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

@@ -327,6 +327,16 @@ 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.}
+
 @; ------------------------------------------------------------------------
 
 @section{Constants and Layout Variables}

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)
@@ -129,6 +134,11 @@
 	(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)))
 
       (define (add-click-region! cr)
@@ -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,11 +676,14 @@
       (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)])
 	      (stop-transition/no-refresh)
@@ -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)