added --comment-on-slide

svn: r915
This commit is contained in:
Matthew Flatt 2005-09-25 19:29:04 +00:00
parent 8307ecdd8b
commit dc7ddab153
5 changed files with 58 additions and 9 deletions

View File

@ -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

View File

@ -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)

View File

@ -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^

View File

@ -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)

View File

@ -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:~