#!/bin/sh
exec ${GUILE-guile} -e '(ttn-do audio-cd-control)' -s $0 "$@" # -*- scheme -*-
!#
;;; audio-cd-control --- control the CD player via Guile-SDL

;; Copyright (C) 2007, 2008, 2009, 2010 Thien-Thi Nguyen
;;
;; This file is part of ttn-do, released under the terms of the
;; GNU General Public License as published by the Free Software
;; Foundation; either version 3, or (at your option) any later
;; version.  There is NO WARRANTY.  See file COPYING for details.

;;; Commentary:

;; Usage: audio-cd-control [COMMAND]
;;
;; If COMMAND is omitted, it defaults to `q'.
;; The recognized commands are:
;;
;;  `q' (query) displays track count and times for the CD.
;;  `p' (pause) pauses a currently playing CD.
;;  `r' (resume) resumes a currently paused CD.
;;  `s' (stop) stops the CD player.
;;  `m' (monitor) shows current track and time, every second.
;;  `e' (eject) ejects the CD from the player.
;;  N (a number 1, 2, ...) starts playing track N.

;;; Code:

(define-module (ttn-do audio-cd-control)
  #:export (act)
  #:use-module ((ttn-do zzz banalities) #:select (check-hv))
  #:use-module ((ttn-do zzz personally) #:select (fso))
  #:use-module ((sdl sdl) #:prefix SDL: #:select (init
                                                  was-init
                                                  cd-open
                                                  cd-status
                                                  cd-get-num-tracks
                                                  cd-get-cur-track
                                                  cd-get-cur-frame
                                                  cd-get-nth-track
                                                  cd-play-tracks
                                                  cd-pause
                                                  cd-resume
                                                  cd-stop
                                                  cd-eject
                                                  cd-close
                                                  cd-frames->msf)))

;; Do @var{command}, a symbol (q, p, r, s, m) or integer.
;;
(define (act command)
  (or (SDL:was-init 'SDL_INIT_CDROM)
      (zero? (SDL:init 'SDL_INIT_CDROM))
      (error "could not init SDL subsystem: cdrom"))

  (let ((c (or (SDL:cd-open)
               (error "could not open cdrom"))))

    (define (status)
      (SDL:cd-status c))

    (define (show-status)
      (fso "status: ~A~%" (status)))

    (define (monitor-1 prefix)
      (status)
      (let* ((f (SDL:cd-get-cur-frame c))
             (msf (SDL:cd-frames->msf f)))
        (fso "~A~A -- ~Am ~As~%" prefix
             (1+ (SDL:cd-get-cur-track c))
             (assq-ref msf 'm)
             (assq-ref msf 's))
        (usleep (- 1000000 (quotient (* 1000000 (assq-ref msf 'f)) 75)))))

    (define (monitor)
      (while (eq? 'PLAYING (status))
        (monitor-1 "track ")))

    (define (dispatch)
      (case command
        ((q) (or (memq (status) '(TRAYEMPTY ERROR))
                 (let ((tot (SDL:cd-get-num-tracks c)))
                   (fso "tracks: ~A~%" tot)
                   (do ((i 0 (1+ i)))
                       ((= i tot))
                     (let* ((info (SDL:cd-get-nth-track c i))
                            (msf (SDL:cd-frames->msf (assq-ref info 'length))))
                       (fso " ~A: ~Am ~As~%"
                            (assq-ref info 'id)
                            (assq-ref msf 'm)
                            (assq-ref msf 's))))
                   (set! show-status noop)
                   (or (eq? 'STOPPED (status))
                       (monitor-1 "currently-playing: ")))))
        ((p) (SDL:cd-pause c))
        ((r) (SDL:cd-resume c))
        ((s) (SDL:cd-stop c))
        ((m) (monitor))
        ((e) (SDL:cd-eject c))
        (else
         (or (number? command)
             (error "bad command (try one of: q, p, r, s, m, e, 1, 2, ...)"))
         (SDL:cd-play-tracks c (1- command) 0 0 0)
         (show-status)
         (monitor))))

    (define (finish)
      (show-status)
      (SDL:cd-close c))

    ;; do it!
    (dynamic-wind show-status dispatch finish)
    #t))

(define (main args)
  (check-hv args '((package . "ttn-do")
                   (version . "1.1")
                   (help . commentary)))
  (act (if (null? (cdr args))
           'q
           (with-input-from-string (cadr args) read))))

;;; audio-cd-control ends here