slideshow: add "spotlight" support

The spotlight is a replacement for the mouse pointer that
is bigger while obscuring less (which works better for
screencasts, for example).

pkgs/slideshow-pkgs/slideshow-doc/scribblings/slideshow/guide.scrbl

@@ -1,5 +1,7 @@
 #lang scribble/doc
-@(require "ss.rkt" scribble/struct)
+@(require "ss.rkt"
+          scribble/struct
+          scribble/decode)
 
 @(define (control-table . l)
    (make-table
@@ -8,7 +10,7 @@
            (list (make-flow (list (make-paragraph (list (hspace 2)))))
                  (make-flow (list (make-paragraph (list (car p)))))
                  (make-flow (list (make-paragraph (list (hspace 1) ":" (hspace 1)))))
-                 (make-flow (list (make-paragraph (list (cadr p)))))))
+                 (make-flow (list (decode-paragraph (list (cadr p)))))))
          l)))
 
 
@@ -70,6 +72,7 @@ Alt-q (or Meta-q) to end the slides. Here are more controls:
   (list "Alt-c, Cmd-c, or Meta-c"             "show/hide commentary")
   (list "Alt-d, Cmd-d, or Meta-d"             "show/hide preview")
   (list "Alt-m, Cmd-m, or Meta-m"             "show/hide mouse cursor")
+  (list "Alt-l, Cmd-l, or Meta-l"             "show/hide ``spotlight''")
   (list "Shift with arrow"                    "move window 1 pixel")
   (list "Alt, Meta, or Cmd with arrow"        "move window 10 pixels")
 ]

pkgs/slideshow-pkgs/slideshow-doc/scribblings/slideshow/slides.scrbl

@@ -325,7 +325,17 @@ input to the function is the default string and the slide
 number, and the result is what is drawn in the bottom right
 corner. The default parameter value just returns its first
 argument.
