Coverage report: /home/ellis/comp/core/ffi/jack/pkg.lisp

Kind	Covered	All	%
expression	10	511	2.0
branch	0	20	0.0

Key

Not instrumented

Conditionalized out

Executed

Not executed

Both branches taken

One branch taken

Neither branch taken

1

;;; pkg.lisp --- JACK Audio Connection Kit FFI

2

3

;;

4

5

;;; Code:

6

(defpackage :jack

7

(:use :cl :std :log :sb-alien)

8

(:export :load-jack

9

:jack-get-version-string

10

:jackoptions

11

:jackportflags

12

:jack-client-name-size

13

:jack-client-open

14

:jack-get-sample-rate

15

:jack-port-type-get-buffer-size

16

:jack-get-buffer-size

17

:jack-get-client-name

18

:jack-port-get-buffer

19

:jack-port-name

20

:jack-connect

21

:jack-disconnect

22

:jack-get-ports

23

:jack-port-register

24

:jack-client-close

25

:jack-activate

26

:jack-deactivate

27

:jack-set-process-callback

28

:jack-midi-clear-buffer

29

:jack-midi-event-reserve

30

:jack-get-time

31

:jack-frames-to-time

32

:jack-time-to-frames

33

:jack-last-frame-time

34

:jack-frame-time

35

:jack-ringbuffer

36

:jack-ringbuffer-data

37

:rb-data-buf

38

:rb-data-len

39

:rb-data-len-p

40

:jack-ringbuffer-create

41

:jack-ringbuffer-reset

42

:jack-ringbuffer-get-write-vector

43

:jack-ringbuffer-free

44

:jack-ringbuffer-write-advance

45

:jack-ringbuffer-write-space

46

:jack-ringbuffer-write

47

:jack-ringbuffer-get-read-vector

48

:jack-ringbuffer-read

49

:jack-ringbuffer-read-space

50

:*jack-midi-output-port*

51

:*jack-midi-input-port*

52

:make-jack-seqs

53

:*jack-seqs*

54

:make-jack-seq

55

:*jack-seq*

56

:jack-add-event-this-period

57

:jack-add-event-this-frame

58

:seqhash-midi-event

59

:seqhash-midi-note-on

60

:seqhash-midi-note-off

61

:seqhash-midi-program-change

62

:seqhash-midi-control-change

63

:seqhash-midi-pitch-wheel-msg

64

:seqhash-clear-note-offs

65

:jack-start-dur-to-frames

66

:jack-play-event

67

:jack-play-note

68

:jack-all-notes-off

69

:jack-all-notes-off-and-kill-seq

70

:jack-reset

71

:jack-reset-channels

72

:jack-seq-hush-this-seq

73

:jack-seq-hush-all-seqs

74

:*jack-playing*

75

:play-from-seq

76

:jack-handle-event-seqs

77

:jack-init-midi

78

:*jack-client*

79

:jack-period-now

80

:jack-frame-now

81

:*jack-audio-input-channels*

82

:*jack-audio-output-channels*

83

:*jack-audio-input-ports*

84

:*jack-audio-output-ports*

85

:jack-init-audio

86

:jack-process-callback-silence

87

:jack-connect-audio-client-to-system-output

88

:ms->frame

89

:sec->frame

90

:frame->period-offset

91

:+jack-default-midi-type+

92

:+jack-default-audio-type+))

93

94

(in-package :jack)

95

96

(defconstant +jack-max-frames+ 4294967295)

97

(define-alien-loader :jack "/usr/lib/")

98

99

(defar jack-get-version-string c-string)

100

101

(define-alien-type jack-nframes-t unsigned-int)

102

103

(define-alien-type jack-port-t (* t))

104

(define-alien-type jack-options-t (* t))

105

(define-alien-type jack-time-t unsigned-long)

106

(define-alien-type jack-midi-data-t unsigned-char)

107

108

