cl-mpg123/example.lisp at master · Shirakumo/cl-mpg123 · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
(defpackage #:cl-mpg123-example
  (:use #:cl #:cffi)
  (:export #:main-low-level #:main-high-level)
  (:local-nicknames (:m :cl-mpg123-cffi)
                    (:o :cl-out123-cffi)
                    (:v :org.shirakumo.verbose)))
(in-package #:cl-mpg123-example)

(defmacro with-err-return (form)
  (let ((code (gensym "CODE")))
    `(let ((,code ,form))
       (when (eql :err ,code)
         (error "~a failed: ~a" ',form (m:strerror ,code))))))

(defmacro with-err-param (code form)
  `(with-foreign-object (,code :pointer)
     ,form
     (let ((,code (cffi:mem-ref ,code 'm:errors)))
       (when (eql :err ,code)
         (error "~a failed: ~a" ',form (m:strerror ,code))))))

(defmacro with-handles ((mpg-handle out-handle) &body body)
  `(let ((,mpg-handle (null-pointer))
         (,out-handle (null-pointer)))
     (unwind-protect
          (progn
            (with-err-param err (setf ,mpg-handle (m:new (null-pointer) err)))
            (setf ,out-handle (o:new))
            (when (null-pointer-p ,out-handle)
              (error "Failed to create output handler."))
            ,@body)
       (unless (null-pointer-p ,out-handle)
         (o:del ,out-handle))
       (unless (null-pointer-p ,mpg-handle)
         (m:close ,mpg-handle)
         (m:delete ,mpg-handle)))))

(defmacro with-mpeg-init (&body body)
  `(progn (with-err-return (m:init))
          (unwind-protect (progn ,@body)
            (m:exit))))

(defun mpeg-configure (encoding mpg-handle)
  (let ((enc (o:enc-byname encoding)))
    (m:format-none mpg-handle)
    (with-foreign-objects ((rates :pointer)
                           (ratec 'm:size_t))
      (m:rates rates ratec)
      (dotimes (i (cffi:mem-ref ratec 'm:size_t))
        (m:format mpg-handle
                  (cffi:mem-aref (cffi:mem-ref rates :pointer) :long i)
                  :mono-stereo
                  enc)))))

(defun mpeg-format (mpg-handle)
  (with-foreign-objects ((rate :long)
                         (channels :int)
                         (encoding :int))
    (with-err-return (m:getformat mpg-handle rate channels encoding))
    (values (cffi:mem-ref rate :long)
            (cffi:mem-ref channels :int)
            (cffi:mem-ref encoding :int))))

(defun out-info (out-handle)
  (with-foreign-objects ((driver :string)
                         (outfile :string))
    (with-err-return (o:driver-info out-handle driver outfile))
    (values (cffi:mem-ref driver :string)
            (cffi:mem-ref outfile :string))))

(defun out-format (out-handle)
  (with-foreign-objects ((rate :long)
                         (channels :int)
                         (encoding :int)
                         (framesize :int))
    (with-err-return (o:getformat out-handle rate channels encoding framesize))
    (values (cffi:mem-ref rate :long)
            (cffi:mem-ref channels :int)
            (cffi:mem-ref encoding :int)
            (cffi:mem-ref framesize :int))))

(defun main-low-level (file &key driver output encoding buffer-size)
  (let ((driver (or driver (null-pointer)))
        (output (or output (null-pointer))))
    (with-mpeg-init
      (with-handles (mpg-handle out-handle)
        (when encoding
          (mpeg-configure encoding mpg-handle))
        (with-err-return (m:open mpg-handle file))
        (multiple-value-bind (rate channels encoding) (mpeg-format mpg-handle)
          (m:format-none mpg-handle)
          (m:format mpg-handle rate channels encoding)
          (v:info :mpg123 "Input format ~a Hz, ~a channels, ~a encoded."
                  rate channels (o:enc-longname encoding))
          (with-err-return (o:open out-handle driver output))
          (multiple-value-bind (driver output) (out-info out-handle)
            (v:info :mpg123 "Playback device ~a / ~a" driver output))
          (with-err-return (o:start out-handle rate channels encoding))
          (multiple-value-bind (rate channels encoding framesize) (out-format out-handle)
            (v:info :mpg123 "Playback format ~a Hz, ~a channels, ~a encoded, ~a frames."
                    rate channels (o:enc-longname encoding) framesize))
          (let ((buffer-size (or buffer-size (m:outblock mpg-handle))))
            (with-foreign-objects ((buffer :char buffer-size)
                                   (read 'm:size_t))
              (loop do (with-err-return (m:read mpg-handle buffer buffer-size read))
                       (let* ((read (cffi:mem-ref read 'm:size_t))
                              (played (o:play out-handle buffer read)))
                         (when (/= played read)
                           (v:warn :mpg123 "Playback is not catching up with input by ~a bytes."
                                   (- read played)))
                         (when (<= read 0)
                           (return)))))))))))

(defun main-high-level (file &key driver output (buffer-size T))
  (let* ((file (cl-mpg123:connect (cl-mpg123:make-file file :buffer-size buffer-size)))
         (out  (cl-out123:connect (cl-out123:make-output driver :device output))))
    (v:info :mpg123 "Playback device ~a / ~a" (cl-out123:driver out) (cl-out123:device out))
    (multiple-value-bind (rate channels encoding) (cl-mpg123:file-format file)
      (v:info :mpg123 "Input format ~a Hz, ~a channels, ~a encoded." rate channels encoding)
      (cl-out123:start out :rate rate :channels channels :encoding encoding))
    (unwind-protect
         (loop with buffer = (cl-mpg123:buffer file)
               for read = (cl-mpg123:process file)
               for played = (cl-out123:play out buffer read)
               while (< 0 read)
               do (when (/= played read)
                    (v:warn :mpg123 "Playback is not catching up with input by ~a bytes."
                            (- read played))))
      (cl-out123:stop out)
      (cl-out123:disconnect out)
      (cl-mpg123:disconnect file))))