Coverage report: /home/ellis/comp/core/lib/cli/tools/media.lisp

Kind	Covered	All	%
expression	0	395	0.0
branch	0	22	0.0

Key

Not instrumented

Conditionalized out

Executed

Not executed

Both branches taken

One branch taken

Neither branch taken

1

;;; media.lisp --- CLI Media Tools

2

3

;;

4

5

;;; Code:

6

(in-package :cli/tools/media)

7

8

(define-cli-tool :ffmpeg (args &optional (output *standard-output*))

9

(let ((proc (sb-ext:run-program *ffmpeg* args :wait t :output output)))

10

(unless (eq 0 (sb-ext:process-exit-code proc))

11

(ffmpeg-error "FFMPEG command failed: ~A ~A" *ffmpeg* (or args "")))))

12

13

#|

14

D..... = Decoding supported

15

.E.... = Encoding supported

16

..V... = Video codec

17

..A... = Audio codec

18

..S... = Subtitle codec

19

..D... = Data codec

20

..T... = Attachment codec

21

...I.. = Intra frame-only codec

22

....L. = Lossy compression

23

.....S = Lossless compression

24

|#

25

(define-bitfield ffmpeg-codec-props

26

(decode boolean)

27

(encode boolean)

28

(type (member :video :audio :subtitle :data :attachment))

29

(intra boolean)

30

(lossy boolean)

31

(lossless boolean))

32

33

(defun list-ffmpeg-codec-props (i)

34

(list

35

:decode (ffmpeg-codec-props-decode i)

36

:encode (ffmpeg-codec-props-encode i)

37

:type (ffmpeg-codec-props-type i)

38

:intra (ffmpeg-codec-props-intra i)

39

:lossy (ffmpeg-codec-props-lossy i)

40

:lossless (ffmpeg-codec-props-lossless i)))

41

42

