diff --git a/pkgs/slideshow-pkgs/slideshow-doc/scribblings/slideshow/guide.scrbl b/pkgs/slideshow-pkgs/slideshow-doc/scribblings/slideshow/guide.scrbl index fe959050ed..348a0d12fb 100644 --- a/pkgs/slideshow-pkgs/slideshow-doc/scribblings/slideshow/guide.scrbl +++ b/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") ] diff --git a/pkgs/slideshow-pkgs/slideshow-doc/scribblings/slideshow/slides.scrbl b/pkgs/slideshow-pkgs/slideshow-doc/scribblings/slideshow/slides.scrbl index 97a8cc650a..76c5ff9327 100644 --- a/pkgs/slideshow-pkgs/slideshow-doc/scribblings/slideshow/slides.scrbl +++ b/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.} @; ------------------------------------------------------------------------ diff --git a/pkgs/slideshow-pkgs/slideshow-lib/slideshow/base.rkt b/pkgs/slideshow-pkgs/slideshow-lib/slideshow/base.rkt index 8a8cc71b5e..a3629fccf2 100644 --- a/pkgs/slideshow-pkgs/slideshow-lib/slideshow/base.rkt +++ b/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)) diff --git a/pkgs/slideshow-pkgs/slideshow-lib/slideshow/core.rkt b/pkgs/slideshow-pkgs/slideshow-lib/slideshow/core.rkt index 64c9d6d419..a3333f0fd2 100644 --- a/pkgs/slideshow-pkgs/slideshow-lib/slideshow/core.rkt +++ b/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) diff --git a/pkgs/slideshow-pkgs/slideshow-lib/slideshow/sig.rkt b/pkgs/slideshow-pkgs/slideshow-lib/slideshow/sig.rkt index ea75694bfe..c816b46280 100644 --- a/pkgs/slideshow-pkgs/slideshow-lib/slideshow/sig.rkt +++ b/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 diff --git a/pkgs/slideshow-pkgs/slideshow-lib/slideshow/slide.rkt b/pkgs/slideshow-pkgs/slideshow-lib/slideshow/slide.rkt index 9c898241bb..94dab47b7f 100644 --- a/pkgs/slideshow-pkgs/slideshow-lib/slideshow/slide.rkt +++ b/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 diff --git a/pkgs/slideshow-pkgs/slideshow-lib/slideshow/slides-to-picts.rkt b/pkgs/slideshow-pkgs/slideshow-lib/slideshow/slides-to-picts.rkt index 9eb6249ea9..d9a5e5418f 100644 --- a/pkgs/slideshow-pkgs/slideshow-lib/slideshow/slides-to-picts.rkt +++ b/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]) diff --git a/pkgs/slideshow-pkgs/slideshow-lib/slideshow/viewer.rkt b/pkgs/slideshow-pkgs/slideshow-lib/slideshow/viewer.rkt index cd2b8cbeb2..6126e730e1 100644 --- a/pkgs/slideshow-pkgs/slideshow-lib/slideshow/viewer.rkt +++ b/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)