split off unstable/gui/pict module (no racket/gui dependency)
added examples to docs
This commit is contained in:
Ryan Culpepper
parent
3bcf99b8f6
commit
19ec1fbccd
354
collects/unstable/gui/pict.rkt
Normal file
354
collects/unstable/gui/pict.rkt
Normal file
|
|
@ -0,0 +1,354 @@
|
||||||
|
#lang racket/base
|
||||||
|
(require slideshow/pict
|
||||||
|
racket/contract racket/list racket/match
|
||||||
|
racket/splicing racket/stxparam racket/draw
|
||||||
|
racket/block racket/class
|
||||||
|
unstable/define
|
||||||
|
(for-syntax racket/base))
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;;
|
||||||
|
;; Picture Manipulation
|
||||||
|
;;
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
(define (fill pict w h)
|
||||||
|
(cc-superimpose
|
||||||
|
pict
|
||||||
|
(blank (or w (pict-width pict))
|
||||||
|
(or h (pict-height pict)))))
|
||||||
|
|
||||||
|
(define (color c p) (colorize p c))
|
||||||
|
|
||||||
|
(define color/c
|
||||||
|
(or/c string? ;; might be faster
|
||||||
|
;;(and/c string? (lambda (s) (send the-color-database find-color s)))
|
||||||
|
(is-a?/c color%)
|
||||||
|
(list/c byte? byte? byte?)))
|
||||||
|
|
||||||
|
(define-syntax-rule (define-colors name ...)
|
||||||
|
(begin (define (name pict) (color (symbol->string 'name) pict)) ...))
|
||||||
|
|
||||||
|
(define-colors
|
||||||
|
red orange yellow green blue purple
|
||||||
|
black brown gray white cyan magenta)
|
||||||
|
|
||||||
|
(define (light c) (scale-color 2 c))
|
||||||
|
(define (dark c) (scale-color 1/2 c))
|
||||||
|
|
||||||
|
(provide/contract
|
||||||
|
[color/c flat-contract?]
|
||||||
|
[red (-> pict? pict?)]
|
||||||
|
[orange (-> pict? pict?)]
|
||||||
|
[yellow (-> pict? pict?)]
|
||||||
|
[green (-> pict? pict?)]
|
||||||
|
[blue (-> pict? pict?)]
|
||||||
|
[purple (-> pict? pict?)]
|
||||||
|
[black (-> pict? pict?)]
|
||||||
|
[brown (-> pict? pict?)]
|
||||||
|
[gray (-> pict? pict?)]
|
||||||
|
[white (-> pict? pict?)]
|
||||||
|
[cyan (-> pict? pict?)]
|
||||||
|
[magenta (-> pict? pict?)]
|
||||||
|
[light (-> color/c color/c)]
|
||||||
|
[dark (-> color/c color/c)]
|
||||||
|
[color (-> color/c pict? pict?)]
|
||||||
|
[fill
|
||||||
|
(-> pict?
|
||||||
|
(or/c (real-in 0 +inf.0) #f)
|
||||||
|
(or/c (real-in 0 +inf.0) #f)
|
||||||
|
pict?)])
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;;
|
||||||
|
;; Space-smart picture selection
|
||||||
|
;;
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
(define-syntax-parameter pict-combine #'ltl-superimpose)
|
||||||
|
|
||||||
|
(define-syntax-rule (with-pict-combine combine body ...)
|
||||||
|
(splicing-syntax-parameterize
|
||||||
|
([pict-combine #'combine])
|
||||||
|
body ...))
|
||||||
|
|
||||||
|
(define-syntax (pict-if stx)
|
||||||
|
(syntax-case stx ()
|
||||||
|
[(_ #:combine combine test success failure)
|
||||||
|
(syntax/loc stx
|
||||||
|
(let* ([result test])
|
||||||
|
(combine (show success result)
|
||||||
|
(hide failure result))))]
|
||||||
|
[(_ test success failure)
|
||||||
|
(quasisyntax/loc stx
|
||||||
|
(pict-if #:combine #,(syntax-parameter-value #'pict-combine)
|
||||||
|
test success failure))]))
|
||||||
|
|
||||||
|
(define-syntax (pict-cond stx)
|
||||||
|
(syntax-case stx (else)
|
||||||
|
[(_ #:combine combine [test expr] ... [else default])
|
||||||
|
(with-syntax ([(pict ...) (generate-temporaries #'(expr ...))])
|
||||||
|
(syntax/loc stx
|
||||||
|
(let ([pict expr] ... [final default])
|
||||||
|
(combine (cond [test pict] ... [else final])
|
||||||
|
(ghost pict) ... (ghost final)))))]
|
||||||
|
[(_ #:combine combine [test pict] ...)
|
||||||
|
(syntax/loc stx
|
||||||
|
(pict-cond #:combine combine [test pict] ... [else (blank 0 0)]))]
|
||||||
|
[(_ [test expr] ...)
|
||||||
|
(quasisyntax/loc stx
|
||||||
|
(pict-cond #:combine #,(syntax-parameter-value #'pict-combine)
|
||||||
|
[test expr] ...))]))
|
||||||
|
|
||||||
|
(define-syntax (pict-case stx)
|
||||||
|
(syntax-case stx (else)
|
||||||
|
[(_ test #:combine combine [literals expr] ... [else default])
|
||||||
|
(with-syntax ([(pict ...) (generate-temporaries #'(expr ...))])
|
||||||
|
(syntax/loc stx
|
||||||
|
(let ([pict expr] ... [final default])
|
||||||
|
(combine (case test [literals pict] ... [else final])
|
||||||
|
(ghost pict) ... (ghost final)))))]
|
||||||
|
[(_ test #:combine combine [literals expr] ...)
|
||||||
|
(syntax/loc stx
|
||||||
|
(pict-case test #:combine combine
|
||||||
|
[literals expr] ... [else (blank 0 0)]))]
|
||||||
|
[(_ test [literals expr] ...)
|
||||||
|
(quasisyntax/loc stx
|
||||||
|
(pict-case test #:combine #,(syntax-parameter-value #'pict-combine)
|
||||||
|
[literals expr] ...))]))
|
||||||
|
|
||||||
|
(define-syntax (pict-match stx)
|
||||||
|
(syntax-case stx ()
|
||||||
|
[(_ test #:combine combine [pattern expr] ...)
|
||||||
|
(with-syntax ([(pict ...) (generate-temporaries #'(expr ...))])
|
||||||
|
(syntax/loc stx
|
||||||
|
(let ([pict expr] ...)
|
||||||
|
(combine (match test [pattern pict] ... [_ (blank 0 0)])
|
||||||
|
(ghost pict) ...))))]
|
||||||
|
[(_ test [pattern expr] ...)
|
||||||
|
(quasisyntax/loc stx
|
||||||
|
(pict-match test #:combine #,(syntax-parameter-value #'pict-combine)
|
||||||
|
[pattern expr] ...))]))
|
||||||
|
|
||||||
|
(provide/contract
|
||||||
|
[hide (->* [pict?] [any/c] pict?)]
|
||||||
|
[show (->* [pict?] [any/c] pict?)]
|
||||||
|
[strike (->* [pict?] [any/c] pict?)]
|
||||||
|
[shade (->* [pict?] [any/c #:ratio (real-in 0 1)] pict?)])
|
||||||
|
(provide staged stage stage-name
|
||||||
|
before at after before/at at/after
|
||||||
|
pict-if pict-cond pict-case pict-match
|
||||||
|
pict-combine with-pict-combine)
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;;
|
||||||
|
;; Slide Staging
|
||||||
|
;;
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
(define-for-syntax (stage-keyword stx)
|
||||||
|
(raise-syntax-error #f "not in the body of a staged slide" stx))
|
||||||
|
|
||||||
|
(define-syntax-parameter stage stage-keyword)
|
||||||
|
(define-syntax-parameter stage-name stage-keyword)
|
||||||
|
|
||||||
|
(define-syntax (staged stx)
|
||||||
|
(syntax-case stx ()
|
||||||
|
[(_ [name ...] body ...)
|
||||||
|
(let* ([ids (syntax->list #'(name ...))])
|
||||||
|
|
||||||
|
(for ([id (in-list ids)] #:when (not (identifier? id)))
|
||||||
|
(raise-syntax-error #f "expected an identifier" stx id))
|
||||||
|
|
||||||
|
(with-syntax ([(num ...)
|
||||||
|
(for/list ([i (in-naturals 1)] [id (in-list ids)])
|
||||||
|
(datum->syntax #'here i id))])
|
||||||
|
|
||||||
|
(syntax/loc stx
|
||||||
|
(let* ([name num] ...)
|
||||||
|
(define (staged-computation number symbol)
|
||||||
|
(syntax-parameterize
|
||||||
|
([stage (make-rename-transformer #'number)]
|
||||||
|
[stage-name (make-rename-transformer #'symbol)])
|
||||||
|
(block body ...)))
|
||||||
|
(begin (staged-computation name 'name) ...)))))]))
|
||||||
|
|
||||||
|
(define-syntax-rule (before name) (< stage name))
|
||||||
|
(define-syntax-rule (before/at name) (<= stage name))
|
||||||
|
(define-syntax-rule (at/after name) (>= stage name))
|
||||||
|
(define-syntax-rule (after name) (> stage name))
|
||||||
|
(define-syntax-rule (before/after name) (not (= stage name)))
|
||||||
|
(define-syntax-rule (at name ...) (or (= stage name) ...))
|
||||||
|
|
||||||
|
(define (hide pict [hide? #t])
|
||||||
|
(if hide? (ghost pict) pict))
|
||||||
|
|
||||||
|
(define (show pict [show? #t])
|
||||||
|
(if show? pict (ghost pict)))
|
||||||
|
|
||||||
|
(define (shade pict [shade? #t] #:ratio [ratio 0.5])
|
||||||
|
(if shade? (cellophane pict ratio) pict))
|
||||||
|
|
||||||
|
(define (strike pict [strike? #t])
|
||||||
|
(if strike?
|
||||||
|
(pin-over pict
|
||||||
|
0
|
||||||
|
(/ (pict-height pict) 2)
|
||||||
|
(pip-line (pict-width pict) 0 0))
|
||||||
|
pict))
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;;
|
||||||
|
;; Misc
|
||||||
|
;;
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
;; the following has been added by stamourv
|
||||||
|
|
||||||
|
;; borders may be of slightly uneven width, sadly
|
||||||
|
(define-values (ellipse/border
|
||||||
|
rectangle/border
|
||||||
|
rounded-rectangle/border)
|
||||||
|
(let ()
|
||||||
|
(define ((mk shape) w h
|
||||||
|
#:color (color "white")
|
||||||
|
#:border-color (border-color "black")
|
||||||
|
#:border-width (border-width 2))
|
||||||
|
(cc-superimpose
|
||||||
|
(colorize (shape w h) border-color)
|
||||||
|
(colorize (shape (- w (* 2 border-width))
|
||||||
|
(- h (* 2 border-width)))
|
||||||
|
color)))
|
||||||
|
(values (mk filled-ellipse)
|
||||||
|
(mk filled-rectangle)
|
||||||
|
(mk filled-rounded-rectangle))))
|
||||||
|
(define (circle/border d
|
||||||
|
#:color (color "white")
|
||||||
|
#:border-color (border-color "black")
|
||||||
|
#:border-width (border-width 2))
|
||||||
|
(cc-superimpose
|
||||||
|
(colorize (disk d) border-color)
|
||||||
|
(colorize (disk (- d (* 2 border-width)))
|
||||||
|
color)))
|
||||||
|
|
||||||
|
(define shape/border-contract
|
||||||
|
(->* [real? real?]
|
||||||
|
[#:color color/c #:border-color color/c #:border-width real?]
|
||||||
|
pict?))
|
||||||
|
(provide/contract
|
||||||
|
[ellipse/border shape/border-contract]
|
||||||
|
[rectangle/border shape/border-contract]
|
||||||
|
[rounded-rectangle/border shape/border-contract]
|
||||||
|
[circle/border
|
||||||
|
(->* [real?]
|
||||||
|
[#:color color/c #:border-color color/c #:border-width real?]
|
||||||
|
pict?)])
|
||||||
|
|
||||||
|
;; the following has been written by Scott Owens
|
||||||
|
;; and updated and added by stamourv
|
||||||
|
|
||||||
|
(define (label-line label pict src-pict src-coord-fn dest-pict dest-coord-fn
|
||||||
|
#:x-adjust (x-adjust 0) #:y-adjust (y-adjust 0))
|
||||||
|
(let-values (((src-x src-y) (src-coord-fn pict src-pict))
|
||||||
|
((dest-x dest-y) (dest-coord-fn pict dest-pict)))
|
||||||
|
(let* ((src (make-rectangular src-x src-y))
|
||||||
|
(dest (make-rectangular dest-x dest-y))
|
||||||
|
(adjust (make-rectangular x-adjust y-adjust))
|
||||||
|
(v (- dest src))
|
||||||
|
(h2 (pict-height label)))
|
||||||
|
;; Ensure that the src is left of dest
|
||||||
|
(when (< (real-part v) 0)
|
||||||
|
(set! v (- v))
|
||||||
|
(set! src dest))
|
||||||
|
(let ((p (+ src
|
||||||
|
;; Move the label to sit atop the line.
|
||||||
|
(/ (* h2 -i v) (magnitude v) 2)
|
||||||
|
;; Center the label in the line.
|
||||||
|
(/ (- v (make-rectangular (pict-width label)
|
||||||
|
(pict-height label)))
|
||||||
|
2)
|
||||||
|
adjust)))
|
||||||
|
(pin-over
|
||||||
|
pict
|
||||||
|
(real-part p)
|
||||||
|
(imag-part p)
|
||||||
|
label)))))
|
||||||
|
|
||||||
|
(define (pin-label-line label pict
|
||||||
|
src-pict src-coord-fn
|
||||||
|
dest-pict dest-coord-fn
|
||||||
|
#:start-angle (start-angle #f)
|
||||||
|
#:end-angle (end-angle #f)
|
||||||
|
#:start-pull (start-pull 1/4)
|
||||||
|
#:end-pull (end-pull 1/4)
|
||||||
|
#:line-width (line-width #f)
|
||||||
|
#:color (color #f)
|
||||||
|
#:under? (under? #f)
|
||||||
|
#:x-adjust (x-adjust 0)
|
||||||
|
#:y-adjust (y-adjust 0))
|
||||||
|
(label-line
|
||||||
|
label
|
||||||
|
(pin-line
|
||||||
|
pict src-pict src-coord-fn dest-pict dest-coord-fn
|
||||||
|
#:start-angle start-angle #:end-angle end-angle
|
||||||
|
#:start-pull start-pull #:end-pull end-pull
|
||||||
|
#:line-width line-width #:color color #:under? under?)
|
||||||
|
src-pict src-coord-fn dest-pict dest-coord-fn
|
||||||
|
#:x-adjust x-adjust #:y-adjust y-adjust))
|
||||||
|
|
||||||
|
(define-values (pin-arrow-label-line
|
||||||
|
pin-arrows-label-line)
|
||||||
|
(let ()
|
||||||
|
(define ((mk fn)
|
||||||
|
label arrow-size pict
|
||||||
|
src-pict src-coord-fn
|
||||||
|
dest-pict dest-coord-fn
|
||||||
|
#:start-angle (start-angle #f)
|
||||||
|
#:end-angle (end-angle #f)
|
||||||
|
#:start-pull (start-pull 1/4)
|
||||||
|
#:end-pull (end-pull 1/4)
|
||||||
|
#:line-width (line-width #f)
|
||||||
|
#:color (color #f)
|
||||||
|
#:under? (under? #f)
|
||||||
|
#:solid? (solid? #t)
|
||||||
|
#:hide-arrowhead? (hide-arrowhead? #f)
|
||||||
|
#:x-adjust (x-adjust 0)
|
||||||
|
#:y-adjust (y-adjust 0))
|
||||||
|
(label-line
|
||||||
|
label
|
||||||
|
(fn
|
||||||
|
arrow-size pict src-pict src-coord-fn dest-pict dest-coord-fn
|
||||||
|
#:start-angle start-angle #:end-angle end-angle
|
||||||
|
#:start-pull start-pull #:end-pull end-pull
|
||||||
|
#:line-width line-width #:color color #:under? under?
|
||||||
|
#:hide-arrowhead? hide-arrowhead?)
|
||||||
|
src-pict src-coord-fn dest-pict dest-coord-fn
|
||||||
|
#:x-adjust x-adjust #:y-adjust y-adjust))
|
||||||
|
(values (mk pin-arrow-line)
|
||||||
|
(mk pin-arrows-line))))
|
||||||
|
(define pin-arrow-label-line-contract
|
||||||
|
(->* [pict? real? pict?
|
||||||
|
pict-path? (-> pict? pict-path? (values real? real?))
|
||||||
|
pict-path? (-> pict? pict-path? (values real? real?))]
|
||||||
|
[#:start-angle (or/c real? #f) #:end-angle (or/c real? #f)
|
||||||
|
#:start-pull real? #:end-pull real?
|
||||||
|
#:line-width (or/c real? #f)
|
||||||
|
#:color (or/c #f string? (is-a?/c color%))
|
||||||
|
#:under? any/c #:hide-arrowhead? any/c
|
||||||
|
#:x-adjust real? #:y-adjust real?]
|
||||||
|
pict?))
|
||||||
|
|
||||||
|
(provide/contract
|
||||||
|
[pin-label-line
|
||||||
|
(->* [pict? pict?
|
||||||
|
pict-path? (-> pict? pict-path? (values real? real?))
|
||||||
|
pict-path? (-> pict? pict-path? (values real? real?))]
|
||||||
|
[#:start-angle (or/c real? #f) #:end-angle (or/c real? #f)
|
||||||
|
#:start-pull real? #:end-pull real?
|
||||||
|
#:line-width (or/c real? #f)
|
||||||
|
#:color (or/c #f string? (is-a?/c color%))
|
||||||
|
#:under? any/c
|
||||||
|
#:x-adjust real? #:y-adjust real?]
|
||||||
|
pict?)]
|
||||||
|
[pin-arrow-label-line pin-arrow-label-line-contract]
|
||||||
|
[pin-arrows-label-line pin-arrow-label-line-contract])
|
||||||
|
|
@ -1,11 +1,12 @@
|
||||||
#lang racket/base
|
#lang racket/base
|
||||||
|
|
||||||
(require slideshow/base slideshow/pict
|
(require slideshow/base slideshow/pict
|
||||||
racket/contract racket/list racket/match
|
racket/contract racket/list racket/match
|
||||||
racket/splicing racket/stxparam racket/gui/base
|
racket/splicing racket/stxparam racket/gui/base
|
||||||
racket/block racket/class
|
racket/block racket/class
|
||||||
unstable/define
|
unstable/define
|
||||||
(for-syntax scheme/base))
|
(for-syntax racket/base)
|
||||||
|
"pict.rkt")
|
||||||
|
(provide (all-from-out "pict.rkt"))
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
;;
|
;;
|
||||||
|
|
@ -32,35 +33,18 @@
|
||||||
(define-style superscript 'superscript)
|
(define-style superscript 'superscript)
|
||||||
(define-style caps 'caps)
|
(define-style caps 'caps)
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
(provide with-size
|
||||||
;;
|
with-scale
|
||||||
;; Picture Manipulation
|
big
|
||||||
;;
|
small
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
|
|
||||||
(define (fill pict w h)
|
with-font
|
||||||
(cc-superimpose
|
with-style
|
||||||
pict
|
bold
|
||||||
(blank (or w (pict-width pict))
|
italic
|
||||||
(or h (pict-height pict)))))
|
subscript
|
||||||
|
superscript
|
||||||
(define (color c p) (colorize p c))
|
caps)
|
||||||
|
|
||||||
(define color/c
|
|
||||||
(or/c string? ;; might be faster
|
|
||||||
;;(and/c string? (lambda (s) (send the-color-database find-color s)))
|
|
||||||
(is-a?/c color%)
|
|
||||||
(list/c byte? byte? byte?)))
|
|
||||||
|
|
||||||
(define-syntax-rule (define-colors name ...)
|
|
||||||
(begin (define (name pict) (color (symbol->string 'name) pict)) ...))
|
|
||||||
|
|
||||||
(define-colors
|
|
||||||
red orange yellow green blue purple
|
|
||||||
black brown gray white cyan magenta)
|
|
||||||
|
|
||||||
(define (light c) (scale-color 2 c))
|
|
||||||
(define (dark c) (scale-color 1/2 c))
|
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
;;
|
;;
|
||||||
|
|
@ -83,6 +67,12 @@
|
||||||
(define (mini-slide . picts)
|
(define (mini-slide . picts)
|
||||||
(apply vc-append gap-size picts))
|
(apply vc-append gap-size picts))
|
||||||
|
|
||||||
|
(provide column
|
||||||
|
columns
|
||||||
|
column-size
|
||||||
|
two-columns
|
||||||
|
mini-slide)
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
;;
|
;;
|
||||||
;; Simple Tables
|
;; Simple Tables
|
||||||
|
|
@ -124,171 +114,6 @@
|
||||||
[(list _) #t]
|
[(list _) #t]
|
||||||
[(list xs ...) (apply = (map length xs))]))))
|
[(list xs ...) (apply = (map length xs))]))))
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
;;
|
|
||||||
;; Space-smart picture selection
|
|
||||||
;;
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
|
|
||||||
(define-syntax-parameter pict-combine #'ltl-superimpose)
|
|
||||||
|
|
||||||
(define-syntax-rule (with-pict-combine combine body ...)
|
|
||||||
(splicing-syntax-parameterize
|
|
||||||
([pict-combine #'combine])
|
|
||||||
body ...))
|
|
||||||
|
|
||||||
(define-syntax (pict-if stx)
|
|
||||||
(syntax-case stx ()
|
|
||||||
[(_ #:combine combine test success failure)
|
|
||||||
(syntax/loc stx
|
|
||||||
(let* ([result test])
|
|
||||||
(combine (show success result)
|
|
||||||
(hide failure result))))]
|
|
||||||
[(_ test success failure)
|
|
||||||
(quasisyntax/loc stx
|
|
||||||
(pict-if #:combine #,(syntax-parameter-value #'pict-combine)
|
|
||||||
test success failure))]))
|
|
||||||
|
|
||||||
(define-syntax (pict-cond stx)
|
|
||||||
(syntax-case stx (else)
|
|
||||||
[(_ #:combine combine [test expr] ... [else default])
|
|
||||||
(with-syntax ([(pict ...) (generate-temporaries #'(expr ...))])
|
|
||||||
(syntax/loc stx
|
|
||||||
(let ([pict expr] ... [final default])
|
|
||||||
(combine (cond [test pict] ... [else final])
|
|
||||||
(ghost pict) ... (ghost final)))))]
|
|
||||||
[(_ #:combine combine [test pict] ...)
|
|
||||||
(syntax/loc stx
|
|
||||||
(pict-cond #:combine combine [test pict] ... [else (blank 0 0)]))]
|
|
||||||
[(_ [test expr] ...)
|
|
||||||
(quasisyntax/loc stx
|
|
||||||
(pict-cond #:combine #,(syntax-parameter-value #'pict-combine)
|
|
||||||
[test expr] ...))]))
|
|
||||||
|
|
||||||
(define-syntax (pict-case stx)
|
|
||||||
(syntax-case stx (else)
|
|
||||||
[(_ test #:combine combine [literals expr] ... [else default])
|
|
||||||
(with-syntax ([(pict ...) (generate-temporaries #'(expr ...))])
|
|
||||||
(syntax/loc stx
|
|
||||||
(let ([pict expr] ... [final default])
|
|
||||||
(combine (case test [literals pict] ... [else final])
|
|
||||||
(ghost pict) ... (ghost final)))))]
|
|
||||||
[(_ test #:combine combine [literals expr] ...)
|
|
||||||
(syntax/loc stx
|
|
||||||
(pict-case test #:combine combine
|
|
||||||
[literals expr] ... [else (blank 0 0)]))]
|
|
||||||
[(_ test [literals expr] ...)
|
|
||||||
(quasisyntax/loc stx
|
|
||||||
(pict-case test #:combine #,(syntax-parameter-value #'pict-combine)
|
|
||||||
[literals expr] ...))]))
|
|
||||||
|
|
||||||
(define-syntax (pict-match stx)
|
|
||||||
(syntax-case stx ()
|
|
||||||
[(_ test #:combine combine [pattern expr] ...)
|
|
||||||
(with-syntax ([(pict ...) (generate-temporaries #'(expr ...))])
|
|
||||||
(syntax/loc stx
|
|
||||||
(let ([pict expr] ...)
|
|
||||||
(combine (match test [pattern pict] ... [_ (blank 0 0)])
|
|
||||||
(ghost pict) ...))))]
|
|
||||||
[(_ test [pattern expr] ...)
|
|
||||||
(quasisyntax/loc stx
|
|
||||||
(pict-match test #:combine #,(syntax-parameter-value #'pict-combine)
|
|
||||||
[pattern expr] ...))]))
|
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
;;
|
|
||||||
;; Slide Staging
|
|
||||||
;;
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
|
|
||||||
(define-for-syntax (stage-keyword stx)
|
|
||||||
(raise-syntax-error #f "not in the body of a staged slide" stx))
|
|
||||||
|
|
||||||
(define-syntax-parameter stage stage-keyword)
|
|
||||||
(define-syntax-parameter stage-name stage-keyword)
|
|
||||||
|
|
||||||
(define-syntax (staged stx)
|
|
||||||
(syntax-case stx ()
|
|
||||||
[(_ [name ...] body ...)
|
|
||||||
(let* ([ids (syntax->list #'(name ...))])
|
|
||||||
|
|
||||||
(for ([id (in-list ids)] #:when (not (identifier? id)))
|
|
||||||
(raise-syntax-error #f "expected an identifier" stx id))
|
|
||||||
|
|
||||||
(with-syntax ([(num ...)
|
|
||||||
(for/list ([i (in-naturals 1)] [id (in-list ids)])
|
|
||||||
(datum->syntax #'here i id))])
|
|
||||||
|
|
||||||
(syntax/loc stx
|
|
||||||
(let* ([name num] ...)
|
|
||||||
(define (staged-computation number symbol)
|
|
||||||
(syntax-parameterize
|
|
||||||
([stage (make-rename-transformer #'number)]
|
|
||||||
[stage-name (make-rename-transformer #'symbol)])
|
|
||||||
(block body ...)))
|
|
||||||
(begin (staged-computation name 'name) ...)))))]))
|
|
||||||
|
|
||||||
(define-syntax-rule (slide/staged [name ...] body ...)
|
|
||||||
(staged [name ...] (slide body ...)))
|
|
||||||
|
|
||||||
(define-syntax-rule (before name) (< stage name))
|
|
||||||
(define-syntax-rule (before/at name) (<= stage name))
|
|
||||||
(define-syntax-rule (at/after name) (>= stage name))
|
|
||||||
(define-syntax-rule (after name) (> stage name))
|
|
||||||
(define-syntax-rule (before/after name) (not (= stage name)))
|
|
||||||
(define-syntax-rule (at name ...) (or (= stage name) ...))
|
|
||||||
|
|
||||||
(define (hide pict [hide? #t])
|
|
||||||
(if hide? (ghost pict) pict))
|
|
||||||
|
|
||||||
(define (show pict [show? #t])
|
|
||||||
(if show? pict (ghost pict)))
|
|
||||||
|
|
||||||
(define (shade pict [shade? #t] #:ratio [ratio 0.5])
|
|
||||||
(if shade? (cellophane pict ratio) pict))
|
|
||||||
|
|
||||||
(define (strike pict [strike? #t])
|
|
||||||
(if strike?
|
|
||||||
(pin-over pict
|
|
||||||
0
|
|
||||||
(/ (pict-height pict) 2)
|
|
||||||
(pip-line (pict-width pict) 0 0))
|
|
||||||
pict))
|
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
;;
|
|
||||||
;; Exports
|
|
||||||
;;
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
|
|
||||||
(provide with-size with-scale big small
|
|
||||||
with-font with-style bold italic subscript superscript caps)
|
|
||||||
|
|
||||||
(provide/contract
|
|
||||||
[color/c flat-contract?]
|
|
||||||
[red (-> pict? pict?)]
|
|
||||||
[orange (-> pict? pict?)]
|
|
||||||
[yellow (-> pict? pict?)]
|
|
||||||
[green (-> pict? pict?)]
|
|
||||||
[blue (-> pict? pict?)]
|
|
||||||
[purple (-> pict? pict?)]
|
|
||||||
[black (-> pict? pict?)]
|
|
||||||
[brown (-> pict? pict?)]
|
|
||||||
[gray (-> pict? pict?)]
|
|
||||||
[white (-> pict? pict?)]
|
|
||||||
[cyan (-> pict? pict?)]
|
|
||||||
[magenta (-> pict? pict?)]
|
|
||||||
[light (-> color/c color/c)]
|
|
||||||
[dark (-> color/c color/c)]
|
|
||||||
[color (-> color/c pict? pict?)]
|
|
||||||
[fill
|
|
||||||
(-> pict?
|
|
||||||
(or/c (real-in 0 +inf.0) #f)
|
|
||||||
(or/c (real-in 0 +inf.0) #f)
|
|
||||||
pict?)])
|
|
||||||
|
|
||||||
(provide column columns column-size two-columns mini-slide)
|
|
||||||
|
|
||||||
(provide/contract
|
(provide/contract
|
||||||
[tabular (->* []
|
[tabular (->* []
|
||||||
[#:gap natural-number/c
|
[#:gap natural-number/c
|
||||||
|
|
@ -300,168 +125,25 @@
|
||||||
#:rest (matrixof (or/c string? pict?))
|
#:rest (matrixof (or/c string? pict?))
|
||||||
pict?)])
|
pict?)])
|
||||||
|
|
||||||
(provide/contract
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
[hide (->* [pict?] [any/c] pict?)]
|
;;
|
||||||
[show (->* [pict?] [any/c] pict?)]
|
;; Slide Staging
|
||||||
[strike (->* [pict?] [any/c] pict?)]
|
;;
|
||||||
[shade (->* [pict?] [any/c #:ratio (real-in 0 1)] pict?)])
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
(provide staged slide/staged stage stage-name
|
|
||||||
before at after before/at at/after
|
|
||||||
pict-if pict-cond pict-case pict-match
|
|
||||||
pict-combine with-pict-combine)
|
|
||||||
|
|
||||||
|
(define-syntax-rule (slide/staged [name ...] body ...)
|
||||||
|
(staged [name ...] (slide body ...)))
|
||||||
|
|
||||||
;; the following has been added by stamourv
|
(provide slide/staged)
|
||||||
|
|
||||||
;; borders may be of slightly uneven width, sadly
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
(define-values (ellipse/border
|
;;
|
||||||
rectangle/border
|
;; Misc
|
||||||
rounded-rectangle/border)
|
;;
|
||||||
(let ()
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
(define ((mk shape) w h
|
|
||||||
#:color (color "white")
|
|
||||||
#:border-color (border-color "black")
|
|
||||||
#:border-width (border-width 2))
|
|
||||||
(cc-superimpose
|
|
||||||
(colorize (shape w h) border-color)
|
|
||||||
(colorize (shape (- w (* 2 border-width))
|
|
||||||
(- h (* 2 border-width)))
|
|
||||||
color)))
|
|
||||||
(values (mk filled-ellipse)
|
|
||||||
(mk filled-rectangle)
|
|
||||||
(mk filled-rounded-rectangle))))
|
|
||||||
(define (circle/border d
|
|
||||||
#:color (color "white")
|
|
||||||
#:border-color (border-color "black")
|
|
||||||
#:border-width (border-width 2))
|
|
||||||
(cc-superimpose
|
|
||||||
(colorize (disk d) border-color)
|
|
||||||
(colorize (disk (- d (* 2 border-width)))
|
|
||||||
color)))
|
|
||||||
|
|
||||||
(define shape/border-contract
|
|
||||||
(->* [real? real?]
|
|
||||||
[#:color color/c #:border-color color/c #:border-width real?]
|
|
||||||
pict?))
|
|
||||||
(provide/contract
|
|
||||||
[ellipse/border shape/border-contract]
|
|
||||||
[rectangle/border shape/border-contract]
|
|
||||||
[rounded-rectangle/border shape/border-contract]
|
|
||||||
[circle/border
|
|
||||||
(->* [real?]
|
|
||||||
[#:color color/c #:border-color color/c #:border-width real?]
|
|
||||||
pict?)])
|
|
||||||
|
|
||||||
|
|
||||||
;; the following has been written by Scott Owens
|
|
||||||
;; and updated and added by stamourv
|
|
||||||
|
|
||||||
(define (blank-line)
|
(define (blank-line)
|
||||||
(blank 0 (current-font-size)))
|
(blank 0 (current-font-size)))
|
||||||
|
|
||||||
(define (label-line label pict src-pict src-coord-fn dest-pict dest-coord-fn
|
|
||||||
#:x-adjust (x-adjust 0) #:y-adjust (y-adjust 0))
|
|
||||||
(let-values (((src-x src-y) (src-coord-fn pict src-pict))
|
|
||||||
((dest-x dest-y) (dest-coord-fn pict dest-pict)))
|
|
||||||
(let* ((src (make-rectangular src-x src-y))
|
|
||||||
(dest (make-rectangular dest-x dest-y))
|
|
||||||
(adjust (make-rectangular x-adjust y-adjust))
|
|
||||||
(v (- dest src))
|
|
||||||
(h2 (pict-height label)))
|
|
||||||
;; Ensure that the src is left of dest
|
|
||||||
(when (< (real-part v) 0)
|
|
||||||
(set! v (- v))
|
|
||||||
(set! src dest))
|
|
||||||
(let ((p (+ src
|
|
||||||
;; Move the label to sit atop the line.
|
|
||||||
(/ (* h2 -i v) (magnitude v) 2)
|
|
||||||
;; Center the label in the line.
|
|
||||||
(/ (- v (make-rectangular (pict-width label)
|
|
||||||
(pict-height label)))
|
|
||||||
2)
|
|
||||||
adjust)))
|
|
||||||
(pin-over
|
|
||||||
pict
|
|
||||||
(real-part p)
|
|
||||||
(imag-part p)
|
|
||||||
label)))))
|
|
||||||
|
|
||||||
(define (pin-label-line label pict
|
|
||||||
src-pict src-coord-fn
|
|
||||||
dest-pict dest-coord-fn
|
|
||||||
#:start-angle (start-angle #f)
|
|
||||||
#:end-angle (end-angle #f)
|
|
||||||
#:start-pull (start-pull 1/4)
|
|
||||||
#:end-pull (end-pull 1/4)
|
|
||||||
#:line-width (line-width #f)
|
|
||||||
#:color (color #f)
|
|
||||||
#:under? (under? #f)
|
|
||||||
#:x-adjust (x-adjust 0)
|
|
||||||
#:y-adjust (y-adjust 0))
|
|
||||||
(label-line
|
|
||||||
label
|
|
||||||
(pin-line
|
|
||||||
pict src-pict src-coord-fn dest-pict dest-coord-fn
|
|
||||||
#:start-angle start-angle #:end-angle end-angle
|
|
||||||
#:start-pull start-pull #:end-pull end-pull
|
|
||||||
#:line-width line-width #:color color #:under? under?)
|
|
||||||
src-pict src-coord-fn dest-pict dest-coord-fn
|
|
||||||
#:x-adjust x-adjust #:y-adjust y-adjust))
|
|
||||||
|
|
||||||
(define-values (pin-arrow-label-line
|
|
||||||
pin-arrows-label-line)
|
|
||||||
(let ()
|
|
||||||
(define ((mk fn)
|
|
||||||
label arrow-size pict
|
|
||||||
src-pict src-coord-fn
|
|
||||||
dest-pict dest-coord-fn
|
|
||||||
#:start-angle (start-angle #f)
|
|
||||||
#:end-angle (end-angle #f)
|
|
||||||
#:start-pull (start-pull 1/4)
|
|
||||||
#:end-pull (end-pull 1/4)
|
|
||||||
#:line-width (line-width #f)
|
|
||||||
#:color (color #f)
|
|
||||||
#:under? (under? #f)
|
|
||||||
#:solid? (solid? #t)
|
|
||||||
#:hide-arrowhead? (hide-arrowhead? #f)
|
|
||||||
#:x-adjust (x-adjust 0)
|
|
||||||
#:y-adjust (y-adjust 0))
|
|
||||||
(label-line
|
|
||||||
label
|
|
||||||
(fn
|
|
||||||
arrow-size pict src-pict src-coord-fn dest-pict dest-coord-fn
|
|
||||||
#:start-angle start-angle #:end-angle end-angle
|
|
||||||
#:start-pull start-pull #:end-pull end-pull
|
|
||||||
#:line-width line-width #:color color #:under? under?
|
|
||||||
#:hide-arrowhead? hide-arrowhead?)
|
|
||||||
src-pict src-coord-fn dest-pict dest-coord-fn
|
|
||||||
#:x-adjust x-adjust #:y-adjust y-adjust))
|
|
||||||
(values (mk pin-arrow-line)
|
|
||||||
(mk pin-arrows-line))))
|
|
||||||
(define pin-arrow-label-line-contract
|
|
||||||
(->* [pict? real? pict?
|
|
||||||
pict-path? (-> pict? pict-path? (values real? real?))
|
|
||||||
pict-path? (-> pict? pict-path? (values real? real?))]
|
|
||||||
[#:start-angle (or/c real? #f) #:end-angle (or/c real? #f)
|
|
||||||
#:start-pull real? #:end-pull real?
|
|
||||||
#:line-width (or/c real? #f)
|
|
||||||
#:color (or/c #f string? (is-a?/c color%))
|
|
||||||
#:under? any/c #:hide-arrowhead? any/c
|
|
||||||
#:x-adjust real? #:y-adjust real?]
|
|
||||||
pict?))
|
|
||||||
|
|
||||||
(provide/contract
|
(provide/contract
|
||||||
[blank-line (-> pict?)]
|
[blank-line (-> pict?)])
|
||||||
[pin-label-line
|
|
||||||
(->* [pict? pict?
|
|
||||||
pict-path? (-> pict? pict-path? (values real? real?))
|
|
||||||
pict-path? (-> pict? pict-path? (values real? real?))]
|
|
||||||
[#:start-angle (or/c real? #f) #:end-angle (or/c real? #f)
|
|
||||||
#:start-pull real? #:end-pull real?
|
|
||||||
#:line-width (or/c real? #f)
|
|
||||||
#:color (or/c #f string? (is-a?/c color%))
|
|
||||||
#:under? any/c
|
|
||||||
#:x-adjust real? #:y-adjust real?]
|
|
||||||
pict?)]
|
|
||||||
[pin-arrow-label-line pin-arrow-label-line-contract]
|
|
||||||
[pin-arrows-label-line pin-arrow-label-line-contract])
|
|
||||||
|
|
|
||||||
|
|
@ -10,6 +10,7 @@
|
||||||
@include-section["gui/language-level.scrbl"]
|
@include-section["gui/language-level.scrbl"]
|
||||||
@include-section["gui/notify.scrbl"]
|
@include-section["gui/notify.scrbl"]
|
||||||
@include-section["gui/prefs.scrbl"]
|
@include-section["gui/prefs.scrbl"]
|
||||||
|
@include-section["gui/pict.scrbl"]
|
||||||
@include-section["gui/slideshow.scrbl"]
|
@include-section["gui/slideshow.scrbl"]
|
||||||
@include-section["gui/pslide.scrbl"]
|
@include-section["gui/pslide.scrbl"]
|
||||||
@include-section["gui/blur.scrbl"]
|
@include-section["gui/blur.scrbl"]
|
||||||
|
|
|
||||||
341
collects/unstable/scribblings/gui/pict.scrbl
Normal file
341
collects/unstable/scribblings/gui/pict.scrbl
Normal file
|
|
@ -0,0 +1,341 @@
|
||||||
|
#lang scribble/manual
|
||||||
|
@(require "../utils.rkt"
|
||||||
|
scribble/eval
|
||||||
|
(for-label slideshow
|
||||||
|
unstable/contract
|
||||||
|
unstable/gui/pict))
|
||||||
|
|
||||||
|
@(define the-eval (make-base-eval))
|
||||||
|
@(the-eval '(require racket/math slideshow/pict unstable/gui/pict))
|
||||||
|
|
||||||
|
@title{Pict Utilities}
|
||||||
|
|
||||||
|
@unstable[@author+email["Carl Eastlund" "cce@racket-lang.org"]]
|
||||||
|
|
||||||
|
@defmodule[unstable/gui/pict]
|
||||||
|
|
||||||
|
The functions and macros exported by this module are also exported by
|
||||||
|
@racketmodname[unstable/gui/slideshow].
|
||||||
|
|
||||||
|
@;{----------------------------------------}
|
||||||
|
|
||||||
|
@section{Pict Colors}
|
||||||
|
|
||||||
|
@defproc[(color [c color/c] [p pict?]) pict?]{
|
||||||
|
|
||||||
|
Applies color @racket[c] to picture @racket[p]. Equivalent to @racket[(colorize
|
||||||
|
p c)].
|
||||||
|
|
||||||
|
@examples[#:eval the-eval
|
||||||
|
(color "red" (disk 20))
|
||||||
|
]
|
||||||
|
}
|
||||||
|
|
||||||
|
@deftogether[(
|
||||||
|
@defproc[(red [pict pict?]) pict?]
|
||||||
|
@defproc[(orange [pict pict?]) pict?]
|
||||||
|
@defproc[(yellow [pict pict?]) pict?]
|
||||||
|
@defproc[(green [pict pict?]) pict?]
|
||||||
|
@defproc[(blue [pict pict?]) pict?]
|
||||||
|
@defproc[(purple [pict pict?]) pict?]
|
||||||
|
@defproc[(black [pict pict?]) pict?]
|
||||||
|
@defproc[(brown [pict pict?]) pict?]
|
||||||
|
@defproc[(gray [pict pict?]) pict?]
|
||||||
|
@defproc[(white [pict pict?]) pict?]
|
||||||
|
@defproc[(cyan [pict pict?]) pict?]
|
||||||
|
@defproc[(magenta [pict pict?]) pict?]
|
||||||
|
)]{
|
||||||
|
|
||||||
|
These functions apply appropriate colors to picture @racket[p].
|
||||||
|
|
||||||
|
@examples[#:eval the-eval
|
||||||
|
(red (disk 20))
|
||||||
|
]
|
||||||
|
}
|
||||||
|
|
||||||
|
@deftogether[(
|
||||||
|
@defproc[(light [color color/c]) color/c]
|
||||||
|
@defproc[(dark [color color/c]) color/c]
|
||||||
|
)]{
|
||||||
|
|
||||||
|
These functions produce ligher or darker versions of a color.
|
||||||
|
|
||||||
|
@examples[#:eval the-eval
|
||||||
|
(hc-append (colorize (disk 20) "red")
|
||||||
|
(colorize (disk 20) (dark "red"))
|
||||||
|
(colorize (disk 20) (light "red")))
|
||||||
|
]
|
||||||
|
}
|
||||||
|
|
||||||
|
@defthing[color/c flat-contract?]{
|
||||||
|
|
||||||
|
This contract recognizes color strings, @racket[color%] instances, and RGB color
|
||||||
|
lists.
|
||||||
|
}
|
||||||
|
|
||||||
|
@;{----------------------------------------}
|
||||||
|
|
||||||
|
@section{Pict Manipulation}
|
||||||
|
|
||||||
|
@defproc[(fill [pict pict?] [width (or/c real? #f)] [height (or/c real? #f)])
|
||||||
|
pict?]{
|
||||||
|
|
||||||
|
Extends @racket[pict]'s bounding box to a minimum @racket[width] and/or
|
||||||
|
@racket[height], placing the original picture in the middle of the space.
|
||||||
|
|
||||||
|
@examples[#:eval the-eval
|
||||||
|
(frame (fill (disk 20) 40 40))
|
||||||
|
]
|
||||||
|
}
|
||||||
|
|
||||||
|
@subsection{Conditional Manipulations}
|
||||||
|
|
||||||
|
These pict transformers all take boolean arguments that determine whether to
|
||||||
|
transform the pict or leave it unchanged. These transformations can be useful
|
||||||
|
for staged slides, as the resulting pict always has the same size and shape, and
|
||||||
|
its contents always appear at the same position, but changing the boolean
|
||||||
|
argument between slides can control when the transformation occurs.
|
||||||
|
|
||||||
|
@deftogether[(
|
||||||
|
@defproc[(show [pict pict?] [show? truth/c #t]) pict?]
|
||||||
|
@defproc[(hide [pict pict?] [hide? truth/c #t]) pict?]
|
||||||
|
)]{
|
||||||
|
|
||||||
|
These functions conditionally show or hide an image, essentially choosing
|
||||||
|
between @racket[pict] and @racket[(ghost pict)]. The only difference between
|
||||||
|
the two is the default behavior and the opposite meaning of the @racket[show?]
|
||||||
|
and @racket[hide?] booleans. Both functions are provided for mnemonic purposes.
|
||||||
|
}
|
||||||
|
|
||||||
|
@defproc[(strike [pict pict?] [strike? truth/c #t]) pict?]{
|
||||||
|
|
||||||
|
Displays a strikethrough image by putting a line through the middle of
|
||||||
|
@racket[pict] if @racket[strike?] is true; produces @racket[pict] unchanged
|
||||||
|
otherwise.
|
||||||
|
|
||||||
|
@examples[#:eval the-eval
|
||||||
|
(strike (colorize (disk 20) "yellow"))
|
||||||
|
]
|
||||||
|
}
|
||||||
|
|
||||||
|
@defproc[(shade [pict pict?]
|
||||||
|
[shade? truth/c #t]
|
||||||
|
[#:ratio ratio (real-in 0 1) 1/2])
|
||||||
|
pict?]{
|
||||||
|
|
||||||
|
Shades @racket[pict] to show with @racket[ratio] of its normal opacity; if
|
||||||
|
@racket[ratio] is @racket[1] or @racket[shade?] is @racket[#f], shows
|
||||||
|
@racket[pict] unchanged.
|
||||||
|
|
||||||
|
@examples[#:eval the-eval
|
||||||
|
(shade (colorize (disk 20) "red"))
|
||||||
|
]
|
||||||
|
}
|
||||||
|
|
||||||
|
@subsection{Conditional Combinations}
|
||||||
|
|
||||||
|
These pict control flow operators decide which pict of several to use. All
|
||||||
|
branches are evaluated; the resulting pict is a combination of the pict chosen
|
||||||
|
by normal conditional flow with @racket[ghost] applied to all the other picts.
|
||||||
|
The result is a picture large enough to accommodate each alternative, but showing
|
||||||
|
only the chosen one. This is useful for staged slides, as the pict chosen may
|
||||||
|
change with each slide but its size and position will not.
|
||||||
|
|
||||||
|
@defform/subs[(pict-if maybe-combine test-expr then-expr else-expr)
|
||||||
|
([maybe-combine code:blank (code:line #:combine combine-expr)])]{
|
||||||
|
|
||||||
|
Chooses either @racket[then-expr] or @racket[else-expr] based on
|
||||||
|
@racket[test-expr], similarly to @racket[if]. Combines the chosen, visible
|
||||||
|
image with the other, invisible image using @racket[combine-expr], defaulting to
|
||||||
|
@racket[pict-combine].
|
||||||
|
|
||||||
|
@examples[#:eval the-eval
|
||||||
|
(let ([f (lambda (x)
|
||||||
|
(pict-if x
|
||||||
|
(disk 20)
|
||||||
|
(disk 40)))])
|
||||||
|
(hc-append 10
|
||||||
|
(frame (f #t))
|
||||||
|
(frame (f #f))))
|
||||||
|
]
|
||||||
|
}
|
||||||
|
|
||||||
|
@defform/subs[(pict-cond maybe-combine [test-expr pict-expr] ...)
|
||||||
|
([maybe-combine code:blank (code:line #:combine combine-expr)])]{
|
||||||
|
|
||||||
|
Chooses a @racket[pict-expr] based on the first successful @racket[test-expr],
|
||||||
|
similarly to @racket[cond]. Combines the chosen, visible image with the other,
|
||||||
|
invisible images using @racket[combine-expr], defaulting to
|
||||||
|
@racket[pict-combine].
|
||||||
|
|
||||||
|
@examples[#:eval the-eval
|
||||||
|
(let ([f (lambda (x)
|
||||||
|
(pict-cond
|
||||||
|
[(eq? x 'circle) (circle 20)]
|
||||||
|
[(eq? x 'disk) (disk 40)]
|
||||||
|
[(eq? x 'text) (text "ok" null 20)]))])
|
||||||
|
(hc-append 10
|
||||||
|
(frame (f 'circle))
|
||||||
|
(frame (f 'disk))
|
||||||
|
(frame (f 'text))))
|
||||||
|
]
|
||||||
|
}
|
||||||
|
|
||||||
|
@defform/subs[(pict-case test-expr maybe-combine [literals pict-expr] ...)
|
||||||
|
([maybe-combine code:blank (code:line #:combine combine-expr)])]{
|
||||||
|
|
||||||
|
Chooses a @racket[pict-expr] based on @racket[test-expr] and each list of
|
||||||
|
@racket[literals], similarly to @racket[case]. Combines the chosen, visible
|
||||||
|
image with the other, invisible images using @racket[combine-expr], defaulting
|
||||||
|
to @racket[pict-combine].
|
||||||
|
|
||||||
|
@examples[#:eval the-eval
|
||||||
|
(let ([f (lambda (x)
|
||||||
|
(pict-case x
|
||||||
|
[(circle) (circle 20)]
|
||||||
|
[(disk) (disk 40)]
|
||||||
|
[(text) (text "ok" null 20)]))])
|
||||||
|
(hc-append 10
|
||||||
|
(frame (f 'circle))
|
||||||
|
(frame (f 'disk))
|
||||||
|
(frame (f 'text))))
|
||||||
|
]
|
||||||
|
}
|
||||||
|
|
||||||
|
@defform/subs[(pict-match test-expr maybe-combine [pattern pict-expr] ...)
|
||||||
|
([maybe-combine code:blank (code:line #:combine combine-expr)])]{
|
||||||
|
|
||||||
|
Chooses a @racket[pict-expr] based on @racket[test-expr] and each
|
||||||
|
@racket[pattern], similarly to @racket[match]. Combines the chosen, visible
|
||||||
|
image with the other, invisible images using @racket[combine-expr], defaulting
|
||||||
|
to @racket[pict-combine].
|
||||||
|
|
||||||
|
}
|
||||||
|
|
||||||
|
@defform[#:id pict-combine pict-combine]{
|
||||||
|
|
||||||
|
This syntax parameter determines the default pict combining form used by the
|
||||||
|
above macros. It defaults to @racket[lbl-superimpose].
|
||||||
|
}
|
||||||
|
|
||||||
|
@defform[(with-pict-combine combine-id body ...)]{
|
||||||
|
|
||||||
|
Sets @racket[pict-combine] to refer to @racket[combine-id] within each of the
|
||||||
|
@racket[body] terms, which are spliced into the containing context.
|
||||||
|
|
||||||
|
@examples[#:eval the-eval
|
||||||
|
(let ([f (lambda (x)
|
||||||
|
(with-pict-combine cc-superimpose
|
||||||
|
(pict-case x
|
||||||
|
[(circle) (circle 20)]
|
||||||
|
[(disk) (disk 40)]
|
||||||
|
[(text) (text "ok" null 20)])))])
|
||||||
|
(hc-append 10
|
||||||
|
(frame (f 'circle))
|
||||||
|
(frame (f 'disk))
|
||||||
|
(frame (f 'text))))
|
||||||
|
]
|
||||||
|
}
|
||||||
|
|
||||||
|
@section{Miscellaneous Pict Utilities}
|
||||||
|
|
||||||
|
@addition{Vincent St-Amour}
|
||||||
|
|
||||||
|
@deftogether[(
|
||||||
|
@defproc[(ellipse/border [w real?] [h real?]
|
||||||
|
[#:color color color/c "white"]
|
||||||
|
[#:border-color border-color color/c "black"]
|
||||||
|
[#:border-width border-width real? 2])
|
||||||
|
pict?]
|
||||||
|
@defproc[(circle/border [diameter real?]
|
||||||
|
[#:color color color/c "white"]
|
||||||
|
[#:border-color border-color color/c "black"]
|
||||||
|
[#:border-width border-width real? 2])
|
||||||
|
pict?]
|
||||||
|
@defproc[(rectangle/border [w real?] [h real?]
|
||||||
|
[#:color color color/c "white"]
|
||||||
|
[#:border-color border-color color/c "black"]
|
||||||
|
[#:border-width border-width real? 2])
|
||||||
|
pict?]
|
||||||
|
@defproc[(rounded-rectangle/border [w real?] [h real?]
|
||||||
|
[#:color color color/c "white"]
|
||||||
|
[#:border-color border-color color/c "black"]
|
||||||
|
[#:border-width border-width real? 2])
|
||||||
|
pict?]
|
||||||
|
)]{
|
||||||
|
These functions create shapes with border of the given color and width.
|
||||||
|
|
||||||
|
@examples[#:eval the-eval
|
||||||
|
(ellipse/border 40 20 #:border-color "blue")
|
||||||
|
(rounded-rectangle/border 40 20 #:color "red")
|
||||||
|
]
|
||||||
|
}
|
||||||
|
|
||||||
|
@addition{Scott Owens}
|
||||||
|
|
||||||
|
@deftogether[(
|
||||||
|
@defproc[(pin-label-line [label pict?] [pict pict?]
|
||||||
|
[src-pict pict-path?]
|
||||||
|
[src-coord-fn (-> pict-path? (values real? real?))]
|
||||||
|
[dest-pict pict-path?]
|
||||||
|
[dest-coord-fn (-> pict-path? (values real? real?))]
|
||||||
|
[#:start-angle start-angle (or/c real? #f) #f]
|
||||||
|
[#:end-angle end-angle (or/c real? #f) #f]
|
||||||
|
[#:start-pull start-pull real? 1/4]
|
||||||
|
[#:end-pull end-pull real? 1/4]
|
||||||
|
[#:line-width line-width (or/c real? #f) #f]
|
||||||
|
[#:color color (or/c #f string? (is-a?/c color%)) #f]
|
||||||
|
[#:under? under? any/c #f]
|
||||||
|
[#:x-adjust x-adjust real? 0]
|
||||||
|
[#:y-adjust y-adjust real? 0])
|
||||||
|
pict?]
|
||||||
|
@defproc[(pin-arrow-label-line [label pict?] [arrow-size real?] [pict pict?]
|
||||||
|
[src-pict pict-path?]
|
||||||
|
[src-coord-fn (-> pict-path? (values real? real?))]
|
||||||
|
[dest-pict pict-path?]
|
||||||
|
[dest-coord-fn (-> pict-path? (values real? real?))]
|
||||||
|
[#:start-angle start-angle (or/c real? #f) #f]
|
||||||
|
[#:end-angle end-angle (or/c real? #f) #f]
|
||||||
|
[#:start-pull start-pull real? 1/4]
|
||||||
|
[#:end-pull end-pull real? 1/4]
|
||||||
|
[#:line-width line-width (or/c real? #f) #f]
|
||||||
|
[#:color color (or/c #f string? (is-a?/c color%)) #f]
|
||||||
|
[#:under? under? any/c #f]
|
||||||
|
[#:hide-arrowhead? hide-arrowhead? any/c #f]
|
||||||
|
[#:x-adjust x-adjust real? 0]
|
||||||
|
[#:y-adjust y-adjust real? 0])
|
||||||
|
pict?]
|
||||||
|
@defproc[(pin-arrows-label-line [label pict?] [arrow-size real?] [pict pict?]
|
||||||
|
[src-pict pict-path?]
|
||||||
|
[src-coord-fn (-> pict-path? (values real? real?))]
|
||||||
|
[dest-pict pict-path?]
|
||||||
|
[dest-coord-fn (-> pict-path? (values real? real?))]
|
||||||
|
[#:start-angle start-angle (or/c real? #f) #f]
|
||||||
|
[#:end-angle end-angle (or/c real? #f) #f]
|
||||||
|
[#:start-pull start-pull real? 1/4]
|
||||||
|
[#:end-pull end-pull real? 1/4]
|
||||||
|
[#:line-width line-width (or/c real? #f) #f]
|
||||||
|
[#:color color (or/c #f string? (is-a?/c color%)) #f]
|
||||||
|
[#:under? under? any/c #f]
|
||||||
|
[#:hide-arrowhead? hide-arrowhead? any/c #f]
|
||||||
|
[#:x-adjust x-adjust real? 0]
|
||||||
|
[#:y-adjust y-adjust real? 0])
|
||||||
|
pict?]
|
||||||
|
)]{
|
||||||
|
These functions behave like @racket[pin-line], @racket[pin-arrow-line]
|
||||||
|
and @racket[pin-arrows-line] with the addition of a label attached to
|
||||||
|
the line.
|
||||||
|
|
||||||
|
@examples[#:eval the-eval
|
||||||
|
(let* ([a (red (disk 20))]
|
||||||
|
[b (blue (filled-rectangle 20 20))]
|
||||||
|
[p (vl-append a (hb-append (blank 100) b))])
|
||||||
|
(pin-arrow-label-line
|
||||||
|
(rotate (text "label" null 10) (/ pi -4))
|
||||||
|
10 p
|
||||||
|
a rb-find
|
||||||
|
b lt-find))
|
||||||
|
]
|
||||||
|
}
|
||||||
|
|
||||||
|
@(close-eval the-eval)
|
||||||
|
|
@ -6,9 +6,12 @@
|
||||||
|
|
||||||
@title{Slideshow Presentations}
|
@title{Slideshow Presentations}
|
||||||
|
|
||||||
|
@unstable[@author+email["Carl Eastlund" "cce@racket-lang.org"]]
|
||||||
|
|
||||||
@defmodule[unstable/gui/slideshow]
|
@defmodule[unstable/gui/slideshow]
|
||||||
|
|
||||||
@unstable[@author+email["Carl Eastlund" "cce@racket-lang.org"]]
|
This module also exports everything provided by
|
||||||
|
@racketmodname[unstable/gui/pict].
|
||||||
|
|
||||||
@section{Text Formatting}
|
@section{Text Formatting}
|
||||||
|
|
||||||
|
|
@ -61,201 +64,6 @@ text, respectively, to @racket[current-main-font] while running @racket[text].
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|
||||||
@section{Pict Colors}
|
|
||||||
|
|
||||||
@defproc[(color [c color/c] [p pict?]) pict?]{
|
|
||||||
|
|
||||||
Applies color @racket[c] to picture @racket[p]. Equivalent to @racket[(colorize
|
|
||||||
p c)].
|
|
||||||
|
|
||||||
}
|
|
||||||
|
|
||||||
@deftogether[(
|
|
||||||
@defproc[(red [pict pict?]) pict?]
|
|
||||||
@defproc[(orange [pict pict?]) pict?]
|
|
||||||
@defproc[(yellow [pict pict?]) pict?]
|
|
||||||
@defproc[(green [pict pict?]) pict?]
|
|
||||||
@defproc[(blue [pict pict?]) pict?]
|
|
||||||
@defproc[(purple [pict pict?]) pict?]
|
|
||||||
@defproc[(black [pict pict?]) pict?]
|
|
||||||
@defproc[(brown [pict pict?]) pict?]
|
|
||||||
@defproc[(gray [pict pict?]) pict?]
|
|
||||||
@defproc[(white [pict pict?]) pict?]
|
|
||||||
@defproc[(cyan [pict pict?]) pict?]
|
|
||||||
@defproc[(magenta [pict pict?]) pict?]
|
|
||||||
)]{
|
|
||||||
|
|
||||||
These functions apply appropriate colors to picture @racket[p].
|
|
||||||
|
|
||||||
}
|
|
||||||
|
|
||||||
@deftogether[(
|
|
||||||
@defproc[(light [color color/c]) color/c]
|
|
||||||
@defproc[(dark [color color/c]) color/c]
|
|
||||||
)]{
|
|
||||||
|
|
||||||
These functions produce ligher or darker versions of a color.
|
|
||||||
|
|
||||||
}
|
|
||||||
|
|
||||||
@defthing[color/c flat-contract?]{
|
|
||||||
|
|
||||||
This contract recognizes color strings, @racket[color%] instances, and RGB color
|
|
||||||
lists.
|
|
||||||
|
|
||||||
}
|
|
||||||
|
|
||||||
@section{Pict Manipulation}
|
|
||||||
|
|
||||||
@defproc[(fill [pict pict?] [width (or/c real? #f)] [height (or/c real? #f)])
|
|
||||||
pict?]{
|
|
||||||
|
|
||||||
Extends @racket[pict]'s bounding box to a minimum @racket[width] and/or
|
|
||||||
@racket[height], placing the original picture in the middle of the space.
|
|
||||||
|
|
||||||
}
|
|
||||||
|
|
||||||
@subsection{Conditional Manipulations}
|
|
||||||
|
|
||||||
These pict transformers all take boolean arguments that determine whether to
|
|
||||||
transform the pict or leave it unchanged. These transformations can be useful
|
|
||||||
for staged slides, as the resulting pict always has the same size and shape, and
|
|
||||||
its contents always appear at the same position, but changing the boolean
|
|
||||||
argument between slides can control when the transformation occurs.
|
|
||||||
|
|
||||||
@deftogether[(
|
|
||||||
@defproc[(show [pict pict?] [show? truth/c #t]) pict?]
|
|
||||||
@defproc[(hide [pict pict?] [hide? truth/c #t]) pict?]
|
|
||||||
)]{
|
|
||||||
|
|
||||||
These functions conditionally show or hide an image, essentially choosing
|
|
||||||
between @racket[pict] and @racket[(ghost pict)]. The only difference between
|
|
||||||
the two is the default behavior and the opposite meaning of the @racket[show?]
|
|
||||||
and @racket[hide?] booleans. Both functions are provided for mnemonic purposes.
|
|
||||||
|
|
||||||
}
|
|
||||||
|
|
||||||
@defproc[(strike [pict pict?] [strike? truth/c #t]) pict?]{
|
|
||||||
|
|
||||||
Displays a strikethrough image by putting a line through the middle of
|
|
||||||
@racket[pict] if @racket[strike?] is true; produces @racket[pict] unchanged
|
|
||||||
otherwise.
|
|
||||||
|
|
||||||
}
|
|
||||||
|
|
||||||
@defproc[(shade [pict pict?]
|
|
||||||
[shade? truth/c #t]
|
|
||||||
[#:ratio ratio (real-in 0 1) 1/2])
|
|
||||||
pict?]{
|
|
||||||
|
|
||||||
Shades @racket[pict] to show with @racket[ratio] of its normal opacity; if
|
|
||||||
@racket[ratio] is @racket[1] or @racket[shade?] is @racket[#f], shows
|
|
||||||
@racket[pict] unchanged.
|
|
||||||
|
|
||||||
}
|
|
||||||
|
|
||||||
@subsection{Conditional Combinations}
|
|
||||||
|
|
||||||
These pict control flow operators decide which pict of several to use. All
|
|
||||||
branches are evaluated; the resulting pict is a combination of the pict chosen
|
|
||||||
by normal conditional flow with @racket[ghost] applied to all the other picts.
|
|
||||||
The result is a picture large enough to accommodate each alternative, but showing
|
|
||||||
only the chosen one. This is useful for staged slides, as the pict chosen may
|
|
||||||
change with each slide but its size and position will not.
|
|
||||||
|
|
||||||
@defform/subs[(pict-if maybe-combine test-expr then-expr else-expr)
|
|
||||||
([maybe-combine code:blank (code:line #:combine combine-expr)])]{
|
|
||||||
|
|
||||||
Chooses either @racket[then-expr] or @racket[else-expr] based on
|
|
||||||
@racket[test-expr], similarly to @racket[if]. Combines the chosen, visible
|
|
||||||
image with the other, invisible image using @racket[combine-expr], defaulting to
|
|
||||||
@racket[pict-combine].
|
|
||||||
|
|
||||||
}
|
|
||||||
|
|
||||||
@defform/subs[(pict-cond maybe-combine [test-expr pict-expr] ...)
|
|
||||||
([maybe-combine code:blank (code:line #:combine combine-expr)])]{
|
|
||||||
|
|
||||||
Chooses a @racket[pict-expr] based on the first successful @racket[test-expr],
|
|
||||||
similarly to @racket[cond]. Combines the chosen, visible image with the other,
|
|
||||||
invisible images using @racket[combine-expr], defaulting to
|
|
||||||
@racket[pict-combine].
|
|
||||||
|
|
||||||
}
|
|
||||||
|
|
||||||
@defform/subs[(pict-case test-expr maybe-combine [literals pict-expr] ...)
|
|
||||||
([maybe-combine code:blank (code:line #:combine combine-expr)])]{
|
|
||||||
|
|
||||||
Chooses a @racket[pict-expr] based on @racket[test-expr] and each list of
|
|
||||||
@racket[literals], similarly to @racket[case]. Combines the chosen, visible
|
|
||||||
image with the other, invisible images using @racket[combine-expr], defaulting
|
|
||||||
to @racket[pict-combine].
|
|
||||||
|
|
||||||
}
|
|
||||||
|
|
||||||
@defform/subs[(pict-match test-expr maybe-combine [pattern pict-expr] ...)
|
|
||||||
([maybe-combine code:blank (code:line #:combine combine-expr)])]{
|
|
||||||
|
|
||||||
Chooses a @racket[pict-expr] based on @racket[test-expr] and each
|
|
||||||
@racket[pattern], similarly to @racket[match]. Combines the chosen, visible
|
|
||||||
image with the other, invisible images using @racket[combine-expr], defaulting
|
|
||||||
to @racket[pict-combine].
|
|
||||||
|
|
||||||
}
|
|
||||||
|
|
||||||
@defform[#:id pict-combine pict-combine]{
|
|
||||||
|
|
||||||
This syntax parameter determines the default pict combining form used by the
|
|
||||||
above macros. It defaults to @racket[lbl-superimpose].
|
|
||||||
|
|
||||||
}
|
|
||||||
|
|
||||||
@defform[(with-pict-combine combine-id body ...)]{
|
|
||||||
|
|
||||||
Sets @racket[pict-combine] to refer to @racket[combine-id] within each of the
|
|
||||||
@racket[body] terms, which are spliced into the containing context.
|
|
||||||
|
|
||||||
}
|
|
||||||
|
|
||||||
@section{Staged Slides}
|
|
||||||
|
|
||||||
@defform[(staged [name ...] body ...)]{
|
|
||||||
|
|
||||||
Executes the @racket[body] terms once for each stage @racket[name]. The terms
|
|
||||||
may include expressions and mutually recursive definitions. Within the body,
|
|
||||||
each @racket[name] is bound to a number from @racket[1] to the number of stages
|
|
||||||
in order. Furthermore, during execution @racket[stage] is bound to the number
|
|
||||||
of the current stage and @racket[stage-name] is bound to a symbol representing
|
|
||||||
the @racket[name] of the current stage. By comparing @racket[stage] to the
|
|
||||||
numeric value of each @racket[name], or @racket[stage-name] to quoted symbols of
|
|
||||||
the form @racket['name], the user may compute based on the progression of the
|
|
||||||
stages.
|
|
||||||
|
|
||||||
}
|
|
||||||
|
|
||||||
@deftogether[(
|
|
||||||
@defform[#:id stage stage]
|
|
||||||
@defform[#:id stage-name stage-name]
|
|
||||||
)]{
|
|
||||||
|
|
||||||
These keywords are bound during the execution of @racket[staged] and should not
|
|
||||||
be used otherwise.
|
|
||||||
|
|
||||||
}
|
|
||||||
|
|
||||||
@defform[(slide/staged [name ...] arg ...)]{
|
|
||||||
|
|
||||||
Creates a staged slide. Equivalent to @racket[(staged [name ...] (slide arg
|
|
||||||
...))].
|
|
||||||
|
|
||||||
Within a staged slide, the boolean arguments to @racket[hide], @racket[show],
|
|
||||||
@racket[strike], and @racket[shade] can be used to determine in which stages to
|
|
||||||
perform a transformation. The macros @racket[pict-if], @racket[pict-cond],
|
|
||||||
@racket[pict-case], and @racket[pict-match] may also be used to create images
|
|
||||||
which change naturally between stages.
|
|
||||||
|
|
||||||
}
|
|
||||||
|
|
||||||
@section{Tables}
|
@section{Tables}
|
||||||
|
|
||||||
@defproc[(tabular [row (listof (or/c string? pict?))] ...
|
@defproc[(tabular [row (listof (or/c string? pict?))] ...
|
||||||
|
|
@ -314,89 +122,46 @@ Computes the width of one column out of @racket[n] that takes up a ratio of
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|
||||||
@addition{Vincent St-Amour}
|
@section{Staged Slides}
|
||||||
|
|
||||||
|
@defform[(staged [name ...] body ...)]{
|
||||||
|
|
||||||
|
Executes the @racket[body] terms once for each stage @racket[name]. The terms
|
||||||
|
may include expressions and mutually recursive definitions. Within the body,
|
||||||
|
each @racket[name] is bound to a number from @racket[1] to the number of stages
|
||||||
|
in order. Furthermore, during execution @racket[stage] is bound to the number
|
||||||
|
of the current stage and @racket[stage-name] is bound to a symbol representing
|
||||||
|
the @racket[name] of the current stage. By comparing @racket[stage] to the
|
||||||
|
numeric value of each @racket[name], or @racket[stage-name] to quoted symbols of
|
||||||
|
the form @racket['name], the user may compute based on the progression of the
|
||||||
|
stages.
|
||||||
|
}
|
||||||
|
|
||||||
@deftogether[(
|
@deftogether[(
|
||||||
@defproc[(ellipse/border [w real?] [h real?]
|
@defform[#:id stage stage]
|
||||||
[#:color color color/c]
|
@defform[#:id stage-name stage-name]
|
||||||
[#:border-color border-color color/c]
|
|
||||||
[#:border-width border-width real?])
|
|
||||||
pict?]
|
|
||||||
@defproc[(circle/border [diameter real?]
|
|
||||||
[#:color color color/c]
|
|
||||||
[#:border-color border-color color/c]
|
|
||||||
[#:border-width border-width real?])
|
|
||||||
pict?]
|
|
||||||
@defproc[(rectangle/border [w real?] [h real?]
|
|
||||||
[#:color color color/c]
|
|
||||||
[#:border-color border-color color/c]
|
|
||||||
[#:border-width border-width real?])
|
|
||||||
pict?]
|
|
||||||
@defproc[(rounded-rectangle/border [w real?] [h real?]
|
|
||||||
[#:color color color/c]
|
|
||||||
[#:border-color border-color color/c]
|
|
||||||
[#:border-width border-width real?])
|
|
||||||
pict?]
|
|
||||||
)]{
|
)]{
|
||||||
These functions create shapes with border of the given color and width.
|
|
||||||
|
These keywords are bound during the execution of @racket[staged] and should not
|
||||||
|
be used otherwise.
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@defform[(slide/staged [name ...] arg ...)]{
|
||||||
|
|
||||||
|
Creates a staged slide. Equivalent to @racket[(staged [name ...] (slide arg
|
||||||
|
...))].
|
||||||
|
|
||||||
|
Within a staged slide, the boolean arguments to @racket[hide], @racket[show],
|
||||||
|
@racket[strike], and @racket[shade] can be used to determine in which stages to
|
||||||
|
perform a transformation. The macros @racket[pict-if], @racket[pict-cond],
|
||||||
|
@racket[pict-case], and @racket[pict-match] may also be used to create images
|
||||||
|
which change naturally between stages.
|
||||||
|
}
|
||||||
|
|
||||||
|
@section{Miscellaneous Slide Utilities}
|
||||||
|
|
||||||
@addition{Scott Owens}
|
@addition{Scott Owens}
|
||||||
|
|
||||||
@defproc[(blank-line) pict?]{
|
@defproc[(blank-line) pict?]{
|
||||||
Adds a blank line of the current font size's height.
|
Adds a blank line of the current font size's height.
|
||||||
}
|
}
|
||||||
|
|
||||||
@deftogether[(
|
|
||||||
@defproc[(pin-label-line [label pict?] [pict pict?]
|
|
||||||
[src-pict pict-path?]
|
|
||||||
[src-coord-fn (-> pict-path? (values real? real?))]
|
|
||||||
[dest-pict pict-path?]
|
|
||||||
[dest-coord-fn (-> pict-path? (values real? real?))]
|
|
||||||
[#:start-angle start-angle (or/c real? #f)]
|
|
||||||
[#:end-angle end-angle (or/c real? #f)]
|
|
||||||
[#:start-pull start-pull real?]
|
|
||||||
[#:end-pull end-pull real?]
|
|
||||||
[#:line-width line-width (or/c real? #f)]
|
|
||||||
[#:color color (or/c #f string? (is-a?/c color%))]
|
|
||||||
[#:under? under? any/c]
|
|
||||||
[#:x-adjust x-adjust real?]
|
|
||||||
[#:y-adjust y-adjust real?])
|
|
||||||
pict?]
|
|
||||||
@defproc[(pin-arrow-label-line [label pict?] [arrow-size real?] [pict pict?]
|
|
||||||
[src-pict pict-path?]
|
|
||||||
[src-coord-fn (-> pict-path? (values real? real?))]
|
|
||||||
[dest-pict pict-path?]
|
|
||||||
[dest-coord-fn (-> pict-path? (values real? real?))]
|
|
||||||
[#:start-angle start-angle (or/c real? #f)]
|
|
||||||
[#:end-angle end-angle (or/c real? #f)]
|
|
||||||
[#:start-pull start-pull real?]
|
|
||||||
[#:end-pull end-pull real?]
|
|
||||||
[#:line-width line-width (or/c real? #f)]
|
|
||||||
[#:color color (or/c #f string? (is-a?/c color%))]
|
|
||||||
[#:under? under? any/c]
|
|
||||||
[#:hide-arrowhead? hide-arrowhead? any/c]
|
|
||||||
[#:x-adjust x-adjust real?]
|
|
||||||
[#:y-adjust y-adjust real?])
|
|
||||||
pict?]
|
|
||||||
@defproc[(pin-arrows-label-line [label pict?] [arrow-size real?] [pict pict?]
|
|
||||||
[src-pict pict-path?]
|
|
||||||
[src-coord-fn (-> pict-path? (values real? real?))]
|
|
||||||
[dest-pict pict-path?]
|
|
||||||
[dest-coord-fn (-> pict-path? (values real? real?))]
|
|
||||||
[#:start-angle start-angle (or/c real? #f)]
|
|
||||||
[#:end-angle end-angle (or/c real? #f)]
|
|
||||||
[#:start-pull start-pull real?]
|
|
||||||
[#:end-pull end-pull real?]
|
|
||||||
[#:line-width line-width (or/c real? #f)]
|
|
||||||
[#:color color (or/c #f string? (is-a?/c color%))]
|
|
||||||
[#:under? under? any/c]
|
|
||||||
[#:hide-arrowhead? hide-arrowhead? any/c]
|
|
||||||
[#:x-adjust x-adjust real?]
|
|
||||||
[#:y-adjust y-adjust real?])
|
|
||||||
pict?]
|
|
||||||
)]{
|
|
||||||
These functions behave like @racket[pin-line], @racket[pin-arrow-line]
|
|
||||||
and @racket[pin-arrows-line] with the addition of a label attached to
|
|
||||||
the line.
|
|
||||||
}
|
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue
Block a user