rktplayer/player.rkt

#lang racket

(require racket/class
         racket-sound
         "utils.rkt"
         )

(provide player%)

(define orig-current-seconds current-seconds)

(define player%
  (class object%
    (init-field [settings #f]
                [time-updater (λ (time-s length-s) #t)]
                [track-nr-updater (λ (nr) #t)]
                [state-updater (λ (state) #t)]
                [buffer-max-seconds 10]
                [buffer-min-seconds 4]
                )

    (define pl #f)
    (define state 'stopped)
    (define track -1)
    (define current-track -1)
    (define ct-data #f)
    (define closing #f)
    (define pause #f)
    
    (define ao-handle #f)
    (define flac-handle #f)
    
    (define current-rate 0)
    (define current-bits 0)
    (define current-channels 0)
    
    (define current-length 0)
    (define current-seconds 0)

    (define repeat 'no-repeat)   ;; no-repeat, repeat-1, repeat-all

    (define play-time-updater-state 'stopped)

    (define (set-state! st)
      (set! state st)
      (state-updater st))

    (define (check-ao-handle)
      (when (eq? ao-handle #f)
        (unless (or (= current-rate 0) (= current-bits 0) (= current-channels 0))
          (displayln (format "current-rate = ~a, current-bits = ~a, current-channels = ~a, ao-handle = ~a"
                            current-rate current-bits current-channels ao-handle))
          (displayln "Opening ao-handle")
          (let ((fmt (ao-mk-format current-bits current-rate current-channels 'big-endian)))
            (set! ao-handle (ao-open-live #f fmt))
            (start-play-time-updater)
            )
          )
        )
      )

    (define (start-play-time-updater)
      (when (eq? play-time-updater-state 'stopped)
        (set! play-time-updater-state 'updating)
        (displayln "Starting play-time-updater")
        (thread (λ ()
                  (define (updater)
                    (if (or (eq? ao-handle #f) closing)
                        (begin
                          (set! play-time-updater-state 'stopped)
                          (displayln "Terminating play-time-updater")
                          'done)
                        (let ((seconds (ao-at-second ao-handle))
                              (duration (ao-music-duration ao-handle))
                              )
                          (set! current-seconds seconds)
                          (time-updater current-seconds duration)
                          (sleep 0.1)
                          (updater))))
                  (updater)
                  )
                )
        )
      )

    (define (flac-play frame buffer)
        (unless (eq? state 'quitted)
          (let* ((sample (hash-ref frame 'number))
                 (rate (hash-ref frame 'sample-rate))
                 (second (/ (* sample 1.0) (* rate 1.0)))
                 (bits-per-sample (hash-ref frame 'bits-per-sample))
                 (bytes-per-sample (/ bits-per-sample 8))
                 (channels (hash-ref frame 'channels))
                 (bytes-per-sample-all-channels (* channels bytes-per-sample))
                 (duration (hash-ref frame 'duration))
                 )
            (set! current-rate rate)
            (set! current-bits bits-per-sample)
            (set! current-channels channels)
            (set! current-length duration)

            (check-ao-handle)
            (when (not (eq? ao-handle #f))
              (let ((buf-seconds-left (λ () (exact->inexact
                                             (/ (ao-bufsize-async ao-handle)
                                                bytes-per-sample-all-channels
                                                rate)))))
                (when (> (buf-seconds-left) buffer-max-seconds)
                  (while (and (not (eq? ao-handle #f))
                              (not closing)
                              (not pause)
                              (> (buf-seconds-left) buffer-min-seconds))
                         (sleep 0.25))))

              (when (not (eq? ao-handle #f))
                (ao-play ao-handle second duration buffer)
                )
              )

            (when pause
              (displayln "Pauzing now...")
              (ao-pause ao-handle #t)
              (while (and (not (eq? ao-handle #f))
                          (not closing)
                          pause)
                     (sleep 0.25))
              (ao-pause ao-handle #f)
              (displayln "Playing on...")
              )
            )
          )
      )

    (define (flac-meta meta)
      (displayln meta))

    (define (play-track-worker)
      (thread
       (λ ()
         (if (eq? ct-data #f)
             'no-track-data
             (let ((file (send ct-data get-file)))
               (displayln (format "opening flac handle for file: ~a" file))
               (set! flac-handle (flac-open file flac-meta flac-play))
               (displayln "Starting flac-read")
               (let ((result (flac-read flac-handle)))
                 (if (eq? result 'end-of-stream)
                   (set-state! 'track-feeded)
                   (displayln "Flac read stopped")))
               'worker-done
               )
             )
         )
       )
      (set-state! 'playing)
      'playing
      )

    (define (close-player*)
      (displayln "Closing flac handle")

      (set! closing #t)

      (unless (eq? flac-handle #f)
        (flac-stop flac-handle)
        (set! flac-handle #f))
      
      (set! current-rate 0)
      (set! current-channels 0)
      (set! current-bits 0)
      (set! ct-data #f)
      
      (unless (eq? ao-handle #f)
        (let ((h ao-handle))
          (displayln "closing ao-handle")
          (set! ao-handle #f)
          (displayln (format "ao-handle = ~a" h))
          (ao-close h)
          ))
      (displayln (format "close-player*: ao-handle = ~a" ao-handle))
      (displayln "Waiting for updater to stop")
      (while (eq? play-time-updater-state 'updating)
             (displayln (format "close-player*: ao-handle = ~a" ao-handle))
             (sleep 0.1))
      (displayln "resetting tracks")
      (set! track -1)
      (set! current-track -1)

      (set! closing #f)
      )
    
    (define (quit-player)
      (close-player*)
      (set-state! 'quitted)
      )

    (define (stop-and-clear)
      (set-state! 'stopped)
      (close-player*)
      )

    (define/public (next-track)
      (set! track (+ track 1))
      (if (>= track (send pl length))
          (begin
            (set-state! 'stopped)
            (track-nr-updater #f))
          (begin
            (set! ct-data (send pl track track))
            (set-state! 'play)
            (track-nr-updater track)
            )
          )
      )

    (define/public (play-track i)
      (displayln (format "play-track ~a" i))
      (set! state 'stopped)
      (close-player*)
      (displayln "Player closed")
      (set! track i)
      (set! ct-data (send pl track i))
      (set-state! 'play)
      (displayln (format "Set state to 'play, updating to track ~a" track))
      (track-nr-updater track)
      (displayln "track-nr-updater called")
      )

    (define/public (stop)
      (stop-and-clear)
      )

    (define/public (next)
      (if (= (send pl length) 0)
          #f
          (let ((idx track))
            (set! idx (+ idx 1))
            (when (>= idx (send pl length))
              (set! idx 0))
            (send this play-track idx))
          ))

    (define/public (previous)
      (if (= (send pl length) 0)
          #f
          (let ((idx track))
            (set! idx (- idx 1))
            (when (< idx 0)
              (set! idx (- (send pl length) 1)))
            (send this play-track idx)
            )))

    (define/public (pause-unpause)
      (set! pause (not pause))
      (displayln (format "pauzed: ~a" pause))
      )
    
    (define (state-machine)
      (let ((st (orig-current-seconds))
            (s (orig-current-seconds)))
        (define (worker)
          (if (eq? state 'quit)
              (begin
                (quit-player)
                'done)
              (begin
                (cond
                  ((eq? state 'stopped)
                   (sleep 0.01))
                  ((eq? state 'play)
                   (if (eq? pl #f)
                       (set-state! 'stoppped)
                       (play-track-worker)))
                  ((eq? state 'playing)
                   (sleep 0.01))
                  ((eq? state 'track-feeded)
                   (send this next-track))
                  )
                ;(let ((ns (orig-current-seconds)))
                ;  (when (> (- ns 5) s)
                ;    (displayln (format "state-machine: ~a" (- ns st)))
                ;    (set! s ns)))
                (worker)
                )
              ))
        (worker)))
  
    (define/public (play playlist)
      (stop-and-clear)
      ;(unless (eq? pl #f) (send pl display-tracks))
      (set! pl playlist)
      ;(unless (eq? pl #f) (send pl display-tracks))
      (send this play-track 0)
      )

    (define/public (quit)
      (set-state! 'quit)
      (while (not (eq? state 'quitted))
             (sleep 0.1))
      )

    (super-new)

    (begin
      (thread (λ () (state-machine)))
      )
    )
  )