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
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
|
; S T E E L B A N K C O M M O N L I S P F F I I N T E R F A C E T O C S O U N D . H
;
; Copyright (C) 2016 Michael Gogins
;
; This file belongs to Csound.
;
; This software is free software; you can redistribute it and/or
; modify it under the terms of the GNU Lesser General Public
; License as published by the Free Software Foundation; either
; version 2.1 of the License, or (at your option) any later version.
;
; This software is distributed in the hope that it will be useful,
; but WITHOUT ANY WARRANTY; without even the implied warranty of
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
; Lesser General Public License for more details.
;
; You should have received a copy of the GNU Lesser General Public
; License along with this software; if not, write to the Free Software
; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
;
; This file is handwritten and should be maintained by keeping it up to date
; with regard to include/csound.h. This file is not intended to be complete
; and essentially defines a Steel Bank Common Lisp interface to a subset of
; the most useful functions in csound.h. At the present time, only pointers,
; strings, and other primitive types are used in this interface.
(defpackage :sb-csound
(:use :common-lisp :sb-alien :sb-c-call :cm)
(:export
:csoundCompileCsd
:csoundCompileCsdText
:csoundCompileOrc
:csoundCreate
:csoundDestroy
:csoundPerformKsmps
:csoundReadScore
:csoundSetControlChanel
:csoundSetOption
:csoundStart
:csoundCleanup
:render-with-csound
)
)
(in-package :sb-csound)
#+unix (sb-alien:load-shared-object "libcsound64.so")
#+win32 (sb-alien:load-shared-object "csound64.dll")
(declaim (inline csoundCompileCsd))
(define-alien-routine "csoundCompileCsd" integer (csound integer) (csd-pathname c-string))
(declaim (inline csoundCompileCsdText))
(define-alien-routine "csoundCompileCsdText" integer (csound integer) (csd-text c-string))
(declaim (inline csoundCompileOrc))
(define-alien-routine "csoundCompileOrc" integer (csound integer) (orc-text c-string))
(declaim (inline csoundCreate))
(define-alien-routine "csoundCreate" integer (host-data integer))
(declaim (inline csoundDestroy))
(define-alien-routine "csoundDestroy" sb-alien:void (csound integer))
(declaim (inline csoundPerformKsmps))
(define-alien-routine "csoundPerformKsmps" integer (csound integer))
(declaim (inline csoundReadScore))
(define-alien-routine "csoundReadScore" integer (csound integer) (sco-text c-string))
(declaim (inline csoundSetControlChannel))
(define-alien-routine "csoundSetControlChannel" sb-alien:void (csound integer) (channel-name c-string) (channel-value double))
(declaim (inline csoundSetOption))
(define-alien-routine "csoundSetOption" integer (csound integer) (one-option c-string))
(declaim (inline csoundStart))
(define-alien-routine "csoundStart" integer (csound integer))
(declaim (inline csoundCleanup))
(define-alien-routine "csoundCleanup" integer (csound integer))
(in-package :cm)
(use-package :sb-csound)
(defun event-to-istatement (event channel-offset velocity-scale)
"
Translates a Common Music MIDI event to a Csound score event
(i-statement), which is terminated with a newline. An offset, which may
be any number, is added to the MIDI channel number.
"
(format nil "i ~,6f ~,6f ~,6f ~,6f ~,6f 0 0 0 0 0 0~%" (+ channel-offset (midi-channel event)) (object-time event)(midi-duration event)(keynum (midi-keynum event))(* velocity-scale (midi-amplitude event)))
)
(export 'event-to-istatement)
(defun replace-all (string part replacement &key (test #'char=))
"
Replaces all occurences of the string 'part' in 'string' with 'replacement',
using 'test' for character equality.
"
(with-output-to-string (out)
(loop with part-length = (length part)
for old-pos = 0 then (+ pos part-length)
for pos = (search part string
:start2 old-pos
:test test)
do (write-string string out
:start old-pos
:end (or pos (length string)))
when pos do (write-string replacement out)
while pos)))
(defun render-csound (sequence csd-text &optional (channel-offset 1) (velocity-scale 127) (csound nil))
"
Given a Common Music seq 'sequence', translates each of its events into a
Csound 'i' statement, optionally offsetting the channel number and/or
rescaling MIDI velocity, then renders the resulting score using 'csd-text'.
A CSD is used because it can contain any textual Csound input in one block of
raw text. The score generated from 'sequence' is appended to any <CsScore>
lines found in 'csd-text'. This is done so that Csound will quit performing
at the end of the score. It is possible to call csoundReadScore during the
performance. This function returns the Csound object that it uses.
The optional 'csound' parameter is used to call Csound if passed. This enables
'render-with-csound' to be run in a separate thread of execution, and for
the caller to control Csound instrument parameters during real time
performance, e.g.
(setq csound (sb-csound:csoundCreate 0))
(setq my-thread (bt:make-thread (lambda () (render-with-csound cs csd 1 127 csound))))
(sb-csound:csoundSetControlChannel csound 'mychannel' myvalue)
(bt:join-thread my-thread)
"
(let
((score-list (list))
(cs)
(sco-text)
(result)
(new-csd-text))
(progn
(format t "Building Csound score...~%")
(defun curried-event-to-istatement (event)
(event-to-istatement event channel-offset velocity-scale))
(setq score-list (mapcar 'curried-event-to-istatement (subobjects sequence)))
(setq sco-text (format nil "~{~A~^ ~}" score-list))
(print sco-text)
(if csound
(setq cs csound)
(progn
(setq cs (sb-csound:csoundCreate 0))
(format t "csoundCreate returned: ~S.~%" cs)
)
)
(setq new-csd-text (replace-all csd-text "</CsScore>" (concatenate 'string sco-text "</CsScore>")))
(format t "new-csd-text: ~A~%" new-csd-text)
(setq result (sb-csound:csoundCompileCsdText cs new-csd-text))
(format t "csoundCompileCsdText returned: ~D.~%" result)
(setq result (sb-csound:csoundStart cs))
(format t "csoundStart returned: ~D.~%" result)
(loop
(setq result (sb-csound:csoundPerformKsmps cs))
(when (not (equal result 0))(return))
)
(setf result(sb-csound:csoundCleanup cs))
(format t "csoundCleanup returned: ~D.~%" result)
(sleep 5)
(if (not csound)
(sb-csound::csoundDestroy cs)
(format t "csoundDestroy was called.~%")
)
(format t "The Csound performance has ended: ~D.~%" result)
)
)
)
|
