(module slideshow-frlib (lib "frtime.ss" "fta" "slideshow" "private" "frtime") (require (rename (lib "math.ss") pi pi) (as-is:unchecked (lib "mrpict.ss" "texpict") dc-for-text-size) (rename (lib "frp-core.ss" "fta" "slideshow" "private" "frtime") do-in-manager do-in-manager) (as-is:unchecked (lib "class.ss") new make-object) (all-except (lib "mred.ss" "mred") send-event)) (define set-dc-for-text-size (let ([dc (new bitmap-dc% (bitmap (make-object bitmap% 1 1 #f)))]) (lambda () (do-in-manager (dc-for-text-size dc))))) (define current-slide/time (make-parameter 0)) (define current-slide/mouse-x (make-parameter undefined)) (define current-slide/mouse-y (make-parameter undefined)) (define current-slide/key-events (make-parameter (event-receiver))) (define (repeat/0->1 duration) (let ([slide-time (current-slide/time)]) (/ (modulo slide-time duration) duration))) (define (wave wavelength) (/ (+ 1 (sin (* 2 pi (+ (/ 3 4) (repeat/0->1 wavelength))))) 2)) (define (make-timer interval) (let ([time-of-last (new-cell (value-now milliseconds))] [rtn (event-receiver)]) (for-each-e! (changes (> (- milliseconds time-of-last) interval)) (lambda (x) (if x (begin (send-event rtn 'alarm) (set-cell! time-of-last (value-now milliseconds)))))) rtn)) (define (transition/new-time start-val wait end-thunk) (let ([slide-time (current-slide/time)]) (if (< slide-time wait) start-val (parameterize ([current-slide/time (- slide-time (value-now slide-time))]) (end-thunk))))) (define (transition/thunk start-val wait end-thunk) (let ([slide-time (current-slide/time)]) (if (< slide-time wait) start-val (end-thunk)))) (define (transition/delay start-val wait end-val) (let ([slide-time (current-slide/time)]) (if (< slide-time wait) start-val end-val))) (define (transition/trigger start-val trigger end-val) (if trigger start-val end-val)) (define (transition/trigger-thunk start-thunk trigger end-thunk) (if trigger (start-thunk) (end-thunk))) (provide current-slide/time current-slide/mouse-x current-slide/mouse-y current-slide/key-events set-dc-for-text-size make-timer repeat/0->1 transition/new-time transition/thunk transition/delay transition/trigger transition/trigger-thunk wave pi))