/[cl-wav-synth]/cl-wav-synth/mikmod.lisp
ViewVC logotype

Contents of /cl-wav-synth/mikmod.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.7 - (show annotations)
Sat Dec 13 20:53:28 2008 UTC (5 years, 4 months ago) by pbrochard
Branch: MAIN
CVS Tags: HEAD
Changes since 1.6: +0 -1 lines
First libterminatorX commit
1 ;;; CL-Wav-Synth - Manipulate WAV files
2 ;;;
3 ;;; Copyright (C) 2006 Philippe Brochard (hocwp@free.fr)
4 ;;;
5 ;;; #Date#: Fri Feb 2 22:39:36 2007
6 ;;;
7 ;;; **********************************************
8 ;;; The authors grant you the rights to distribute
9 ;;; and use this software as governed by the terms
10 ;;; of the Lisp Lesser GNU Public License
11 ;;; (http://opensource.franz.com/preamble.html),
12 ;;; known as the LLGPL.
13 ;;; **********************************************
14
15 (in-package :cl-user)
16
17 (defpackage :mikmod
18 (:nicknames :mm)
19 (:use :common-lisp :cffi)
20 (:export :mikmod-play-file
21 :*md-mode*
22 :*mikmod-control-function*
23 :mikmod-init
24 :mikmod-exit
25 :mikmod-enable-output
26 :mikmod-disable-output
27 :mikmod-set-num-voices
28 :mikmod-update
29 :mikmod-load
30 :mikmod-free
31 :mikmod-play
32 :mikmod-voice-stopped
33 :mikmod-voice-set-panning))
34
35 (in-package :mikmod)
36
37
38 (defparameter *mikmod-control-function* (lambda () nil)
39 "A function returning T to stop the mikmod player")
40
41 (define-foreign-library libmikmod
42 (:unix "libmikmod.so")
43 (t (:default "mikmod")))
44
45 (use-foreign-library libmikmod)
46
47 (defcfun ("MikMod_RegisterAllDrivers" mikmod-register-all-drivers) :void)
48
49 (defcvar "md_mode" :unsigned-short)
50
51 (defcfun "MikMod_Init" :int (str :string))
52 (defcfun "MikMod_Exit" :void)
53
54
55 (defcfun ("MikMod_EnableOutput" mikmod-enable-output) :int)
56 (defcfun ("MikMod_DisableOutput" mikmod-disable-output) :void)
57
58 (defcfun ("MikMod_SetNumVoices" mikmod-set-num-voices) :int
59 (musicvoices :int)
60 (samplevoices :int))
61
62 (defcfun "MikMod_Update" :void)
63
64 (defcfun ("Sample_Load" mikmod-load) :pointer
65 (filename :string))
66
67 (defcfun ("Sample_Free" mikmod-free) :void
68 (sample :pointer))
69
70 (defcfun ("Sample_Play" mikmod-play) :char
71 (sample :pointer)
72 (start :unsigned-long)
73 (flags :char))
74
75 (defcfun ("Voice_Stopped" mikmod-voice-stopped) :int
76 (voice :int))
77
78
79 (defcfun ("Voice_SetPanning" mikmod-voice-set-panning) :void
80 (voice :char)
81 (panning :unsigned-int))
82
83
84
85
86 ;;;;;;;;;;;;;;;;;;;;;;;;;;;
87 ;;; Beging of code
88 ;;;;;;;;;;;;;;;;;;;;;;;;;;;
89
90 ;;; Register all drivers once at load time
91 (mikmod-register-all-drivers)
92
93
94 (defun mikmod-play-file (filename)
95 "Play a wav sample with mikmod (volume is in range 0 127)"
96 (setf *md-mode* (logior *md-mode* #x0004))
97 (unless (zerop (mikmod-init ""))
98 (print "Could not initialize sound")
99 (return-from mikmod-play-file nil))
100 (unwind-protect
101 (let ((sample (mikmod-load filename)))
102 (mikmod-set-num-voices -1 2)
103 (mikmod-enable-output)
104 (let ((voice (mikmod-play sample 0 0)))
105 (mikmod-voice-set-panning voice 127)
106 (mikmod-update)
107 (loop while (zerop (mikmod-voice-stopped voice)) do
108 (mikmod-update)
109 (when (funcall *mikmod-control-function*)
110 (return))
111 (sleep 0.1)))
112 (mikmod-free sample))
113 (mikmod-disable-output)
114 (mikmod-exit)))
115
116
117 (defun mikmod-test ()
118 (setf *md-mode* (logior *md-mode* #x0004))
119 (unless (zerop (mikmod-init ""))
120 (print "Could not initialize sound")
121 (return-from mikmod-test nil))
122 (unwind-protect
123 (let ((sample (mikmod-load "synth.wav"))
124 (sa2 (mikmod-load "synth.wav")))
125 (mikmod-set-num-voices -1 2)
126 (mikmod-enable-output)
127 (let ((voice (mikmod-play sample 0 0)))
128 (mikmod-voice-set-panning voice 127)
129 (mikmod-update)
130 (dotimes (i 40)
131 (mikmod-update)
132 (sleep 0.1)))
133 (let ((v2 (mikmod-play sa2 0 0)))
134 (mikmod-voice-set-panning v2 127)
135 (mikmod-update)
136 (dotimes (i 40)
137 (mikmod-update)
138 (sleep 0.1)))
139 (mikmod-free sample)
140 (mikmod-free sa2))
141 (mikmod-disable-output)
142 (mikmod-exit)))
143
144
145
146 (pushnew :mikmod *features*)

  ViewVC Help
Powered by ViewVC 1.1.5