fta/slideshow/private/slideshow-frlib.ss
(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))