(define-constant +jack-default-audio-type+ "32 bit float mono audio" :test 'string=)

109

(define-constant +jack-default-midi-type+ "8 bit raw midi" :test 'string=)

110

111

(define-alien-type jack-default-audio-sample-t float)

112

113

(define-alien-enum (jackoptions int)

114

:null #x00

115

:no-start-server #x01

116

:use-exact-name #x02

117

:server-name #x04

118

:load-name #x08

119

:load-init #x10

120

:session-id #x20)

121

122

(define-alien-enum (jackportflags int)

123

:is-input #x1

124

:is-output #x2

125

:is-physical #x4

126

:can-monitor #x8

127

:is-terminal #x10)

128

129

(defar jack-client-name-size int)

130

(defar jack-client-open (* t)

131

(name c-string)

132

(opt int)

133

(status int))

134

135

(defar jack-get-sample-rate int

136

(client (* t)))

137

138

(defar jack-port-type-get-buffer-size size-t

139

(client (* t))

140

(port-type c-string))

141

142

(defar jack-get-buffer-size jack-nframes-t

143

(client (* t)))

144

145

(defar jack-get-client-name c-string

146

(client (* t)))

147

148

(defar jack-port-get-buffer (* t)

149

(port (* t))

150

(frames jack-nframes-t))

151

152

(defar jack-port-name c-string

153

(port (* jack-port-t)))

154

155

(defar jack-connect int

156

(client (* t))

157

(source-port c-string)

158

(destination-port c-string))

159

160

(defar jack-disconnect int

161

(client (* t))

162

(source-port c-string)

163

(destination-port c-string))

164

165

(defar jack-get-ports (* t)

166

(client (* t))

167

(port_name_pattern c-string)

168

(type_name_pattern c-string)

169

(flags unsigned-long))

170

171

(defar jack-port-register (* t)

172

(client (* t))

173

(port-name c-string)

174

(port-type c-string)

175

(flags unsigned-long)

176

(buffer-size unsigned-long))

177

178

(defar jack-client-close int

179

(client (* t)))

180

181

(defar jack-activate int

182

(client (* t)))

183

184

(defar jack-deactivate int

185

(client (* t)))

186

187

(defar jack-set-process-callback int

188

(client (* t))

189

(process_callback (* t))

190

(arg int))

191

192

(defar jack-midi-clear-buffer void

193

(port-buffer (* t)))

194

195

(defar jack-midi-event-reserve (* t)

196

(port-buffer (* t))

197

(time unsigned-int)

198

(data-size unsigned-char))

199

200

;;; TIME

201

(defar jack-get-time jack-time-t)

202

203

(defar jack-frames-to-time jack-time-t

204

(client (* t))

205

(frames jack-nframes-t))

206

207

(defar jack-time-to-frames jack-nframes-t

208

(client (* t))

209

(time jack-time-t))

210

211

(defar jack-last-frame-time jack-nframes-t

212

(client (* t)))

213

214

(defar jack-frame-time jack-nframes-t

215

(client (* t)))

216

217

(define-alien-type jack-ringbuffer

218

(struct jack-ringbuffer-t

219

(buf (* char))

220

(write-ptr size-t)

221

(read-ptr size-t)

222

(size size-t)

223

(size-mask size-t)

224

(mlocked int)))

225

226

(define-alien-type jack-ringbuffer-data

227

(struct jack-ringbuffer-data-t

228

(buf (* float))

229

(len size-t)))

230

231

;; vec[0].buf

232

(defun rb-data-buf (arr index) ;index is 0 or 1 from jack

233

(sb-alien:slot

234

(sb-alien:deref (sb-alien:cast arr (* jack-ringbuffer-data)) index)

235

'buf))

236

237

;;vec[0].len

238

(defun rb-data-len (arr index)

239

(sb-alien:slot

240

(sb-alien:deref (sb-alien:cast arr (* jack-ringbuffer-data)) index)

241

'len))

242

243

;;(rb-data-len vec 0)

244

(defun rb-data-len-p (arr index) ;len=0 := nothing to get

245

(plusp (rb-data-len arr index)))

246

247

(defar jack-ringbuffer-create (* jack-ringbuffer)

248

(sz size-t))

249

250

(defar jack-ringbuffer-reset void

251

(rb (* jack-ringbuffer)))

252

253

(defar jack-ringbuffer-get-write-vector void

254

(rb (* jack-ringbuffer))

255

(vec (* jack-ringbuffer-data)))

256

257

(defar jack-ringbuffer-free void

258

(rb (* jack-ringbuffer)))

259

260

(defar jack-ringbuffer-write-advance void

261

(rb (* jack-ringbuffer))

262

(cnt size-t))

263

264

(defar jack-ringbuffer-write-space size-t

265

(rb (* jack-ringbuffer)))

266

267

(defar jack-ringbuffer-write size-t

268

(rb (* jack-ringbuffer))

269

(src (* char))

270

(cnt size-t))

271

272

(defar jack-ringbuffer-get-read-vector void

273

(rb (* jack-ringbuffer))

274

(vec (* jack-ringbuffer-data)))

275

276

(defar jack-ringbuffer-read size-t

277

(rb (* jack-ringbuffer))

278

(dest (* char))

279

(cnt size-t))

280

281

(defar jack-ringbuffer-read-space size-t

282

(rb (* jack-ringbuffer)))

283

284

;;; API

285

;; default global client-name

286

(defparameter *jack-client* nil)

287

288

;;; MIDI

289

(defvar *jack-midi-output-port* nil)

290

(defvar *jack-midi-input-port* nil)

291

292

;;; global pool of seqs for this client, for separate control [start/stop/pause...]:

293

(defun make-jack-seqs () (make-hash-table :size 1500

294

:rehash-size 1.5

295

:rehash-threshold 0.7

296

))

297

(defparameter *jack-seqs* (make-jack-seqs))

298

299

;;; event-seq is a hash-table, keys are frameno at jacks' start-of-period (ie: jack-last-frame-time)

300

(defun make-jack-seq () (make-hash-table))

301

302

;;; provide one default seq for global queues, external schedulers etc:

303

;default sequencer

304

(defvar *jack-seq*

305

(setf (gethash '*jack-seq* *jack-seqs*) (make-jack-seq)))

306

307

;;; MIDI EVENTS

308

309

;; TODO 2025-03-25: use dat/midi

310

;; TODO: expand with support for all midi-messages

311

312

(defun jack-add-event-this-period (seq period event)

313

(setf (gethash period seq)

314

(sort (nconc (gethash period seq) (list event))

315

#'(lambda (a b) (< (car a) (car b))))))

316

317

(defun jack-add-event-this-frame (seq frame event)

318

(push event (gethash frame seq)))

319

320

;;; SEQUENCING EVENTS

321

322

;; seq is a hashtable, key'ing on frame-numbers

323

324

;; version hashing on frame-number

325

(defun seqhash-midi-event (seq frame event)

326

(jack-add-event-this-frame seq frame event))

327

328

;;; using midi-classes:

329

330

(defun seqhash-midi-note-on (seq frame noteno velocity &optional (channel 1))

331

(let ((event (make-instance 'midi:note-on-message frame noteno velocity channel)))

332

(seqhash-midi-event seq frame event)))

333

334

(defun seqhash-midi-note-off (seq frame noteno velocity &optional (channel 1))

335

(let ((event (make-instance 'midi:note-off-message frame noteno velocity channel)))

336

(seqhash-midi-event seq frame event)))

337

338

(defun seqhash-midi-program-change (seq frame program &optional (channel 1))

339

(let ((event (make-instance 'midi:program-change-message :time frame :program program :status channel)))

340

(seqhash-midi-event seq frame event)))

341

342

(defun seqhash-midi-control-change (seq frame control value &optional (channel 1))

343

(let ((event (make-instance 'midi::control-change-message frame control value channel)))

344

(seqhash-midi-event seq frame event)))

345

346

(defun seqhash-midi-pitch-wheel-msg (seq frame bend &optional (channel 1))

347

;; expects values between -8192->8191

348

(let ((event (make-instance 'midi:pitch-bend-message :time frame :value bend :status channel)))

349

(seqhash-midi-event seq frame event)))

350

351

;; erase pending note-offs for interval - don't shut off later arriving notes

352

(defun seqhash-clear-note-offs (seq startframe endframe noteno &optional (channel 1))

353

(maphash #'(lambda (key val)

354

(let ((event (car val)))

355

(when (and (<= startframe key endframe)

356

(typep event 'midi::note-off-message)

357

(eql (midi::message-key event) noteno)

358

(eql (midi::message-channel event) channel))

359

(remhash key seq))))

360

seq))

361

362

;; interface to higher-level funcs:

363

364

(defun jack-start-dur-to-frames (start dur)

365

(let* ((dur-frames (sec->frame dur))

366

(startframe (jack-frame-now start))

367

(endframe (+ startframe dur-frames -1)))

368

(values startframe endframe)))

369

370

(defun jack-play-event (seq start event)

371

(seqhash-midi-event seq (jack-frame-now start) event))

372

373

(defun jack-play-note (seq start dur noteno &optional (vel 80) (chan 0))

374

(let* ((startframe (jack-frame-now start))

375

(endframe (+ startframe (sec->frame dur) -1)))

376

(seqhash-clear-note-offs seq startframe endframe noteno chan)

377

(seqhash-midi-note-on seq startframe noteno vel chan)

378

;; (sleep (/ (jack-get-buffer-size *jack-client*)

379

;; (jack-get-sample-rate *jack-client*)))

380

(seqhash-midi-note-off seq endframe noteno 0 chan)))

381

382

(defun jack-all-notes-off (seq)

383

(let ((sounding-notes '()))

384

(maphash #'(lambda (key val)

385

(declare (ignore key))

386

                  (mapc #'(lambda (ev) (push (list (midi:message-key ev) (1- (midi:message-channel ev)))

387

sounding-notes))

388

val))

389

seq)

390

(clrhash seq)

391

(mapc #'(lambda (note)

392

(seqhash-midi-note-off seq (jack-frame-now) (car note) 0 (cadr note)))

393

sounding-notes)))

394

395

(defun jack-all-notes-off-and-kill-seq (seq)

396

(jack-all-notes-off seq)

397

(sleep (float (/ 2

398

(jack-get-buffer-size *jack-client*)

399

(jack-get-sample-rate *jack-client*))))

400

(remhash seq *jack-seqs*))

401

402

(defun jack-reset (&optional (seq *jack-seq*))

403

(dotimes (ch 16)

404

(dotimes (key 127)

405

(seqhash-midi-note-off seq (jack-frame-now) key 0 ch))))

406

407

;;(jack-reset)

408

409

(defun jack-reset-channels ()

410

(loop for ch from 0 to 16

411

do (seqhash-midi-program-change *jack-seq* (jack-frame-now) ch ch)))

412

413

;;(jack-reset-channels)

414

415

(defun jack-seq-hush-this-seq (seq)

416

(jack-all-notes-off seq))

417

418

(defun jack-seq-hush-all-seqs ()

419

(maphash #'(lambda (key seq)

420

(declare (ignore key))

421

(jack-all-notes-off-and-kill-seq seq))

422

*jack-seqs*))

423

424

(defparameter *jack-playing* t) ;nil=shut up

425

;; (setf *playing* nil)

426

427

(defun play-from-seq (port-buf seq)

428

(when *jack-playing*

429

(let ((this-period (jack-last-frame-time *jack-client*)))

430

(loop for offset from 0 below (jack-get-buffer-size *jack-client*)

431

for key from this-period ;events hashed on frameno

432

for events = (gethash key seq)

433

when events

434

do

435

(dolist (midimsg events)

436

(let ((buffer (jack-midi-event-reserve port-buf offset 3))) ;offset inside period

437

(unless (null-alien buffer)

438

(setf (deref buffer) (midi::write-message midimsg)))))

439

(remhash key seq)))))

440

441

;; callback function handles seq-events, plugged into jacks

442

;; process-callback

443

444

(defun jack-handle-event-seqs (nframes)

445

(let ((port-buf (jack-port-get-buffer *jack-midi-output-port* nframes)))

446

(jack-midi-clear-buffer port-buf)

447

;;(play-from-seq port-buf *jack-seq*)

448

(maphash #'(lambda (key seq)

449

(declare (ignore key))

450

(play-from-seq port-buf seq))

451

*jack-seqs*)))

452

453

(defun jack-init-midi ()

454

;; get up and running

455

(unless *jack-client*

456

(setf *jack-client* (jack-client-open "lisp-jack" 0 0)))

457

(setf *jack-midi-output-port*

458

(let ((port (jack-port-register *jack-client*

459

"midiout"

460

+jack-default-midi-type+

461

(jackportflags :is-output)

462

0)))

463

(when (zerop (sb-sys:sap-int (alien-sap port))) ;0 if not allocated

464

(setf port -1)

465

             (cerror "Set *jack-midi-output-port* to -1" "*jack-midi-output-port* for Jack not allocated - check jack-server"))

466

port)))

467

468

;;; Client

469

(defun jack-period-now (&optional sek)

470

(+ (jack-last-frame-time *jack-client*)

471

(jack-get-buffer-size *jack-client*)

472

(round (if sek (* sek (jack-get-sample-rate *jack-client*)) 0))))

473

474

;;; too late to schedule things inside current period, this looks up

475

;;; current frame with exactly one period latency:

476

477

(defun jack-frame-now (&optional sek)

478

(round (+ (jack-frame-time *jack-client*)

479

(jack-get-buffer-size *jack-client*)

480

(if sek (* sek (jack-get-sample-rate *jack-client*)) 0))))

481

482

(defun ms->frame (ms)

483

(round (* ms (jack-get-sample-rate *jack-client*)) 1000))

484

485

(defun sec->frame (sec)

486

(round (* sec (jack-get-sample-rate *jack-client*))))

487

488

(defun frame->period-offset (frame)

489

"returns 2 frame nos: start of period & offset within period"

490

(let ((bufsiz (jack-get-buffer-size *jack-client*)))

491

(multiple-value-bind (n rem)

492

(floor frame bufsiz)

493

(values (* n bufsiz) rem))))

494

495

(defparameter *jack-audio-input-channels* 2)

496

(defparameter *jack-audio-output-channels* 2)

497

498

(defparameter *jack-audio-input-ports* nil)

499

(defparameter *jack-audio-output-ports* nil)

500

501

(defun jack-init-audio ()

502

(unless *jack-client*

503

(setf *jack-client* (jack-client-open "lisp-jack" 0 0)))

504

(setf *jack-audio-input-ports*

505

(loop for chan from 0 below *jack-audio-output-channels*

506

collect

507

(let ((port (jack-port-register

508

*jack-client*

509

(format nil "in_~A" chan)

510

+jack-default-audio-type+

511

(jackportflags :is-input)

512

0)))

513

(when (zerop (sb-sys:sap-int (alien-sap port))) ;0 if not allocated

514

(setf port -1)

515

(cerror (format nil "Set jack-input-port ~A to -1" chan)

516

"*jack-audio-input-ports* not allocated"))

517

port))

518

*jack-audio-output-ports*

519

(loop for chan from 0 below *jack-audio-output-channels*

520

collect

521

(let ((port (jack-port-register

522

*jack-client*

523

(format nil "out_~A" chan)

524

+jack-default-audio-type+

525

(jackportflags :is-output)

526

0)))

527

(when (zerop (sb-sys:sap-int (alien-sap port))) ;0 if not allocated

528

(setf port -1)

529

(cerror (format nil "Set jack-output-port ~A to -1" chan)

530

"*jack-audio-output-ports* not allocated"))

531

port))))

532

533

;; provide default-callback which just copies in to out:

534

(define-alien-callable jack-process-callback-silence int ((nframes jack-nframes-t) (arg (* t)))

535

(when (fboundp 'jack-handle-event-seqs) (jack-handle-event-seqs nframes))

536

(loop for inport in *jack-audio-input-ports*

537

for outport in *jack-audio-output-ports*

538

do

539

(let ((in (jack-port-get-buffer inport nframes))

540

(out (jack-port-get-buffer outport nframes)))

541

(memcpy out in

542

(* nframes #.(std/alien::foreign-type-size 'size-t)))))

543

0)

544

545

(defun jack-connect-audio-client-to-system-output ()

546

(let ((ports (take 2 *jack-audio-output-ports*)))

547

(with-alien ((l jack-port-t (pop ports))

548

(r jack-port-t (pop ports)))

549

(or (not (minusp (jack-connect *jack-client* #1=(jack-port-name (addr l)) "playback_FL")))

550

(warn "could not connect JACK port ~A to output-port playback_FL" #1#))

551

(or (not (minusp (jack-connect *jack-client* #2=(jack-port-name (addr r)) "playback_FR")))

552

(warn "could not connect JACK port ~A to output-port playback_FR" #2#)))))