(defun parse-ffmpeg-codec-type (char)

43

(ecase char

44

(#\V :video)

45

(#\A :audio)

46

(#\S :subtitle)

47

(#\D :data)

48

(#\T :attachment)))

49

50

(defun parse-ffmpeg-codec-props (str)

51

"DEVILS"

52

(make-ffmpeg-codec-props

53

:decode (char= #\D (schar str 0))

54

:encode (char= #\E (schar str 1))

55

:type (parse-ffmpeg-codec-type (schar str 2))

56

:intra (char= #\I (schar str 3))

57

:lossy (char= #\L (schar str 4))

58

:lossless (char= #\S (schar str 5))))

59

60

(defstruct ffmpeg-codec (props 0 :type ffmpeg-codec-props) name description)

61

62

(defmethod print-object ((self ffmpeg-codec) stream)

63

(format stream "#S(~A ~A ~{~S~^ ~})"

64

(type-of self)

65

(ffmpeg-codec-name self)

66

(list-ffmpeg-codec-props (ffmpeg-codec-props self))))

67

68

(defun read-ffmpeg-codec (stream)

69

(when-let ((props (string (read stream nil nil)))

70

(name (read stream nil nil))

71

(description (trim (read-line stream nil nil))))

72

(make-ffmpeg-codec :props (parse-ffmpeg-codec-props props) :name name :description description)))

73

74

(defun list-ffmpeg-codecs ()

75

(let ((ret (with-output-to-string (s)

76

(run-ffmpeg (list "-v" "0" "-codecs") s))))

77

(when-let ((i (search " -------" ret)))

78

(with-input-from-string (s (subseq ret (+ i 9)))

79

(loop for f = (print (read-ffmpeg-codec s))

80

while f

81

collect f)))))

82

83

(defstruct ffmpeg-format props name description)

84

85

(defmethod print-object ((self ffmpeg-format) stream)

86

(format stream "#S(~A ~A ~{~S~^ ~})"

87

(type-of self)

88

(ffmpeg-format-name self)

89

(list-ffmpeg-format-props (ffmpeg-format-props self))))

90

91

(define-bitfield ffmpeg-format-props

92

(mux boolean)

93

(demux boolean)

94

(device boolean))

95

96

(defun list-ffmpeg-format-props (i)

97

(list

98

:mux (ffmpeg-format-props-mux i)

99

:demux (ffmpeg-format-props-demux i)

100

:device (ffmpeg-format-props-device i)))

101

102

(defun parse-ffmpeg-format-props (str)

103

(make-ffmpeg-format-props

104

:demux (find #\D str)

105

:mux (find #\E str)

106

:device (find #\d str)))

107

108

(defun read-ffmpeg-format (stream)

109

(when-let ((props (string (read stream nil nil)))

110

(name (read stream nil nil))

111

(description (trim (read-line stream nil nil))))

112

(make-ffmpeg-format :props (parse-ffmpeg-format-props props) :name name :description description)))

113

114

(defun list-ffmpeg-formats ()

115

(let ((ret (with-output-to-string (s)

116

(run-ffmpeg (list "-v" "0" "-formats") s))))

117

(when-let ((i (search " ---" ret)))

118

(with-input-from-string (s (subseq ret (+ i 5)))

119

(loop for f = (print (read-ffmpeg-format s))

120

while f

121

collect f)))))

122

123

(define-cli-tool :mpv (&rest args)

124

(let ((proc (sb-ext:run-program *mpv* args :wait t :output t)))

125

(unless (eq 0 (sb-ext:process-exit-code proc))

126

(mpv-error "MPV command failed: ~A ~A" *mpv* (or args "")))))

127

128

(defvar *mpv-config-path* (merge-homedir-pathnames ".config/mpv/mpv.conf"))

129

130

;; incomplete config description

131

(defconfig mpv-config (cli-tool-config ini-document)

132

(fs

133

profile

134

hwdec

135

user-agent

136

alang

137

slang))

138

139

(defmethod make-config ((self (eql :mpv)) &rest args &key path &allow-other-keys)

140

(if (remf args :path)

141

(load-ast (apply 'change-class (deserialize path :ini) 'mpv-config args))

142

(apply 'make-instance 'mpv-config args)))

143

144

(defmethod load-ast ((self mpv-config))

145

(with-slots (ast) self

146

(if (formp ast)

147

(mapc

148

(lambda (x)

149

(let ((k (car x)) (v (cdr x)))

150

              (when-let ((s (print (find-symbol* (string-upcase k) #.*package* nil)))) ;; needs to be correct package

151

(unless (null v)

152

(setf v

153

(case k

154

(:fs v)

155

(:hwdec v)

156

(:alang v)

157

(:slang v)

158

(t v)))

159

(setf (slot-value self s) v)))))

160

ast)

161

;; invalid ast, signal error

162

(error 'syntax-error)))

163

(unless *keep-ast* (setf (ast self) nil))

164

self)

165

166

(defun load-mpv-config (&optional (path *mpv-config-path*))

167

(when (probe-file path)

168

(make-config :mpv :path path)))

169

170

(define-cli-tool :wireplumber (&rest args)

171

(let ((proc (sb-ext:run-program *wireplumber* args :wait t :output t)))

172

(unless (eq 0 (sb-ext:process-exit-code proc))

173

(wireplumber-error "WIREPLUMBER command failed: ~A ~A" *wireplumber* (or args "")))))

174

175

(define-cli-tool :picard (args &key (wait t) (output t))

176

(let ((proc (sb-ext:run-program *picard* args :wait wait :output output)))

177

(unless (positive-integer-p #1=(sb-ext:process-exit-code proc))

178

       (picard-error "PICARD command failed: ~A ~{~A ~^~}~%exit-code = ~A" *picard* (or args "") #1#))))

179

180

(defvar *picard-config-path* (merge-homedir-pathnames ".config/MusicBrainz/Picard.ini"))

181

182

(defconfig picard-config (cli-tool-config ini-document) ())

183

184

(defmethod make-config ((self (eql :picard)) &rest args &key path &allow-other-keys)

185

(if (remf args :path)

186

(apply 'change-class (deserialize path :ini) 'picard-config args)

187

(apply 'make-instance 'picard-config args)))

188

189

(defun load-picard-config (&optional (path *picard-config-path*))

190

(when (probe-file path)

191

(make-config :picard :path path)))

192

193

(defvar *picard-commands*

194

'(:clear-logs

195

:cluster

196

:fingerprint

197

:from-file

198

:load

199

:lookup

200

:lookup-cd

201

:pause

202

:quit

203

:remove

204

:remove-all

205

:remove-empty

206

:remove-saved

207

:save-matched

208

:scan

209

:show

210

:submit-fingerprints

211

:write-logs))

212

213

(eval-always

214

(defun picard-cmd (cmd)

215

(when (member cmd *picard-commands*)

216

(substitute #\_ #\- (string-upcase cmd)))))

217

218

;; TODO 2025-04-05:

219

(defun %do-picard (body)

220

"Execute a sequence of forms where atoms are interpreted by picard as commands

221

or arguments and lists are evaluated interpreted as args."

222

(let ((cmd) (args) (ret))

223

(loop for i below (length body)

224

for a in body

225

do (typecase a

226

(symbol (if cmd

227

(progn

228

(push (cons cmd args) ret)

229

(setf cmd a

230

args nil))

231

(setf cmd a)))

232

(t (push (format nil "~A" a) args)))

233

finally

234

(progn

235

(when cmd (push (cons cmd args) ret))

236

(return (nreverse ret))))))

237

238

(defun exec-picard (&rest commands)

239

"Execute a PICARD batch program consisting of COMMANDS."

240

(run-picard (flatten (mapcar (lambda (x) (cons "-e" (rplaca x (string (car x))))) commands))))

241

242

(defmacro do-picard (&body body)

243

`(progn

244

(apply 'exec-picard ',(%do-picard body))))