(module slideshow-frlib "frtime/frtime.ss"
  (require (rename (lib "math.ss") pi pi)
           (as-is:unchecked (lib "mrpict.ss" "texpict") dc-for-text-size)
           (rename "frtime/frp-core.ss" do-in-manager do-in-manager)
           (as-is:unchecked (lib "class.ss") new make-object send)
           (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)))
  
  (define (make-stager bck adv)
    (let ([key-events (current-slide/key-events)])
      (/
       (hold
        (collect-e key-events 0
                   (lambda (evt accum)
                     (if (eq? (send evt get-key-code) adv)
                         (add1 accum)
                         (if (eq? (send evt get-key-code) bck)
                             (max 0 (sub1 accum))
                             accum))))
        0)
       2)))
  
  (define make-stager/event
    (case-lambda
      [(bck-evts adv-evts)
       (make-stager/event bck-evts adv-evts (event-receiver))]
      [(bck-evts adv-evts reset-evts)
       (hold (collect-e (merge-e (map-e (lambda (e) 'adv) adv-evts)
                                 (map-e (lambda (e) 'bck) bck-evts)
                                 (map-e (lambda (e) 'reset) reset-evts))
                        0
                        (lambda (evt accum)
                          (case evt
                            [(adv) (add1 accum)]
                            [(bck) (max (sub1 accum) 0)]
                            [(reset) 0]
                            [else 
                             (error 'make-stager/event "Internal Fatal Error: fall through.")])))
             0)]))


           
                   
      
      

  
  (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
           make-stager
           make-stager/event
           wave
           pi))