diff --git a/collects/2htdp/tests/test-image.rkt b/collects/2htdp/tests/test-image.rkt index 33dc9caea5..2c71d071fe 100644 --- a/collects/2htdp/tests/test-image.rkt +++ b/collects/2htdp/tests/test-image.rkt @@ -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~?) diff --git a/collects/drracket/private/language.rkt b/collects/drracket/private/language.rkt index dc9e0a3684..2578f72b3c 100644 --- a/collects/drracket/private/language.rkt +++ b/collects/drracket/private/language.rkt @@ -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) diff --git a/collects/drracket/tool-lib.rkt b/collects/drracket/tool-lib.rkt index aad4e1da40..027395ce5c 100644 --- a/collects/drracket/tool-lib.rkt +++ b/collects/drracket/tool-lib.rkt @@ -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. }) diff --git a/collects/future-visualizer/main.rkt b/collects/future-visualizer/main.rkt index f4349721bb..4773764284 100644 --- a/collects/future-visualizer/main.rkt +++ b/collects/future-visualizer/main.rkt @@ -1,6 +1,6 @@ #lang racket/base (require racket/contract - slideshow/pict + pict racket/bool future-visualizer/trace "private/visualizer-gui.rkt" diff --git a/collects/future-visualizer/private/drawing-helpers.rkt b/collects/future-visualizer/private/drawing-helpers.rkt index 549b629c9c..7fc2fa6514 100644 --- a/collects/future-visualizer/private/drawing-helpers.rkt +++ b/collects/future-visualizer/private/drawing-helpers.rkt @@ -1,5 +1,5 @@ #lang racket/base -(require slideshow/pict +(require pict "display.rkt" "constants.rkt") (provide opacity-layer diff --git a/collects/future-visualizer/private/gui-helpers.rkt b/collects/future-visualizer/private/gui-helpers.rkt index 60a85aac30..40593fb749 100644 --- a/collects/future-visualizer/private/gui-helpers.rkt +++ b/collects/future-visualizer/private/gui-helpers.rkt @@ -1,6 +1,6 @@ #lang racket/gui (require framework - slideshow/pict + pict "display.rkt" "constants.rkt" "pict-canvas.rkt") diff --git a/collects/future-visualizer/private/pict-canvas.rkt b/collects/future-visualizer/private/pict-canvas.rkt index 21bf71b8dd..e3a6263f0a 100644 --- a/collects/future-visualizer/private/pict-canvas.rkt +++ b/collects/future-visualizer/private/pict-canvas.rkt @@ -1,6 +1,6 @@ #lang racket/gui (require framework - slideshow/pict + pict "display.rkt") (provide pict-canvas%) diff --git a/collects/future-visualizer/private/visualizer-drawing.rkt b/collects/future-visualizer/private/visualizer-drawing.rkt index 8706c2bbab..47d1f6a037 100644 --- a/collects/future-visualizer/private/visualizer-drawing.rkt +++ b/collects/future-visualizer/private/visualizer-drawing.rkt @@ -2,7 +2,7 @@ (require racket/list racket/class racket/draw - slideshow/pict + pict data/interval-map "visualizer-data.rkt" "graph-drawing.rkt" diff --git a/collects/games/scribblings/same.scrbl b/collects/games/scribblings/same.scrbl index 15cf6a69ad..48a61baf4a 100644 --- a/collects/games/scribblings/same.scrbl +++ b/collects/games/scribblings/same.scrbl @@ -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) diff --git a/collects/games/scribblings/tally-maze.scrbl b/collects/games/scribblings/tally-maze.scrbl index 48b8d30a4a..79a155ae1a 100644 --- a/collects/games/scribblings/tally-maze.scrbl +++ b/collects/games/scribblings/tally-maze.scrbl @@ -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)) diff --git a/collects/gui-debugger/debug-tool.rkt b/collects/gui-debugger/debug-tool.rkt index f6312c0fad..b01d16786a 100644 --- a/collects/gui-debugger/debug-tool.rkt +++ b/collects/gui-debugger/debug-tool.rkt @@ -28,7 +28,7 @@ images/icons/style images/icons/symbol images/icons/tool - slideshow/pict)) + pict)) (provide tool@) diff --git a/collects/images/scribblings/flomap.scrbl b/collects/images/scribblings/flomap.scrbl index b8681199cd..0f65fa2968 100644 --- a/collects/images/scribblings/flomap.scrbl +++ b/collects/images/scribblings/flomap.scrbl @@ -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 diff --git a/collects/images/scribblings/icons.scrbl b/collects/images/scribblings/icons.scrbl index b402a1ad3c..135b1ec7a9 100644 --- a/collects/images/scribblings/icons.scrbl +++ b/collects/images/scribblings/icons.scrbl @@ -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")) diff --git a/collects/meta/dist-specs.rkt b/collects/meta/dist-specs.rkt index abaeea7c11..df429e36f4 100644 --- a/collects/meta/dist-specs.rkt +++ b/collects/meta/dist-specs.rkt @@ -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") diff --git a/collects/mrlib/image-core.rkt b/collects/mrlib/image-core.rkt index 3d560e7950..bc5f7901e7 100644 --- a/collects/mrlib/image-core.rkt +++ b/collects/mrlib/image-core.rkt @@ -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" diff --git a/collects/pict/balloon.rkt b/collects/pict/balloon.rkt new file mode 100644 index 0000000000..6d2604ef73 --- /dev/null +++ b/collects/pict/balloon.rkt @@ -0,0 +1,5 @@ +#lang racket/base +(require texpict/balloon) +(provide (except-out (all-from-out texpict/balloon) + place-balloon)) + diff --git a/collects/pict/code.rkt b/collects/pict/code.rkt new file mode 100644 index 0000000000..62962e3cc9 --- /dev/null +++ b/collects/pict/code.rkt @@ -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)])) diff --git a/collects/pict/convert.rkt b/collects/pict/convert.rkt new file mode 100644 index 0000000000..4d80375700 --- /dev/null +++ b/collects/pict/convert.rkt @@ -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)]) diff --git a/collects/pict/face.rkt b/collects/pict/face.rkt new file mode 100644 index 0000000000..55a8ac2d5d --- /dev/null +++ b/collects/pict/face.rkt @@ -0,0 +1,3 @@ +#lang racket/base +(require texpict/face) +(provide (all-from-out texpict/face)) diff --git a/collects/pict/flash.rkt b/collects/pict/flash.rkt new file mode 100644 index 0000000000..75d59ac674 --- /dev/null +++ b/collects/pict/flash.rkt @@ -0,0 +1,4 @@ +#lang racket/base + +(require texpict/flash) +(provide (all-from-out texpict/flash)) diff --git a/collects/pict/info.rkt b/collects/pict/info.rkt new file mode 100644 index 0000000000..7043eff25b --- /dev/null +++ b/collects/pict/info.rkt @@ -0,0 +1,4 @@ +#lang setup/infotab + +(define scribblings + '(("scribblings/pict.scrbl" () (gui-library)))) diff --git a/collects/pict/main.rkt b/collects/pict/main.rkt new file mode 100644 index 0000000000..98eb6d9330 --- /dev/null +++ b/collects/pict/main.rkt @@ -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%))]) + )) diff --git a/collects/pict/scribblings/code.scrbl b/collects/pict/scribblings/code.scrbl new file mode 100644 index 0000000000..1ffa3da159 --- /dev/null +++ b/collects/pict/scribblings/code.scrbl @@ -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) diff --git a/collects/pict/scribblings/more.scrbl b/collects/pict/scribblings/more.scrbl new file mode 100644 index 0000000000..1572d5f97a --- /dev/null +++ b/collects/pict/scribblings/more.scrbl @@ -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) + diff --git a/collects/scribblings/slideshow/pict-diagram.rkt b/collects/pict/scribblings/pict-diagram.rkt similarity index 98% rename from collects/scribblings/slideshow/pict-diagram.rkt rename to collects/pict/scribblings/pict-diagram.rkt index c651669c37..4101fc4a74 100644 --- a/collects/scribblings/slideshow/pict-diagram.rkt +++ b/collects/pict/scribblings/pict-diagram.rkt @@ -1,5 +1,5 @@ #lang racket/base -(require slideshow/pict +(require pict racket/class racket/draw) diff --git a/collects/scribblings/slideshow/picts.scrbl b/collects/pict/scribblings/pict.scrbl similarity index 70% rename from collects/scribblings/slideshow/picts.scrbl rename to collects/pict/scribblings/pict.scrbl index 81939266cf..26b70a114b 100644 --- a/collects/scribblings/slideshow/picts.scrbl +++ b/collects/pict/scribblings/pict.scrbl @@ -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?]{ diff --git a/collects/plot/plot2d/plot.rkt b/collects/plot/plot2d/plot.rkt index 439cb7c745..1eac6f1ae5 100644 --- a/collects/plot/plot2d/plot.rkt +++ b/collects/plot/plot2d/plot.rkt @@ -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 diff --git a/collects/plot/plot3d/plot.rkt b/collects/plot/plot3d/plot.rkt index d1818110df..1db0d9d0e1 100644 --- a/collects/plot/plot3d/plot.rkt +++ b/collects/plot/plot3d/plot.rkt @@ -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 diff --git a/collects/plot/scribblings/common.rkt b/collects/plot/scribblings/common.rkt index 18878af32c..f11c568114 100644 --- a/collects/plot/scribblings/common.rkt +++ b/collects/plot/scribblings/common.rkt @@ -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 diff --git a/collects/plot/typed/plot2d/plot.rkt b/collects/plot/typed/plot2d/plot.rkt index 7b7a8a677f..bed2d405ca 100644 --- a/collects/plot/typed/plot2d/plot.rkt +++ b/collects/plot/typed/plot2d/plot.rkt @@ -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)] diff --git a/collects/plot/typed/plot3d/plot.rkt b/collects/plot/typed/plot3d/plot.rkt index f6afcdfc79..bdbe30e533 100644 --- a/collects/plot/typed/plot3d/plot.rkt +++ b/collects/plot/typed/plot3d/plot.rkt @@ -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)] diff --git a/collects/redex/scribblings/ref.scrbl b/collects/redex/scribblings/ref.scrbl index 3e1ddb087c..c97a5048d7 100644 --- a/collects/redex/scribblings/ref.scrbl +++ b/collects/redex/scribblings/ref.scrbl @@ -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} diff --git a/collects/redex/scribblings/tut.scrbl b/collects/redex/scribblings/tut.scrbl index 96a5f6c070..725c6baf96 100644 --- a/collects/redex/scribblings/tut.scrbl +++ b/collects/redex/scribblings/tut.scrbl @@ -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. diff --git a/collects/redex/tests/bitmap-test-util.rkt b/collects/redex/tests/bitmap-test-util.rkt index 126f0bf1da..9c3c6ee04a 100644 --- a/collects/redex/tests/bitmap-test-util.rkt +++ b/collects/redex/tests/bitmap-test-util.rkt @@ -1,6 +1,6 @@ #lang racket/base (require framework - slideshow/pict + pict racket/runtime-path racket/gui/base (for-syntax racket/base) diff --git a/collects/redex/tests/bitmap-test.rkt b/collects/redex/tests/bitmap-test.rkt index ccc3d35b0f..3826e5bdb5 100644 --- a/collects/redex/tests/bitmap-test.rkt +++ b/collects/redex/tests/bitmap-test.rkt @@ -1,7 +1,7 @@ #lang racket (require "bitmap-test-util.rkt" "../main.rkt" - slideshow/pict) + pict) ;; tests: ;; - language, diff --git a/collects/scribblings/draw/linear-gradient-class.scrbl b/collects/scribblings/draw/linear-gradient-class.scrbl index 75135357b0..eb1e9e7318 100644 --- a/collects/scribblings/draw/linear-gradient-class.scrbl +++ b/collects/scribblings/draw/linear-gradient-class.scrbl @@ -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% ()]{ diff --git a/collects/scribblings/draw/pen-class.scrbl b/collects/scribblings/draw/pen-class.scrbl index d7923b8e64..61fe0d2a7e 100644 --- a/collects/scribblings/draw/pen-class.scrbl +++ b/collects/scribblings/draw/pen-class.scrbl @@ -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% ()]{ diff --git a/collects/scribblings/draw/radial-gradient-class.scrbl b/collects/scribblings/draw/radial-gradient-class.scrbl index 88b8c01ca7..4b3ee89241 100644 --- a/collects/scribblings/draw/radial-gradient-class.scrbl +++ b/collects/scribblings/draw/radial-gradient-class.scrbl @@ -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% ()]{ diff --git a/collects/scribblings/guide/graphics.scrbl b/collects/scribblings/guide/graphics.scrbl index d3a1b61a3a..7148aa4faf 100644 --- a/collects/scribblings/guide/graphics.scrbl +++ b/collects/scribblings/guide/graphics.scrbl @@ -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. diff --git a/collects/scribblings/guide/module-hier.rkt b/collects/scribblings/guide/module-hier.rkt index b9b763c924..19c46ccca5 100644 --- a/collects/scribblings/guide/module-hier.rkt +++ b/collects/scribblings/guide/module-hier.rkt @@ -1,5 +1,5 @@ #lang racket/base -(require slideshow/pict +(require pict racket/draw racket/class racket/math) diff --git a/collects/scribblings/quick/mreval.rkt b/collects/scribblings/quick/mreval.rkt index 22756b5aa8..39a05a3a98 100644 --- a/collects/scribblings/quick/mreval.rkt +++ b/collects/scribblings/quick/mreval.rkt @@ -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 ...)) diff --git a/collects/scribblings/quick/quick.scrbl b/collects/scribblings/quick/quick.scrbl index bc19985abe..e08b446457 100644 --- a/collects/scribblings/quick/quick.scrbl +++ b/collects/scribblings/quick/quick.scrbl @@ -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) diff --git a/collects/scribblings/scribble/class-diagrams.rkt b/collects/scribblings/scribble/class-diagrams.rkt index 4f3feaeeb4..f474bda221 100644 --- a/collects/scribblings/scribble/class-diagrams.rkt +++ b/collects/scribblings/scribble/class-diagrams.rkt @@ -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 diff --git a/collects/scribblings/scribble/how-to-paper.scrbl b/collects/scribblings/scribble/how-to-paper.scrbl index 519aba24c5..d47069e1a0 100644 --- a/collects/scribblings/scribble/how-to-paper.scrbl +++ b/collects/scribblings/scribble/how-to-paper.scrbl @@ -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"). diff --git a/collects/scribblings/scribble/struct-hierarchy.rkt b/collects/scribblings/scribble/struct-hierarchy.rkt index 1c951369f0..06bebd3d83 100644 --- a/collects/scribblings/scribble/struct-hierarchy.rkt +++ b/collects/scribblings/scribble/struct-hierarchy.rkt @@ -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 diff --git a/collects/scribblings/slideshow/code.scrbl b/collects/scribblings/slideshow/code.scrbl index bc2187796b..8f0dd1e340 100644 --- a/collects/scribblings/slideshow/code.scrbl +++ b/collects/scribblings/slideshow/code.scrbl @@ -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] diff --git a/collects/scribblings/slideshow/guide.scrbl b/collects/scribblings/slideshow/guide.scrbl index bcdfc6a75e..d3cda8eb6b 100644 --- a/collects/scribblings/slideshow/guide.scrbl +++ b/collects/scribblings/slideshow/guide.scrbl @@ -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].} diff --git a/collects/scribblings/slideshow/slideshow.scrbl b/collects/scribblings/slideshow/slideshow.scrbl index 5c7991aa3c..3a374f2d93 100644 --- a/collects/scribblings/slideshow/slideshow.scrbl +++ b/collects/scribblings/slideshow/slideshow.scrbl @@ -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"] diff --git a/collects/scribblings/slideshow/ss.rkt b/collects/scribblings/slideshow/ss.rkt index 331a400c58..dcb9f77b62 100644 --- a/collects/scribblings/slideshow/ss.rkt +++ b/collects/scribblings/slideshow/ss.rkt @@ -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))) diff --git a/collects/slideshow/balloon.rkt b/collects/slideshow/balloon.rkt index 57f1629f68..c540d0a1ec 100644 --- a/collects/slideshow/balloon.rkt +++ b/collects/slideshow/balloon.rkt @@ -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)) diff --git a/collects/slideshow/code-pict.rkt b/collects/slideshow/code-pict.rkt index 51e2f62c3c..03e88fa744 100644 --- a/collects/slideshow/code-pict.rkt +++ b/collects/slideshow/code-pict.rkt @@ -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)) diff --git a/collects/slideshow/face.rkt b/collects/slideshow/face.rkt index e6c4c2f0ab..206aea1a24 100644 --- a/collects/slideshow/face.rkt +++ b/collects/slideshow/face.rkt @@ -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)) diff --git a/collects/slideshow/flash.rkt b/collects/slideshow/flash.rkt index dbdda3c939..4dab0c5665 100644 --- a/collects/slideshow/flash.rkt +++ b/collects/slideshow/flash.rkt @@ -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)) diff --git a/collects/slideshow/initial-ones.rkt b/collects/slideshow/initial-ones.rkt index 6f8657f4c7..a11a0d8519 100644 --- a/collects/slideshow/initial-ones.rkt +++ b/collects/slideshow/initial-ones.rkt @@ -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 diff --git a/collects/slideshow/pict-convert.rkt b/collects/slideshow/pict-convert.rkt index 90bb7f545c..b5334bb6d6 100644 --- a/collects/slideshow/pict-convert.rkt +++ b/collects/slideshow/pict-convert.rkt @@ -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)) diff --git a/collects/slideshow/pict-snipclass.rkt b/collects/slideshow/pict-snipclass.rkt index ff8b1ba220..e92ccb5fa7 100644 --- a/collects/slideshow/pict-snipclass.rkt +++ b/collects/slideshow/pict-snipclass.rkt @@ -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) diff --git a/collects/slideshow/pict.rkt b/collects/slideshow/pict.rkt index 98eb6d9330..06cffd52bc 100644 --- a/collects/slideshow/pict.rkt +++ b/collects/slideshow/pict.rkt @@ -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)) diff --git a/collects/slideshow/play.rkt b/collects/slideshow/play.rkt index 37c38ae6b4..a9d630a08a 100644 --- a/collects/slideshow/play.rkt +++ b/collects/slideshow/play.rkt @@ -1,6 +1,6 @@ #lang scheme/base (require slideshow/base - slideshow/pict + pict scheme/list scheme/math) diff --git a/collects/slideshow/private/image-snipr.rkt b/collects/slideshow/private/image-snipr.rkt index 12e5c8a7c0..abd21fa484 100644 --- a/collects/slideshow/private/image-snipr.rkt +++ b/collects/slideshow/private/image-snipr.rkt @@ -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) diff --git a/collects/slideshow/tutorial-show.rkt b/collects/slideshow/tutorial-show.rkt index 7e062ebfde..8c69ad6b81 100644 --- a/collects/slideshow/tutorial-show.rkt +++ b/collects/slideshow/tutorial-show.rkt @@ -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] diff --git a/collects/teachpack/door.ss b/collects/teachpack/door.ss index 87e5719e24..c7fcef4548 100644 --- a/collects/teachpack/door.ss +++ b/collects/teachpack/door.ss @@ -1,7 +1,5 @@ #lang slideshow -(require slideshow/pict) - (define DELTA 40) (define FT 12) diff --git a/collects/teachpack/nuworld.ss b/collects/teachpack/nuworld.ss index 3ade172e9f..42165575dc 100644 --- a/collects/teachpack/nuworld.ss +++ b/collects/teachpack/nuworld.ss @@ -1,6 +1,6 @@ #lang slideshow -(require slideshow/pict mred/mred) +(require racket/draw) (define DELTA 80) (define FT 12) diff --git a/collects/teachpack/server.ss b/collects/teachpack/server.ss index 8437684ecc..7a0576fb80 100644 --- a/collects/teachpack/server.ss +++ b/collects/teachpack/server.ss @@ -1,7 +1,5 @@ #lang slideshow -(require slideshow/pict) - (define DELTA 80) (define FT 12) diff --git a/collects/teachpack/world.ss b/collects/teachpack/world.ss index 03bdff88e4..9471ef567a 100644 --- a/collects/teachpack/world.ss +++ b/collects/teachpack/world.ss @@ -1,7 +1,5 @@ #lang slideshow -(require slideshow/pict) - (define DELTA 80) (define FT 12) diff --git a/collects/tests/racket/enter.rkt b/collects/tests/racket/enter.rkt index 6561df64e5..d8f089916b 100644 --- a/collects/tests/racket/enter.rkt +++ b/collects/tests/racket/enter.rkt @@ -10,4 +10,4 @@ (error "not in f?"))) ;; Make sure that `enter!' can work on lots of modules: -(enter! slideshow/pict) +(enter! pict) diff --git a/collects/unstable/gui/pict.rkt b/collects/unstable/gui/pict.rkt index 2738cb9b50..95e4183449 100644 --- a/collects/unstable/gui/pict.rkt +++ b/collects/unstable/gui/pict.rkt @@ -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 diff --git a/collects/unstable/gui/ppict.rkt b/collects/unstable/gui/ppict.rkt index efdf0a7993..4627a360c8 100644 --- a/collects/unstable/gui/ppict.rkt +++ b/collects/unstable/gui/ppict.rkt @@ -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") diff --git a/collects/unstable/gui/private/blur.rkt b/collects/unstable/gui/private/blur.rkt index 0df882576e..0374b2aa8a 100644 --- a/collects/unstable/gui/private/blur.rkt +++ b/collects/unstable/gui/private/blur.rkt @@ -5,7 +5,7 @@ racket/class racket/draw unstable/future - slideshow/pict) + pict) (define nneg-real/c (and/c real? (not/c negative?))) diff --git a/collects/unstable/gui/private/ppict-syntax.rkt b/collects/unstable/gui/private/ppict-syntax.rkt index 58fab48b87..b094017d9f 100644 --- a/collects/unstable/gui/private/ppict-syntax.rkt +++ b/collects/unstable/gui/private/ppict-syntax.rkt @@ -3,7 +3,7 @@ (for-template racket/base racket/contract/base racket/stxparam - slideshow/pict + pict "ppict.rkt")) (provide fragment-sequence) diff --git a/collects/unstable/gui/private/ppict.rkt b/collects/unstable/gui/private/ppict.rkt index bc9c10049d..f753d7308e 100644 --- a/collects/unstable/gui/private/ppict.rkt +++ b/collects/unstable/gui/private/ppict.rkt @@ -4,7 +4,7 @@ racket/class racket/stxparam racket/contract/base - slideshow/pict + pict "tag-pict.rkt") #| diff --git a/collects/unstable/gui/private/shframe.rkt b/collects/unstable/gui/private/shframe.rkt index 7090ba3e36..f220142b18 100644 --- a/collects/unstable/gui/private/shframe.rkt +++ b/collects/unstable/gui/private/shframe.rkt @@ -2,7 +2,7 @@ (require racket/math racket/class racket/draw - slideshow/pict + pict "blur.rkt") (provide shadow-frame arch) diff --git a/collects/unstable/gui/private/tag-pict.rkt b/collects/unstable/gui/private/tag-pict.rkt index a58d15ae79..0131be92b2 100644 --- a/collects/unstable/gui/private/tag-pict.rkt +++ b/collects/unstable/gui/private/tag-pict.rkt @@ -1,5 +1,5 @@ #lang racket/base -(require slideshow/pict) +(require pict) (provide tag-pict find-tag find-tag* diff --git a/collects/unstable/gui/pslide.rkt b/collects/unstable/gui/pslide.rkt index 6ffe92996f..c647a6ed55 100644 --- a/collects/unstable/gui/pslide.rkt +++ b/collects/unstable/gui/pslide.rkt @@ -4,7 +4,7 @@ "private/ppict-syntax.rkt") racket/contract/base slideshow/base - slideshow/pict + pict "private/ppict.rkt") ;; ============================================================ diff --git a/collects/unstable/gui/redex.rkt b/collects/unstable/gui/redex.rkt index 02bd1c5da5..e13971ffb9 100644 --- a/collects/unstable/gui/redex.rkt +++ b/collects/unstable/gui/redex.rkt @@ -2,7 +2,7 @@ (require racket/contract redex/reduction-semantics redex/pict - slideshow/pict + pict racket/list) ;; TO DO: diff --git a/collects/unstable/gui/scribble.rkt b/collects/unstable/gui/scribble.rkt index a0f2b6e6c3..876fe28931 100644 --- a/collects/unstable/gui/scribble.rkt +++ b/collects/unstable/gui/scribble.rkt @@ -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) diff --git a/collects/unstable/gui/slideshow.rkt b/collects/unstable/gui/slideshow.rkt index 01b207c965..469214fd7f 100644 --- a/collects/unstable/gui/slideshow.rkt +++ b/collects/unstable/gui/slideshow.rkt @@ -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) diff --git a/collects/unstable/scribblings/gui/pict.scrbl b/collects/unstable/scribblings/gui/pict.scrbl index 2562efffbc..ddeec67de5 100644 --- a/collects/unstable/scribblings/gui/pict.scrbl +++ b/collects/unstable/scribblings/gui/pict.scrbl @@ -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"]] diff --git a/collects/unstable/scribblings/gui/pslide.scrbl b/collects/unstable/scribblings/gui/pslide.scrbl index 4efd4659a4..24753f574d 100644 --- a/collects/unstable/scribblings/gui/pslide.scrbl +++ b/collects/unstable/scribblings/gui/pslide.scrbl @@ -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} diff --git a/collects/unstable/scribblings/gui/redex.scrbl b/collects/unstable/scribblings/gui/redex.scrbl index 7484f3bd3c..f63a00b042 100644 --- a/collects/unstable/scribblings/gui/redex.scrbl +++ b/collects/unstable/scribblings/gui/redex.scrbl @@ -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[]