diff --git a/collects/slideshow/cmdline.ss b/collects/slideshow/cmdline.ss index a1f6bd5293..4a22f6b56e 100644 --- a/collects/slideshow/cmdline.ss +++ b/collects/slideshow/cmdline.ss @@ -49,6 +49,7 @@ (define printing? #f) (define native-printing? #f) (define commentary? #f) + (define commentary-on-slide? #f) (define show-gauge? #f) (define keep-titlebar? #f) (define show-page-numbers? #t) @@ -133,8 +134,11 @@ (set! use-prefetch-in-preview? #t)) (("--keep-titlebar") "give the slide window a title bar and resize border" (set! keep-titlebar? #t)) - (("--comment") "display commentary" + (("--comment") "display commentary in window" (set! commentary? #t)) + (("--comment-on-slide") "display commentary on slide" + (set! commentary? #t) + (set! commentary-on-slide? #t)) (("--time") "time seconds per slide" (set! print-slide-seconds? #t))] [args slide-module-file (cond diff --git a/collects/slideshow/core.ss b/collects/slideshow/core.ss index ca718f4456..90fda16be9 100644 --- a/collects/slideshow/core.ss +++ b/collects/slideshow/core.ss @@ -55,11 +55,17 @@ (define current-line-sep (make-parameter line-sep)) + (define commentary-content-scale 0.8) + (when (not (and (= use-screen-w screen-w) (= use-screen-h screen-h) - (= pixel-scale 1))) - (current-expected-text-scale (list (* (/ use-screen-w screen-w) pixel-scale) - (* (/ use-screen-h screen-h) pixel-scale)))) + (= pixel-scale 1) + (not commentary-on-slide?))) + (let ([c-scale (if commentary-on-slide? + commentary-content-scale + 1)]) + (current-expected-text-scale (list (* (/ use-screen-w screen-w) pixel-scale c-scale) + (* (/ use-screen-h screen-h) pixel-scale c-scale))))) (define red "red") (define green "forest green") @@ -165,9 +171,43 @@ (define page-number 1) + (define (add-commentary p comment) + (if commentary-on-slide? + (let ([p (scale (frame + (inset (let ([tp (launder full-page)]) + (refocus (lt-superimpose p tp) tp)) + margin)) + commentary-content-scale)] + [t (if comment + (let ([comments (let loop ([l (just-a-comment-content comment)] + [current-line null]) + (cond + [(null? l) (list (reverse current-line))] + [(pict? (car l)) + (loop (cdr l) (cons (car l) (current-line)))] + [else (let ([m (regexp-match #rx"^(.*?)(?:\n|\r\n|\r)[ \t]*(.*)$" (car l))]) + (if m + (cons + (reverse (cons (cadr m) current-line)) + (loop (cons (caddr m) (cdr l)) + null)) + (loop (cdr l) (cons (car l) current-line))))]))]) + (parameterize ([current-font-size 9]) + (apply vl-append + 1 + (map (lambda (l) + (apply para (- (* screen-w (- 1 commentary-content-scale)) + margin margin 2) + l)) + comments)))) + (blank))]) + (ht-append 2 p t)) + p)) + (define (add-slide! pict title comment page-count inset) (viewer:add-talk-slide! - (make-sliderec (make-pict-drawer pict) + (make-sliderec (make-pict-drawer (add-commentary pict + comment)) title comment page-number @@ -406,7 +446,9 @@ (make-sliderec (let ([orig (sliderec-drawer s)] [extra (if addition - (make-pict-drawer addition) + (make-pict-drawer + (add-commentary addition + #f)) void)]) (lambda (dc x y) (orig dc x y) diff --git a/collects/slideshow/sig.ss b/collects/slideshow/sig.ss index f832391ddd..4945822e90 100644 --- a/collects/slideshow/sig.ss +++ b/collects/slideshow/sig.ss @@ -12,7 +12,8 @@ use-screen-w use-screen-h ; "pixel" size pixel-scale ; amount the "pixels" are scaled (e.g., for quad) condense? printing? ; mode - smoothing?)) + smoothing? + commentary-on-slide?)) ;; Viewer inputs to the core unit: (define-signature viewer^ diff --git a/collects/slideshow/slides-to-picts.ss b/collects/slideshow/slides-to-picts.ss index 6273a37ba9..0d73f0af96 100644 --- a/collects/slideshow/slides-to-picts.ss +++ b/collects/slideshow/slides-to-picts.ss @@ -38,7 +38,8 @@ (define pixel-scale 1) (define condense? c?) (define printing? #f) - (define smoothing? #t)))] + (define smoothing? #t) + (define commentary-on-slide? #f)))] [CORE : core^ (core@ CONFIG (VIEWER : viewer^))] [VIEWER : viewer^ ((unit/sig viewer^ (import) diff --git a/collects/slideshow/viewer.ss b/collects/slideshow/viewer.ss index f034b3cf4c..843bde6943 100644 --- a/collects/slideshow/viewer.ss +++ b/collects/slideshow/viewer.ss @@ -1047,7 +1047,8 @@ (when (send bm ok?) (send f set-icon bm (and (send mbm ok?) mbm) 'both))) - (when config:commentary? + (when (and config:commentary? + (not config:commentary-on-slide?)) (send c-frame show #t) (message-box "Instructions" (format "Keybindings:~