added --comment-on-slide

svn: r915

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

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)))
+		      (= pixel-scale 1)
-	(current-expected-text-scale (list (* (/ use-screen-w screen-w) pixel-scale)
+		      (not commentary-on-slide?)))
-					   (* (/ use-screen-h screen-h) pixel-scale))))
+	(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)

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^

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)

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