-} 
+}
+
+@defproc[(set-spotlight-style! [#:size size (or/c #f (>=/c 0)) #f]
+                               [#:color color (or/c #f string? (is-a?/c color%)) #f])
+         void?]{
+
+Adjusts the size and color of the ``spotlight,'' which can be enabled
+in Slideshow as an alternative to the mouse. Note that the color
+normally should have alpha value less than 1 (to make it partially
+transparent). If @racket[size] or @racket[color] is @racket[#f], the
+corresponding setting is unchanged.}
 
 @; ------------------------------------------------------------------------
 

pkgs/slideshow-pkgs/slideshow-lib/slideshow/base.rkt

@@ -45,4 +45,5 @@
 	   current-page-number-font current-page-number-color current-page-number-adjust
            current-titlet current-para-width
 	   set-page-numbers-visible! done-making-slides
+           set-spotlight-style!
            clickback interactive make-slide-inset slide-inset? apply-slide-inset))

pkgs/slideshow-pkgs/slideshow-lib/slideshow/core.rkt

@@ -165,6 +165,9 @@
       (define (set-page-numbers-visible! on?)
 	(viewer:set-page-numbers-visible! (and on? #t)))
 
+      (define (set-spotlight-style! #:size [size #f] #:color [color #f])
+        (viewer:set-spotlight-style! #:size size #:color color))
+
       (define current-page-number-font 
 	(make-parameter
 	 (make-object font% 10 'default 'normal 'normal)

pkgs/slideshow-pkgs/slideshow-lib/slideshow/sig.rkt

@@ -27,6 +27,7 @@
      enable-click-advance!
      set-page-numbers-visible!
      done-making-slides
+     set-spotlight-style!
      ;; Called when a clickback-containing slide is rendered:
      add-click-region!
      ;; Called when a interactive-containing slide is rendered:
@@ -80,6 +81,7 @@
      current-page-number-font current-page-number-color current-page-number-adjust
      current-titlet current-para-width
      set-page-numbers-visible! done-making-slides
+     set-spotlight-style!
      clickback
      interactive
      make-slide-inset

pkgs/slideshow-pkgs/slideshow-lib/slideshow/slide.rkt

@@ -128,6 +128,7 @@
 	   current-page-number-font current-page-number-color current-page-number-adjust
            current-titlet current-para-width
 	   set-page-numbers-visible! done-making-slides
+           set-spotlight-style!
            slide/timeout
            slide/title/timeout
            slide/center/timeout

pkgs/slideshow-pkgs/slideshow-lib/slideshow/slides-to-picts.rkt

@@ -60,6 +60,9 @@
                                           (define set-page-numbers-visible! void)
                                           (define add-click-region! void)
                                           (define add-interactive! void)
+                                          (define (set-spotlight-style! #:size [size #f] 
+                                                                        #:color [color #f])
+                                            (void))
                                           (define done-making-slides void))
                    CORE]))))
 	(parameterize ([current-namespace ns])

pkgs/slideshow-pkgs/slideshow-lib/slideshow/viewer.rkt

@@ -28,6 +28,7 @@
                       (viewer:set-use-background-frame! set-use-background-frame!)
                       (viewer:enable-click-advance! enable-click-advance!)
                       (viewer:set-page-numbers-visible! set-page-numbers-visible!)
+                      (viewer:set-spotlight-style! set-spotlight-style!)
                       (viewer:done-making-slides done-making-slides)))
               
       (define-accessor margin get-margin)
@@ -40,6 +41,10 @@
       (define show-page-numbers? #t)
       (define click-to-advance? #t)
       (define blank-cursor-allowed? #t)
+      (define spotlight-on? #f)
+      (define spotlight-shown? #f)
+      (define spotlight-size 36)
+      (define spotlight-color (make-color 230 230 0 0.5))
       (define click-regions null)
       (define interactives #hash())
       (define talk-slide-list null)
@@ -128,6 +133,11 @@
       (define (viewer:set-page-numbers-visible! on?)
 	(set! show-page-numbers? (and on? #t)))
       (viewer:set-page-numbers-visible! config:show-page-numbers?)
+
+      (define (viewer:set-spotlight-style! #:size [size #f]
+                                           #:color [color #f])
+        (when size (set! spotlight-size size))
+        (when color (set! spotlight-color color)))
       
       (define adjust-cursor (lambda () (send f set-blank-cursor #f)))
 
@@ -302,6 +312,13 @@
 			     (send e get-alt-down))
 		     (set! blank-cursor-allowed? (not blank-cursor-allowed?))
 		     (send f set-blank-cursor blank-cursor-allowed?))]
+		  [(#\l)
+		   (when (or (send e get-meta-down)
+			     (send e get-alt-down))
+		     (set! spotlight-on? (not spotlight-on?))
+                     (when spotlight-on?
+                       (set! spotlight-shown? #t))
+                     (send c refresh))]
 		  [else
 		   #f]))))
 
@@ -659,10 +676,13 @@
       (define c%
 	(class canvas%
 	  (inherit get-dc get-client-size make-bitmap
-                   client->screen)
+                   client->screen refresh)
-	  
+
 	  (define clicking #f)
 	  (define clicking-hit? #f)
+
+          (define mouse-x 0)
+          (define mouse-y 0)
 	  
 	  (define/override (on-paint)
 	    (let ([dc (get-dc)])
@@ -674,8 +694,23 @@
 	       [else
 		(send dc clear)
 		(paint-slide this dc)])
+              (show-spotlight dc)
               (show-time dc)))
 
+          (define/private (show-spotlight dc)
+            (when (and spotlight-on? spotlight-shown?)
+              (define old-p (send dc get-pen))
+              (define old-b (send dc get-brush))
+              (send dc set-pen "black" 0 'transparent)
+              (send dc set-brush spotlight-color 'solid)
+              (send dc draw-ellipse 
+                    (- mouse-x (/ spotlight-size 2))
+                    (- mouse-y (/ spotlight-size 2))
+                    spotlight-size
+                    spotlight-size)
+              (send dc set-pen old-p)
+              (send dc set-brush old-b)))
+
           (define/private (show-time dc)
             (when config:show-time?
               (define c (send dc get-text-foreground))
@@ -700,6 +735,13 @@
 	  
 	  (inherit get-top-level-window)
 	  (define/override (on-event e)
+            (unless (and (= mouse-x (send e get-x))
+                         (= mouse-y (send e get-y)))
+              (set! mouse-x (send e get-x))
+              (set! mouse-y (send e get-y))
+              (when spotlight-on?
+                (set! spotlight-shown? #t)
+                (refresh)))
 	    (cond
 	     [(send e button-down?)
 	      (let ([c (ormap
@@ -873,6 +915,7 @@
 		(let ([dc (get-dc)])
 		  (send dc clear)
 		  (paint-slide this dc))])
+              (show-spotlight (get-dc))
               (show-time (get-dc))
               (swap-interactives! old-interactives interactives)))
 
@@ -1160,6 +1203,7 @@
       (define refresh-page
 	(lambda ([immediate-prefetch? #f])
 	  (hide-cursor-until-moved)
+          (set! spotlight-shown? #f)
 	  (send f set-blank-cursor #t)
 	  (when (= current-page 0)
 	    (set! start-time #f)