├── examples ├── wav │ ├── .gitignore │ └── Makefile ├── thx ├── obx ├── sine ├── song0 ├── song1 ├── song2 ├── song3 ├── basic.drums ├── c1.drums ├── sine.ml ├── noise.ml ├── r2d2.ml ├── Makefile ├── tabulated.ml ├── filter.ml ├── theremin.ml ├── song3.ml ├── spectral.ml ├── thx.ml ├── fm_arpeggiator.ml ├── song0.ml ├── dune ├── bug.ml ├── better_off_alone.ml ├── midi.ml ├── song2.ml ├── doc.ml ├── song1.ml ├── trance.ml └── obx.ml ├── doc ├── .gitignore ├── lets.png ├── Makefile └── github.css ├── experiments ├── compiler │ ├── extlib.ml │ ├── Makefile │ ├── monads.ml │ ├── stream.ml │ └── OCamlMakefile └── two-monads │ ├── extlib.ml │ ├── test.ml │ └── Makefile ├── .gitignore ├── Makefile ├── src ├── Makefile ├── dune ├── TODO.md ├── sparse.ml ├── board.ml ├── OSC.ml ├── extlib.ml ├── math.ml ├── note.ml ├── visu.ml ├── pattern.ml ├── output.ml ├── MIDI.ml ├── instrument.ml └── formal.ml ├── CHANGES.md ├── dune-project ├── msynth.opam ├── .github └── workflows │ └── build.yml ├── IMPLEMENTATION.md ├── NOTES.md ├── README.md └── LICENSE /examples/wav/.gitignore: -------------------------------------------------------------------------------- 1 | *.mp4 2 | -------------------------------------------------------------------------------- /doc/.gitignore: -------------------------------------------------------------------------------- 1 | site 2 | index.html 3 | -------------------------------------------------------------------------------- /examples/thx: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | dune exec ./thx.exe -------------------------------------------------------------------------------- /examples/obx: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | dune exec ./obx.exe 3 | -------------------------------------------------------------------------------- /examples/sine: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | dune exec ./sine.exe 3 | -------------------------------------------------------------------------------- /experiments/compiler/extlib.ml: -------------------------------------------------------------------------------- 1 | ../../src/extlib.ml -------------------------------------------------------------------------------- /experiments/two-monads/extlib.ml: -------------------------------------------------------------------------------- 1 | ../../src/extlib.ml -------------------------------------------------------------------------------- /examples/song0: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | dune exec ./song0.exe 3 | -------------------------------------------------------------------------------- /examples/song1: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | dune exec ./song1.exe 3 | -------------------------------------------------------------------------------- /examples/song2: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | dune exec ./song2.exe 3 | -------------------------------------------------------------------------------- /examples/song3: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | dune exec ./song3.exe 3 | -------------------------------------------------------------------------------- /doc/lets.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/smimram/monadic-synth/HEAD/doc/lets.png -------------------------------------------------------------------------------- /examples/basic.drums: -------------------------------------------------------------------------------- 1 | CH(0.6):X X X X X X X X 2 | SD(0.9): X X 3 | BD(1.2):X X X X -------------------------------------------------------------------------------- /examples/c1.drums: -------------------------------------------------------------------------------- 1 | CH(0.4):X X X X X X X X 2 | SD(0.5): X X 3 | BD(1.2):X X X X -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.annot 2 | *.o 3 | *.cm* 4 | *.a 5 | *.mp3 6 | *.wav 7 | *~ 8 | ._d 9 | _build 10 | -------------------------------------------------------------------------------- /examples/sine.ml: -------------------------------------------------------------------------------- 1 | open Msynth 2 | open Stream 3 | 4 | let s = Stream.sine () 440. >>= Stereo.of_mono 5 | 6 | let () = Output.play s 7 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | all: build 2 | 3 | build: 4 | @dune build 5 | 6 | clean: 7 | @dune clean 8 | 9 | install: 10 | @dune install 11 | 12 | ci: 13 | git ci . -m "Worked on synth." 14 | git push 15 | -------------------------------------------------------------------------------- /src/Makefile: -------------------------------------------------------------------------------- 1 | all: build 2 | 3 | build: 4 | @dune build 5 | 6 | ci: 7 | $(MAKE) -C .. $@ 8 | 9 | dist: 10 | tar zcvf msynth.tar.gz msynth *.ml Makefile OCamlMakefile test/*.ml test/Makefile 11 | -------------------------------------------------------------------------------- /src/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name msynth) 3 | (public_name msynth) 4 | (synopsis "A monadic audio synthesizer") 5 | (libraries threads re alsa osc osc-unix graphics) 6 | (flags (:standard -warn-error -27)) 7 | ) 8 | -------------------------------------------------------------------------------- /experiments/two-monads/test.ml: -------------------------------------------------------------------------------- 1 | open Op 2 | 3 | let s = 4 | let+ lfo = sine in 5 | let+ osc = saw in 6 | let s = osc (cst 440.) |> amp (add (lfo (cst 10.)) (cst 0.1)) |> stereo in 7 | return s 8 | 9 | let () = 10 | Output.play s 11 | -------------------------------------------------------------------------------- /examples/noise.ml: -------------------------------------------------------------------------------- 1 | open Msynth 2 | open Stream 3 | 4 | let s = 5 | let n1 = Osc.noise () in 6 | let n2 = Osc.pink_noise () in 7 | let b = alternately () in 8 | b 0.5 >>= switch n1 n2 >>= stereo 9 | 10 | let () = 11 | Output.play s 12 | -------------------------------------------------------------------------------- /examples/r2d2.ml: -------------------------------------------------------------------------------- 1 | (** R2D2-ish sound. *) 2 | 3 | open Msynth 4 | open Stream 5 | 6 | let () = 7 | let s = 8 | let freq = random () ~min:500. ~max:1500. 10. in 9 | let osc = sine () in 10 | freq >>= osc >>= stereo 11 | in 12 | Output.play s 13 | -------------------------------------------------------------------------------- /CHANGES.md: -------------------------------------------------------------------------------- 1 | 0.1.2 (unreleased) 2 | ===== 3 | 4 | - Switch to osc instead of lo. 5 | - Switch to re instead of str. 6 | - Add pink noise generator. 7 | 8 | 0.1.1 (2021-01-01) 9 | ===== 10 | 11 | - Switch to dune. 12 | 13 | 0.1.0 (2020-08-19) 14 | ===== 15 | 16 | - Initial release. 17 | -------------------------------------------------------------------------------- /experiments/compiler/Makefile: -------------------------------------------------------------------------------- 1 | SOURCES = extlib.ml stream.ml 2 | RESULT = msynth 3 | THREADS = yes 4 | ANNOTATE = true 5 | PACKS = alsa lo graphics 6 | OCAMLOPTFLAGS = -O3 7 | 8 | DOC_FILES = $(SOURCES) 9 | OCAMLDOCFLAGS = -I +threads 10 | 11 | all: dncl 12 | 13 | ci: 14 | $(MAKE) -C .. $@ 15 | 16 | include OCamlMakefile 17 | -------------------------------------------------------------------------------- /examples/wav/Makefile: -------------------------------------------------------------------------------- 1 | WAV = $(wildcard *.wav) 2 | MP3 = $(WAV:.wav=.mp3) 3 | MP4 = $(WAV:.mp3=.mp4) 4 | 5 | all: $(MP4) 6 | 7 | clean: 8 | rm -f $(MP4) 9 | 10 | %.mp3: %.wav 11 | lame --abr 160 $< 12 | 13 | %.mp4: %.mp3 14 | ffmpeg -i $< -filter_complex "[0:a]showspectrum=s=1280x720:color=intensity[v]" -map "[v]" -map 0:a -pix_fmt yuv420p $@ 15 | -------------------------------------------------------------------------------- /doc/Makefile: -------------------------------------------------------------------------------- 1 | all: site 2 | 3 | index.html: ../README.md 4 | pandoc $< -s -c github.css --toc --metadata title="Monadic synthesizers in OCaml" -o $@ 5 | 6 | site: index.html 7 | cd .. && dune build @doc 8 | rm -rf odoc 9 | cp -r ../_build/default/_doc/_html odoc 10 | 11 | watch: 12 | while inotifywait ../README.md -e modify; do $(MAKE) index.html; done 13 | -------------------------------------------------------------------------------- /examples/Makefile: -------------------------------------------------------------------------------- 1 | all: .gitignore build 2 | 3 | build: 4 | @dune build 5 | 6 | ci: 7 | @$(MAKE) -C .. $@ 8 | 9 | test: build 10 | ./midi 11 | 12 | debug: bug 13 | ./bug 14 | 15 | perf: bug 16 | -perf record --call-graph=dwarf -- ./bug 17 | pref report 18 | 19 | %: %.ml build 20 | @dune exec ./$@.exe 21 | 22 | .gitignore: $(PROG) 23 | @rm -f $@ 24 | @for i in $(PROG); do echo $$i >> $@; done 25 | -------------------------------------------------------------------------------- /experiments/two-monads/Makefile: -------------------------------------------------------------------------------- 1 | SOURCES = extlib.ml op.ml 2 | RESULT = msynth 3 | THREADS = yes 4 | ANNOTATE = true 5 | PACKS = alsa lo graphics 6 | OCAMLOPTFLAGS = -O3 7 | INCDIRS = ../../src 8 | 9 | DOC_FILES = $(SOURCES) 10 | OCAMLDOCFLAGS = -I +threads 11 | 12 | all: dncl 13 | 14 | test: test.ml dncl 15 | ocamlopt $< -o $@ 16 | ./test 17 | 18 | ci: 19 | $(MAKE) -C .. $@ 20 | 21 | include OCamlMakefile 22 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 3.14) 2 | (version 0.1.2) 3 | (name msynth) 4 | (source (github smimram/ocaml-msynth)) 5 | (license LGPL-2.1) 6 | (authors "Samuel Mimram ") 7 | (maintainers "Samuel Mimram ") 8 | 9 | (generate_opam_files true) 10 | (package 11 | (name msynth) 12 | (synopsis "A monadic audio synthesizer") 13 | (depends 14 | (alsa (>= 0.3.0)) 15 | osc-unix 16 | graphics 17 | re 18 | ) 19 | ) 20 | -------------------------------------------------------------------------------- /examples/tabulated.ml: -------------------------------------------------------------------------------- 1 | (** Test tabulated functions. *) 2 | 3 | open Msynth 4 | open Stream 5 | 6 | let () = 7 | let s = 8 | let freq = 440. in 9 | let s = sine () freq in 10 | let s' = sine_tabulated () freq in 11 | (* Switch between the two oscillators every 1 second. *) 12 | let b = ref true in 13 | let e = every () 1. >>= on (fun () -> b := not !b) in 14 | let b = e >> stream_ref b in 15 | b >>= switch s s' >>= stereo 16 | in 17 | Output.play s 18 | -------------------------------------------------------------------------------- /examples/filter.ml: -------------------------------------------------------------------------------- 1 | (** Testing filters. *) 2 | 3 | open Msynth 4 | open Stream 5 | 6 | let () = 7 | let midi = MIDI.create () in 8 | (* let lpq = MIDI.controller midi 0 ~min:0.1 ~max:5. 1. in *) 9 | let lpf = MIDI.controller midi 0 ~min:10. ~max:40000. ~mode:`Logarithmic 2. >>= print "lpf" in 10 | let osc = saw () 1000. in 11 | let lp = bind1_2 (Filter.first_order ~variant:`Simple () `Low_pass) lpf in 12 | let s = 13 | osc 14 | >>= lp 15 | >>= stereo 16 | in 17 | Output.play s 18 | -------------------------------------------------------------------------------- /src/TODO.md: -------------------------------------------------------------------------------- 1 | - make the monad abstract so that we cannot have access to its implementation 2 | - use the sparse monad instead of events 3 | - think again about dup (at least remove them from Stream module) 4 | - investigate leapfrog integrator: 5 | https://www.johndcook.com/blog/2020/07/13/leapfrog-integrator/ 6 | 7 | 8 | ## AKAI mk2 mini 9 | 10 | - light is note on @ velo 127, no light is note on @ velo < 127 11 | - on/off is note 3, tap is note 4, etc (including note repeat) 12 | - bank a/b is 25, cc 26, pc 27 13 | -------------------------------------------------------------------------------- /src/sparse.ml: -------------------------------------------------------------------------------- 1 | (** Sparse streams. *) 2 | 3 | (** A sparse stream, which runs a continuation whenever there is a stream to 4 | play. *) 5 | type 'a t = ('a -> unit) -> unit 6 | 7 | (** A constant stream. *) 8 | let return : 'a -> 'a t = 9 | fun x k -> k x 10 | 11 | let bind : ('a -> 'b t) -> 'a t -> 'b t = 12 | fun f x k -> x (fun x -> f x k) 13 | 14 | (** Build a stream from a sparse stream. *) 15 | let to_stream init (s : 'a t) = 16 | let x = ref init in 17 | let f x' = x := x' in 18 | s f; 19 | Stream.stream_ref x 20 | -------------------------------------------------------------------------------- /examples/theremin.ml: -------------------------------------------------------------------------------- 1 | (* A simple theremin. *) 2 | 3 | open Msynth 4 | open Stream 5 | 6 | let () = 7 | Graphics.open_graph ""; 8 | let pos = seq Graphics.mouse_pos in 9 | (* Graphics isn't ready to be queried 44100 times per second *) 10 | let pos = resample 100. pos in 11 | let vol = 12 | let* x, _ = pos in 13 | let x = float x /. float (Graphics.size_x ()) in 14 | return x 15 | in 16 | let freq = 17 | let* _, y = pos in 18 | let y = float y /. float (Graphics.size_y ()) in 19 | return (Math.stretch ~min:300. ~max:2500. y) 20 | in 21 | let s = bind (sine ()) freq >>= B.mulc vol in 22 | Output.play (s >>= amp 0.5 >>= stereo) 23 | -------------------------------------------------------------------------------- /msynth.opam: -------------------------------------------------------------------------------- 1 | # This file is generated by dune, edit dune-project instead 2 | opam-version: "2.0" 3 | version: "0.1.2" 4 | synopsis: "A monadic audio synthesizer" 5 | maintainer: ["Samuel Mimram "] 6 | authors: ["Samuel Mimram "] 7 | license: "LGPL-2.1" 8 | homepage: "https://github.com/smimram/ocaml-msynth" 9 | bug-reports: "https://github.com/smimram/ocaml-msynth/issues" 10 | depends: [ 11 | "dune" {>= "3.14"} 12 | "alsa" {>= "0.3.0"} 13 | "osc-unix" 14 | "graphics" 15 | "re" 16 | "odoc" {with-doc} 17 | ] 18 | build: [ 19 | ["dune" "subst"] {dev} 20 | [ 21 | "dune" 22 | "build" 23 | "-p" 24 | name 25 | "-j" 26 | jobs 27 | "@install" 28 | "@runtest" {with-test} 29 | "@doc" {with-doc} 30 | ] 31 | ] 32 | dev-repo: "git+https://github.com/smimram/ocaml-msynth.git" 33 | -------------------------------------------------------------------------------- /examples/song3.ml: -------------------------------------------------------------------------------- 1 | open Msynth 2 | open Stream 3 | 4 | let tempo = 130. 5 | 6 | let s = 7 | let synth = Pattern.concat [[0.,8.,`Chord([69;71;72;76],1.)];[0.,8.,`Chord([68;71;74;76],1.)]] in 8 | let synth = Pattern.arpeggiate `Up synth in 9 | let synth = Pattern.transpose (-12) synth in 10 | 11 | let sound () = saw () in 12 | let synth = Instrument.play (Note.adsr ~r:(return 0.01) sound) (Pattern.stream ~loop:true tempo synth) in 13 | let lp = Filter.biquad () `Low_pass in 14 | let synth = 15 | let lp_freq = OSC.float ~mode:`Logarithmic "/oscControl/slider1" ~max:10000. 1500. in 16 | let lp_q = OSC.float "/oscControl/slider2" ~min:0.1 ~max:5. 1. in 17 | bind3 lp lp_q lp_freq synth 18 | in 19 | let synth = synth >>= stereo in 20 | let synth = synth >>= Stereo.dephase () 0.01 in 21 | let s = Stereo.mix [synth] in 22 | Stereo.cmul 0.6 s 23 | 24 | let () = 25 | OSC.server 10000; 26 | Output.play s 27 | -------------------------------------------------------------------------------- /experiments/compiler/monads.ml: -------------------------------------------------------------------------------- 1 | (** Testing simple usual monads. *) 2 | 3 | (** {2 The state monad} *) 4 | 5 | type mem 6 | 7 | type nonrec 'a state = mem -> mem * 'a 8 | 9 | let return : 'a -> 'a state = fun x st -> st, x 10 | 11 | let bind : ('a -> 'b state) -> 'a state -> 'b state = fun f x st -> 12 | let st, x = x st in 13 | f x st 14 | 15 | (** {2 The stream monad} *) 16 | 17 | type dt = float 18 | 19 | type 'a stream = dt -> 'a 20 | 21 | let return : 'a -> 'a stream = fun x dt -> x 22 | 23 | let bind : ('a -> 'b stream) -> 'a stream -> 'b stream = fun f x dt -> 24 | f (x dt) dt 25 | 26 | type 'a t = mem -> mem * (dt -> 'a) 27 | 28 | let return : 'a -> 'a t = fun x st -> st, fun dt -> dt 29 | 30 | let bind : ('a -> 'b t) -> 'a t -> 'b t = fun f x -> 31 | fun st -> 32 | let st, x = x st in 33 | let st, _ = f (x 0.) st in 34 | st, 35 | fun dt -> 36 | let _, y = f (x dt) st in 37 | y dt 38 | -------------------------------------------------------------------------------- /examples/spectral.ml: -------------------------------------------------------------------------------- 1 | open Msynth 2 | open Extlib 3 | open Stream 4 | 5 | let sampler ~freq buf f = ignore freq; ignore buf; ignore f; failwith "TODO" 6 | 7 | let s = 8 | let buflen = 1 lsl 13 in 9 | let buf = Array.make buflen Complex.zero in 10 | let f0 = 500. in 11 | let* dt = dt in 12 | let kf = int_of_float (f0 *. float buflen *. dt) in 13 | buf.(kf) <- Complex.one; 14 | (* let buf = Array.init buflen (fun _ -> Complex.real (Random.float 1.)) in *) 15 | let buf = Array.map Complex.re (Sample.ifft buf) in 16 | let s = sampler ~freq:f0 buf 440. in 17 | s >>= amp 0.5 (* >>= Visu.graphics () *) >>= stereo 18 | 19 | let _ = ignore s 20 | 21 | (* let s () = *) 22 | (* let s = cadd 100. (cmul 400. (now ~dt ())) >>= sine ~dt in *) 23 | (* (\* let s = sine ~dt 440. in *\) *) 24 | (* s >>= Visu.bands ~dt ~bands:4096 () >>= stereo *) 25 | 26 | let s = 27 | (* let s = Spectral.harmonics ~dt () in *) 28 | (* let s = Spectral.pad () in *) 29 | let s _ = failwith "TODO" in 30 | s 440. >>= Visu.bands ~bands:4096 () >>= amp 0.08 >>= Stereo.schroeder () 31 | 32 | let () = 33 | Output.play s 34 | -------------------------------------------------------------------------------- /examples/thx.ml: -------------------------------------------------------------------------------- 1 | (** The THX deep note. *) 2 | 3 | (* We are more or less following the explanations from 4 | http://earslap.com/article/recreating-the-thx-deep-note.html *) 5 | 6 | open Msynth 7 | open Extlib 8 | open Stream 9 | 10 | let () = 11 | (* Number of voices. *) 12 | let voices = 30 in 13 | let voice () = 14 | (* Initial frequency. *) 15 | let freq = Random.float 200. +. 200. in 16 | (* Final frequency. *) 17 | let final = Note.frequency (Float.floor (Random.float 7.) *. 12. +. 2.5) in 18 | (* Add some noise in final frequency. *) 19 | let final = 20 | let e = 0.01 in 21 | let min = final *. (1. -. e) in 22 | let max = final *. (1. +. e) in 23 | random () ~min ~max 0.5 >>= smooth () 1. 24 | in 25 | let freq = 26 | let ramp = Envelope.ramp () in 27 | let* target = final in 28 | ramp ~from:freq ~target 5. in 29 | freq 30 | >>= saw () 31 | >>= amp (1. /. float voices) 32 | >>= Stereo.pan ~law:`Circular (Random.float 2. -. 1.) 33 | in 34 | let voices = List.init voices (fun _ -> voice ()) in 35 | let s = 36 | Stereo.mix voices 37 | (* Avoid abrupt start *) 38 | >>= Stereo.Envelope.apply (Envelope.ramp () 0.1) 39 | (* Adjust general volume *) 40 | >>= Stereo.amp 0.5 41 | in 42 | Output.play s 43 | -------------------------------------------------------------------------------- /src/board.ml: -------------------------------------------------------------------------------- 1 | (** A board stores all the parameters of a synthesizer and can display those. *) 2 | 3 | open Stream 4 | 5 | let create board = 6 | Graphics.open_graph ""; 7 | let dx = 80 in 8 | let dy = 100 in 9 | let draw () = 10 | Graphics.set_color 0x000000; 11 | Graphics.fill_rect 0 0 (Graphics.size_x ()) (Graphics.size_y ()); 12 | Graphics.set_color Graphics.cyan; 13 | List.iteri 14 | (fun j l -> 15 | List.iteri 16 | (fun i (label,c) -> 17 | let x = dx * i in 18 | let y = Graphics.size_y () - dy * j in 19 | (* Draw label *) 20 | let w,h = Graphics.text_size label in 21 | Graphics.moveto (x+dx/2-w/2) (y-dx-h); 22 | Graphics.draw_string label; 23 | (* Draw control *) 24 | match c with 25 | | `Knob(min,max,mode,s) -> 26 | Graphics.draw_circle (x+dx/2) (y-dx/2) 30; 27 | let v = get s in 28 | let v = Math.unstretch ~mode ~min ~max v in 29 | let a = int_of_float (270. -. v *. 360.) in 30 | Graphics.draw_arc (x+dx/2) (y-dx/2) 25 25 270 a; 31 | | `Switch s -> 32 | let r = 20 in 33 | (if get s then Graphics.fill_rect else Graphics.draw_rect) (x+dx/2-r/2) (y-dx/2-r/2) r r 34 | ) l 35 | ) board 36 | in 37 | draw (); 38 | let t = periodic ~on_reset:draw () 10. in 39 | t >>= drop 40 | -------------------------------------------------------------------------------- /examples/fm_arpeggiator.ml: -------------------------------------------------------------------------------- 1 | open Msynth 2 | open Stream 3 | 4 | let tempo = 130. 5 | 6 | (** Nice FM arpegiator. *) 7 | let s = 8 | let midi = MIDI.create () in 9 | let knob = MIDI.controller midi ~channel:0 in 10 | let s = Pattern.concat [[0.,8.,`Chord([72;76;79],1.)];[0.,8.,`Chord([71;72;76;79],1.)];[0.,8.,`Chord([69;72;76;79],1.)];[0.,8.,`Chord([67;71;76;79],1.)]] in 11 | let s = Pattern.transpose (-12) s in 12 | let s = Pattern.arpeggiate ~note:0.25 `Up_down s in 13 | (* let d = OSC.float "/oscControl/fader1" ~mode:`Logarithmic ~max:10000. 100. in *) 14 | let d = B.cmul 100. (now ()) in 15 | let note ~event ~on_die () = 16 | let adsr = adsr ~event ~on_die () ~a:0.01 ~d:0.1 ~r:0.001 () in 17 | let dup_adsr, adsr = dup () adsr in 18 | let fm = fm ~carrier:`Saw ~modulator:`Triangle () in 19 | fun freq _(*vol*) -> 20 | let s = dup_adsr >> B.mul d adsr >>= (fun depth -> fm ~ratio:0.5 depth freq) in 21 | B.mul s adsr 22 | in 23 | let s = Instrument.play note (Pattern.stream ~loop:true tempo s) >>= amp 0.1 in 24 | let s = 25 | let* q = knob 0 ~min:0.1 ~max:20. 0.5 in 26 | let* f = knob 1 ~max:10000. 10000. in 27 | s >>= Filter.biquad () `Low_pass q f 28 | in 29 | (* let s = s >>= agc ~dt () in *) 30 | let s = s >>= stereo >>= Stereo.dephase () (-0.01) in 31 | let kick = Instrument.kick tempo >>= amp 0.7 >>= stereo in 32 | Stereo.add s kick 33 | (* s *) 34 | 35 | let () = 36 | OSC.server 10000; 37 | Output.play s 38 | -------------------------------------------------------------------------------- /.github/workflows/build.yml: -------------------------------------------------------------------------------- 1 | name: Build 2 | on: [push] 3 | jobs: 4 | build: 5 | runs-on: ubuntu-latest 6 | steps: 7 | - uses: actions/checkout@v4 8 | - name: Setup OCaml 9 | run: sudo apt-get -y install ocaml ocaml-dune libalsa-ocaml-dev libgraphics-ocaml-dev libx11-dev libre-ocaml-dev 10 | - name: Install OSC 11 | run: | 12 | sudo apt-get -y install libounit-ocaml-dev libocplib-endian-ocaml-dev liblwt-ocaml-dev 13 | cd /tmp 14 | git clone https://github.com/johnelse/ocaml-osc.git 15 | cd ocaml-osc 16 | sed -i "s/2.9/3.14/" dune-project 17 | sed -i "s/Result.result/Result.t/" src/lwt/osc_lwt.mli 18 | dune build @install 19 | sudo dune install --prefix=/usr --libdir=`ocamlc -where` --verbose 20 | - name: Build 21 | run: make 22 | - name: Build doc 23 | run: | 24 | sudo apt-get -y install ocaml-odoc pandoc 25 | cd doc 26 | make 27 | - name: Upload website artifact 28 | uses: actions/upload-pages-artifact@v3 29 | with: 30 | path: doc 31 | 32 | deploy: 33 | if: github.ref == 'refs/heads/main' 34 | needs: build 35 | permissions: 36 | pages: write 37 | id-token: write 38 | environment: 39 | name: github-pages 40 | url: ${{ steps.deployment.outputs.page_url }} 41 | runs-on: ubuntu-latest 42 | steps: 43 | - name: Deploy website 44 | id: deployment 45 | uses: actions/deploy-pages@v4 46 | -------------------------------------------------------------------------------- /examples/song0.ml: -------------------------------------------------------------------------------- 1 | open Msynth 2 | open Extlib 3 | open Stream 4 | 5 | let s = 6 | let note f ~event ~on_die () = 7 | let s = f () in 8 | let env = adsr ~event ~on_die () ~s:0.5 ~r:0.1 () in 9 | let denv, env = dup () env in 10 | fun freq vol -> 11 | let s = s freq in 12 | let s = B.mul env s in 13 | let s = denv >> bind2 (Filter.first_order () `Low_pass) (B.cmul 10000. env) s in 14 | let s = s >>= amp vol in 15 | s 16 | in 17 | let vm = 1. in 18 | let melody = [ 19 | `Note_on (69,vm); 20 | `Note_off 69; 21 | `Note_on (72,vm); 22 | `Note_off 72; 23 | `Note_on (76,vm); 24 | `Note_off 76; 25 | `Note_on (72,vm); 26 | `Note_off 72; 27 | ] 28 | in 29 | let melody = List.mapi (fun n e -> 0.2 *. float n, e) melody in 30 | let melody = Stream.timed ~loop:true melody in 31 | let melody = Instrument.play (note sine) melody in 32 | let melody = bind2 (Filter.first_order () `Low_pass) (B.add (cst 1000.) (B.cmul 300. (sine () 10.))) melody in 33 | let vb = 0.8 in 34 | let bass1 = [`Note_on (45,vb); `Note_off 45] in 35 | let bass2 = [`Note_on (41,vb); `Note_off 41] in 36 | let bass = (List.repeat 8 bass1)@(List.repeat 8 bass2)@[`Nop] in 37 | let bass = List.mapi (fun n e -> 0.2 *. float n, e) bass in 38 | let bass = Stream.timed ~loop:true bass in 39 | let bass = Instrument.play (note saw) bass in 40 | let bass = bass >>= amp 0.5 in 41 | let bass = bass >>= Slicer.hachoir () 0.1 in 42 | let s = B.add melody bass in 43 | let s = s >>= Stereo.of_mono in 44 | let s = s >>= Stereo.delay () 0.3 ~feedback:0.4 ~ping_pong:0.2 in 45 | s >>= Stereo.amp 0.4 46 | 47 | let () = 48 | Output.play s 49 | -------------------------------------------------------------------------------- /examples/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name better_off_alone) 3 | (modules better_off_alone) 4 | (libraries msynth)) 5 | 6 | (executable 7 | (name bug) 8 | (modules bug) 9 | (libraries msynth)) 10 | 11 | (executable 12 | (name doc) 13 | (modules doc) 14 | (libraries msynth)) 15 | 16 | (executable 17 | (name filter) 18 | (modules filter) 19 | (libraries msynth)) 20 | 21 | (executable 22 | (name fm_arpeggiator) 23 | (modules fm_arpeggiator) 24 | (libraries msynth)) 25 | 26 | (executable 27 | (name midi) 28 | (modules midi) 29 | (libraries msynth)) 30 | 31 | (executable 32 | (name obx) 33 | (modules obx) 34 | (libraries msynth)) 35 | 36 | (executable 37 | (name sine) 38 | (modules sine) 39 | (libraries msynth)) 40 | 41 | (executable 42 | (name song0) 43 | (modules song0) 44 | (libraries msynth)) 45 | 46 | (executable 47 | (name song1) 48 | (modules song1) 49 | (libraries msynth)) 50 | 51 | (executable 52 | (name song2) 53 | (modules song2) 54 | (libraries msynth)) 55 | 56 | (executable 57 | (name song3) 58 | (modules song3) 59 | (libraries msynth)) 60 | 61 | (executable 62 | (name spectral) 63 | (modules spectral) 64 | (libraries msynth)) 65 | 66 | (executable 67 | (name theremin) 68 | (modules theremin) 69 | (libraries msynth)) 70 | 71 | (executable 72 | (name thx) 73 | (modules thx) 74 | (libraries msynth)) 75 | 76 | (executable 77 | (name trance) 78 | (modules trance) 79 | (libraries msynth)) 80 | 81 | (executable 82 | (name tabulated) 83 | (modules tabulated) 84 | (libraries msynth)) 85 | 86 | (executable 87 | (name r2d2) 88 | (modules r2d2) 89 | (libraries msynth)) 90 | 91 | (executable 92 | (name noise) 93 | (modules noise) 94 | (libraries msynth)) 95 | -------------------------------------------------------------------------------- /src/OSC.ml: -------------------------------------------------------------------------------- 1 | (** OSC controllers. *) 2 | 3 | let m = Mutex.create () 4 | 5 | let handlers = ref [] 6 | 7 | let add_handler path h = 8 | handlers := (path,h) :: !handlers 9 | 10 | let ts f = 11 | try 12 | Mutex.lock m; 13 | f (); 14 | Mutex.unlock m 15 | with 16 | | e -> 17 | Mutex.unlock m; 18 | raise e 19 | 20 | let handler path msg = 21 | List.iter (fun (p,h) -> if p = path then List.iter h msg) !handlers 22 | 23 | let server port = 24 | let server = Osc_unix.Udp.Server.create (Unix.ADDR_INET (Unix.inet_addr_any, port)) 1024 in 25 | ignore @@ 26 | Thread.create 27 | (fun () -> 28 | while true do 29 | match Osc_unix.Udp.Server.recv server with 30 | | Ok (Message m, _) -> handler m.address m.arguments 31 | | Ok (Bundle _, _) -> () 32 | | Error _ -> () 33 | done 34 | ) () 35 | 36 | let register_float path f = 37 | let h = function 38 | | Osc.Types.Float32 x -> ts (fun () -> f x) 39 | | _ -> () 40 | in 41 | add_handler path h 42 | 43 | let register_bool path f = 44 | let h b = ts (fun () -> f b) in 45 | let h = function 46 | | Osc.Types.Float32 x -> h (x <> 0.) 47 | | Osc.Types.Int32 x -> h (x <> Int32.zero) 48 | | Osc.Types.Blob "false" -> h false 49 | | Osc.Types.Blob _ -> h true 50 | | _ -> () 51 | in 52 | add_handler path h 53 | 54 | open Stream 55 | 56 | (* TODO: initialize sliders *) 57 | let float ?mode ?min ?max path init = 58 | let x = ref init in 59 | let stretch = Math.stretch ?mode ?min ?max in 60 | let f x' = x := stretch x' in 61 | register_float path f; 62 | stream_ref x 63 | 64 | let bool path init = 65 | let b = ref init in 66 | let f b' = b := b' in 67 | register_bool path f; 68 | stream_ref b 69 | -------------------------------------------------------------------------------- /src/extlib.ml: -------------------------------------------------------------------------------- 1 | (** Extensions to standard library. *) 2 | 3 | (** Don't do anything. *) 4 | let nop () = () 5 | 6 | (** Round to the nearest integer. *) 7 | let round x = int_of_float (x +. 0.5) 8 | 9 | module List = struct 10 | include List 11 | 12 | let make n x = init n (fun _ -> x) 13 | 14 | let repeat n l = 15 | let rec aux k = 16 | if k = 0 then [] else l@(aux (k-1)) 17 | in 18 | aux n 19 | 20 | let last l = 21 | let rec aux = function 22 | | [x] -> x 23 | | _::t -> aux t 24 | | [] -> raise Not_found 25 | in 26 | aux l 27 | 28 | let rev_iter f l = 29 | let rec aux = function 30 | | x::t -> aux t; f x 31 | | [] -> () 32 | in 33 | aux l 34 | 35 | let compose l x = 36 | let x = ref x in 37 | List.iter (fun f -> x := f !x) l; 38 | !x 39 | end 40 | 41 | module File = struct 42 | let to_string fname = 43 | let ic = open_in fname in 44 | let ans = ref "" in 45 | let buflen = 1024 in 46 | let buf = Bytes.create buflen in 47 | let n = ref 1 in 48 | while !n <> 0 do 49 | n := input ic buf 0 buflen; 50 | ans := !ans ^ String.sub (Bytes.unsafe_to_string buf) 0 !n 51 | done; 52 | !ans 53 | end 54 | 55 | module Complex = struct 56 | include Complex 57 | 58 | let make re im = { re; im } 59 | 60 | let real x = make x 0. 61 | 62 | let imaginary x = make 0. x 63 | 64 | let re c = c.re 65 | 66 | let im c = c.im 67 | 68 | let cmul a c = { re = a *. c.re; im = a *. c.im } 69 | end 70 | 71 | module Float = struct 72 | include Float 73 | 74 | let of_bool = function 75 | | false -> 0. 76 | | true -> 1. 77 | end 78 | 79 | module Random = struct 80 | include Random 81 | 82 | let float ?(min=0.) max = Random.float (max -. min) +. min 83 | end 84 | -------------------------------------------------------------------------------- /IMPLEMENTATION.md: -------------------------------------------------------------------------------- 1 | # Events in the monad 2 | 3 | One way to implement events is 4 | 5 | ```ocaml 6 | type ('a, 'e) t = dt -> 'a * ('e -> unit) 7 | ``` 8 | 9 | so that for instance `integrate` has type 10 | 11 | ``` 12 | unit -> float -> (float , [< `Reset | `Set of float]) stream 13 | ``` 14 | 15 | The return is 16 | 17 | ``` 18 | let return : 'a -> ('a , 'e) t = fun x _ -> (x, default_handler) 19 | ``` 20 | 21 | (of course, we need a variant in order to additionally specify a handler) and 22 | the bind is 23 | 24 | ``` 25 | let bind : ('a -> ('b , 'e) t) -> ('a, _) t -> ('b, 'e) t = 26 | fun f x dt -> f (fst (x dt)) dt 27 | ``` 28 | 29 | This looks nice, but we cannot access the effect handler, because it is under 30 | the function taking `dt`: we need to create a new bind such as in 31 | 32 | ``` 33 | let** x, e = integrate s in 34 | ... 35 | e `Reset 36 | ... 37 | ``` 38 | 39 | in order to get the effect handler and use it. Not very practical. 40 | 41 | Another possible implementation is 42 | 43 | ``` 44 | type ('a, 'e) t = (dt -> 'a) * ('e -> unit) 45 | ``` 46 | 47 | where we have access to the emitter at toplevel. The return is now 48 | 49 | ``` 50 | let return : 'a -> ('a , 'e) t = fun x -> (fun _ -> x), default_handler 51 | ``` 52 | 53 | and the bind is 54 | 55 | ``` 56 | let bind : ('a -> ('b , 'e) t) -> ('a, _) t -> ('b, empty) t = 57 | fun f x -> (fun dt -> fst (f (fst x dt)) dt), default_handler 58 | ``` 59 | 60 | Note that we now loose access to the handler (we have `empty` as handler type) 61 | when we have a source with parameters, this is not usable. 62 | 63 | The first option means that handler can depend on all values, but can only be 64 | used after a computation round. The second one is problematic because handlers 65 | might a priori depend on parameters and we thus have to provide a value for 66 | those. 67 | -------------------------------------------------------------------------------- /src/math.ml: -------------------------------------------------------------------------------- 1 | (** Generic arithmetical operations .*) 2 | 3 | open Extlib 4 | 5 | let clip x = max (-1.) (min 1. x) 6 | 7 | (** Stretch a parameter between 0 and 1 to be between given bounds. *) 8 | let stretch ?(mode=`Linear) ?(min=0.) ?(max=1.) = 9 | let d = max -. min in 10 | match mode with 11 | | `Linear -> fun x -> x *. d +. min 12 | | `Logarithmic -> 13 | fun x -> 14 | let x = (10. ** x -. 1.) /. 9. in 15 | x *. d +. min 16 | 17 | (** Inverse of [stretch]. *) 18 | let unstretch ?(mode=`Linear) ?(min=0.) ?(max=1.) = 19 | let d = max -. min in 20 | match mode with 21 | | `Linear -> fun x -> (x -. min) /. d 22 | | `Logarithmic -> 23 | fun x -> 24 | let x = (x -. min) /. d in 25 | log10 (x *. 9. +. 1.) 26 | 27 | (** Oscillators with period 1., first going up, starting from 0. *) 28 | module Osc = struct 29 | (** Change periodic time (between 0. and 1.) so that width becomes as 30 | specified. *) 31 | let width width = 32 | if width = 0.5 then fun t -> t 33 | else fun t -> 34 | if t <= 0.5 then t /. 0.5 *. width 35 | else (t -. 0.5) /. 0.5 *. (1. -. width) +. width 36 | 37 | (** Tablulate a function at given frequency. *) 38 | let tabulate f freq = 39 | let freqn = Float.to_int freq in 40 | let a = Array.init freqn (fun i -> f (float i /. freq)) in 41 | fun t -> 42 | a.(Float.to_int (t *. freq) mod freqn) 43 | 44 | let sine t = sin (2. *. Float.pi *. t) 45 | 46 | let triangle t = 47 | (* 48 | if t <= 0.5 then 4. *. t -. 1. 49 | else 1. -. 4. *. (t -. 0.5) 50 | *) 51 | if t <= 0.25 then 52 | 4. *. t 53 | else if t <= 0.75 then 54 | (* 1. -. 4. *. (t -. 0.25) *) 55 | 4. *. t 56 | else 57 | (* 4. *. (t -. 0.75) -. 1. *) 58 | 4. *. (t -. 1.) 59 | 60 | let square t = if t <= 0.5 then 1. else -1. 61 | 62 | let saw t = 63 | if t <= 0.5 then 2. *. t 64 | else 2. *. (t -. 1.5) 65 | 66 | let noise _ = Random.float ~min:(-1.) 1. 67 | end 68 | -------------------------------------------------------------------------------- /examples/bug.ml: -------------------------------------------------------------------------------- 1 | (** Recreating "Better off alone" by Alice DJ. *) 2 | 3 | open Msynth 4 | open Stream 5 | 6 | let () = 7 | let tempo = 137. in 8 | let lead o = 9 | [ 10 | 0. , 0.5, `Note (71, 1.); 11 | 1. , 0.5, `Note (71, 1.); 12 | 1.5, 0.5, `Note (68, 1.); 13 | 2.5, 0.5, `Note (71, 1.); 14 | 3.5, 0.5, `Note (71, 1.); 15 | 4.5, 0.5, `Note (70, 1.); 16 | 5.5, 0.5, `Note (66, 1.); 17 | 6. , 0.5, `Note (78+o, 1.); 18 | 6.7, 0.5, `Note (78+o, 1.); 19 | 7.3, 0.5, `Note (75, 1.); 20 | 8. , 0. , `Nop 21 | ] 22 | in 23 | let lead = Pattern.append (lead 0) (lead (-2)) in 24 | let lead = Pattern.stream ~loop:true tempo lead in 25 | let lead = Instrument.play (Note.simple saw) lead in 26 | let drum = 27 | [ 28 | 0., `Kick 1.; 29 | 0.5, `Snare 1.; 30 | 1., `Nop; 31 | ] 32 | in 33 | let drum = Instrument.play_drums (Stream.timed ~loop:true ~tempo drum) >>= amp 2. in 34 | let bass = 35 | [ 36 | 0. , 4., `Note (40, 1.); 37 | 4. , 4., `Note (39, 1.); 38 | 8. , 4., `Note (44, 1.); 39 | 12., 4., `Note (42, 1.); 40 | ] 41 | in 42 | (* let note = Note.adsr saw in *) 43 | let note () = 44 | let osc = square () in 45 | let lp = Filter.biquad () `Low_pass 3. in 46 | let ramp = Envelope.ramp ~kind:`Exponential () ~from:5000. ~target:100. 0.5 in 47 | fun freq -> bind2 lp ramp (osc freq) 48 | in 49 | let note = Note.adsr note in 50 | let bass = Instrument.play note (Pattern.stream ~loop:true tempo bass) in 51 | let bass = bass >>= Stream.Slicer.eurotrance () (60. /. tempo) in 52 | let chords = 53 | [ 54 | 0. , 4., `Chord ([40;44;47;52], 1.); 55 | 4. , 4., `Chord ([39;42;46;51], 1.); 56 | 8. , 4., `Chord ([44;47;51;56], 1.); 57 | 12., 4., `Chord ([42;46;49;54], 1.); 58 | ] 59 | in 60 | let arp = Pattern.arpeggiate `Up (Pattern.transpose 24 chords) in 61 | let arp = Instrument.play (Note.simple sine) (Pattern.stream ~loop:true tempo arp) in 62 | let pad = Instrument.play (Note.adsr sine) (Pattern.stream ~loop:true tempo (Pattern.transpose 12 chords)) in 63 | let s = B.mix [lead; drum; bass; arp; pad] >>= amp 0.2 in 64 | Output.play (s >>= stereo) 65 | -------------------------------------------------------------------------------- /examples/better_off_alone.ml: -------------------------------------------------------------------------------- 1 | (** Recreating "Better off alone" by Alice DJ. *) 2 | 3 | open Msynth 4 | open Stream 5 | 6 | let () = 7 | let tempo = 137. in 8 | let lead o = 9 | [ 10 | 0. , 0.5, `Note (71, 1.); 11 | 1. , 0.5, `Note (71, 1.); 12 | 1.5, 0.5, `Note (68, 1.); 13 | 2.5, 0.5, `Note (71, 1.); 14 | 3.5, 0.5, `Note (71, 1.); 15 | 4.5, 0.5, `Note (70, 1.); 16 | 5.5, 0.5, `Note (66, 1.); 17 | 6. , 0.5, `Note (78+o, 1.); 18 | 6.7, 0.5, `Note (78+o, 1.); 19 | 7.45, 0.5, `Note (75, 1.); 20 | 8. , 0. , `Nop 21 | ] 22 | in 23 | let lead = Pattern.append (lead 0) (lead (-2)) in 24 | let lead = Pattern.stream ~loop:true tempo lead in 25 | let lead = Instrument.play (Note.simple saw) lead in 26 | let drum = 27 | [ 28 | 0., `Kick 1.; 29 | 0.5, `Snare 1.; 30 | 1., `Nop; 31 | ] 32 | in 33 | let drum = Instrument.play_drums (Stream.timed ~loop:true ~tempo drum) >>= amp 2. in 34 | let bass = 35 | [ 36 | 0. , 4., `Note (40, 1.); 37 | 4. , 4., `Note (39, 1.); 38 | 8. , 4., `Note (44, 1.); 39 | 12., 4., `Note (42, 1.); 40 | ] 41 | in 42 | (* let note = Note.adsr saw in *) 43 | let note () = 44 | let osc = square () in 45 | let lp = Filter.biquad () `Low_pass 3. in 46 | let ramp = Envelope.ramp ~kind:`Exponential () ~from:5000. ~target:100. 0.5 in 47 | fun freq -> bind2 lp ramp (osc freq) 48 | in 49 | let note = Note.adsr note in 50 | let bass = Instrument.play note (Pattern.stream ~loop:true tempo bass) in 51 | let bass = bass >>= Stream.Slicer.eurotrance () (60. /. tempo) in 52 | let chords = 53 | [ 54 | 0. , 4., `Chord ([40;44;47;52], 1.); 55 | 4. , 4., `Chord ([39;42;46;51], 1.); 56 | 8. , 4., `Chord ([44;47;51;56], 1.); 57 | 12., 4., `Chord ([42;46;49;54], 1.); 58 | ] 59 | in 60 | let arp = Pattern.arpeggiate `Up (Pattern.transpose 24 chords) in 61 | let arp = Instrument.play (Note.simple sine) (Pattern.stream ~loop:true tempo arp) in 62 | let pad = Instrument.play (Note.adsr sine) (Pattern.stream ~loop:true tempo (Pattern.transpose 12 chords)) in 63 | let s = B.mix [lead; drum; bass; arp; pad] >>= amp 0.2 in 64 | Output.play (s >>= stereo) 65 | -------------------------------------------------------------------------------- /examples/midi.ml: -------------------------------------------------------------------------------- 1 | open Msynth 2 | open Stream 3 | 4 | let s = 5 | let midi = MIDI.create () in 6 | let toggle n = MIDI.toggle midi n in 7 | let midi = 8 | let t = toggle 36 in 9 | MIDI.map midi 10 | (fun c e -> 11 | match e with 12 | | `Controller (n, v) -> 13 | let n = if get t then n + 8 else n in 14 | c, `Controller (n, v) 15 | | e -> c, e 16 | ) 17 | in 18 | let knob n ?mode ?min ?max default = MIDI.controller midi ~channel:0 n ?mode ?min ?max default in 19 | let note = 20 | let a = knob 8 ~max:0.1 0.01 >>= print "a" in 21 | let d = knob 9 ~max:0.5 0.05 >>= print "d" in 22 | let s = knob 10 0.8 >>= print "s" in 23 | let r = knob 11 ~max:2. 0.1 >>= print "r" in 24 | Note.adsr ~a ~d ~s ~r saw 25 | in 26 | let note = 27 | let cents = knob 6 ~max:50. 7. in 28 | let wet = knob 7 0.5 in 29 | Note.detune ~cents ~wet note 30 | in 31 | let pad = Instrument.play (* ~portamento:(return 0.1) *) note (MIDI.events ~channel:0 midi) >>= clip in 32 | (* let pad = mul pad (knob 0 1.) in *) 33 | (* let pad = pad >>= amp 0.07 >>= Stereo.schroeder ~dt >>= Stereo.dephase ~dt (-0.01) in *) 34 | let pad = 35 | let lp = Filter.biquad () `Low_pass in 36 | let* q = knob 2 ~min:0.1 ~max:5. 1. >>= print "lpq" 37 | and* freq = knob 3 ~mode:`Logarithmic ~max:10000. 1500. >>= print "lpf" 38 | and* pad = pad in 39 | lp q freq pad 40 | in 41 | let pad = pad >>= amp 0.1 in 42 | (* let pad = bind2 (sample_and_hold ()) (Sample.every () 10) pad in *) 43 | let pad = 44 | let dephase = Stereo.dephase () in 45 | let smooth = smooth () 0.1 in 46 | let* delay = 47 | knob 4 0.01 ~min:(-0.1) ~max:0.1 48 | >>= smooth 49 | >>= initialize [-1.;1.] 50 | >>= print ~first:true "delay" 51 | in 52 | (* TODO: un commenting this makes the sound mono on right channel... *) 53 | (* let* delay = knob 67 ~max:0.1 0.01 in *) 54 | pad 55 | >>= stereo 56 | (* >>= Stereo.schroeder () *) 57 | >>= dephase delay 58 | in 59 | let pad = pad in 60 | (* let pad = exp_ramp () (-0.5) 1. 1. >>= Visu.graphics () >>= drop >> pad in *) 61 | let pad = blink_tempo (fun () -> MIDI.send midi 0 (`Note_on (4, 1.))) (fun () -> MIDI.send midi 0 (`Note_on (4, 0.))) 120. >> pad in 62 | pad 63 | 64 | let () = 65 | (* OSC.server 8000; *) 66 | Output.play s 67 | -------------------------------------------------------------------------------- /NOTES.md: -------------------------------------------------------------------------------- 1 | General resources 2 | ================= 3 | 4 | - _The Theory and Technique of Electronic Music_, Miller Pluckette 5 | - _The art of VA filter design_, Vadim Zavalishin 6 | - https://ccrma.stanford.edu/~jos/ 7 | - https://www.soundonsound.com/series/synth-secrets 8 | - https://www.reasonstudios.com/blog/discovering-reason 9 | - https://learningsynths.ableton.com/ 10 | - http://www.music.mcgill.ca/~gary/ 11 | 12 | Languages / APIs 13 | ================ 14 | 15 | - [SuperCollider](https://supercollider.github.io/) (in particular _The 16 | SuperCollider Book_ and Ruviaro's _A Gentle Introduction to SuperCollider_) 17 | - [Faust](http://faust.grame.fr/) 18 | - [Web Audio API](https://www.w3.org/TR/webaudio/) (see also [MDN 19 | documentation](https://developer.mozilla.org/en-US/docs/Web/API/Web_Audio_API)) 20 | - [Pure data]() (this [manual](http://archive.flossmanuals.net/pure-data/) has 21 | some nice explanations about aliasing for instance) 22 | 23 | Software synths 24 | =============== 25 | 26 | - all [Arturia's emulations](https://en.wikipedia.org/wiki/Arturia) 27 | - many [open source synths](https://zynthian.org/engines) 28 | - [zynaddsubfx](https://zynaddsubfx.sourceforge.io/) 29 | - [Helm](https://tytel.org/helm/) (see [the 30 | source](https://github.com/mtytel/helm)) 31 | - [Viktor NV-1](https://nicroto.github.io/viktor/) 32 | - [Nekobi](https://github.com/DISTRHO/Nekobi) LV2 emulation of TB-303 33 | - [OB-Xd](https://github.com/reales/OB-Xd) emulation of OB-X 34 | 35 | Hardware synths 36 | =============== 37 | 38 | - [Oberheim OB-X](https://en.wikipedia.org/wiki/Oberheim_OB-X) (and -Xa) 39 | - [Roland SH-101](https://en.wikipedia.org/wiki/Roland_SH-101) 40 | - [Roland Jupiter-6](https://en.wikipedia.org/wiki/Roland_Jupiter-6) (its [oscillators explained](https://blog.thea.codes/the-design-of-the-juno-dco/)) 41 | - [Roland TB-303](https://en.wikipedia.org/wiki/Roland_TB-303) 42 | - [ARP Odyssey](https://en.wikipedia.org/wiki/ARP_Odyssey) 43 | - [Sequential Circuits Prophet-5](https://en.wikipedia.org/wiki/Prophet-5) (see [this video](https://www.youtube.com/watch?v=SRWhrxpIqpU)) and [Pro-One](https://www.youtube.com/watch?v=GgSCZTckcqk) 44 | - Minimoog 45 | - [EMS VCS 3](https://en.wikipedia.org/wiki/EMS_VCS_3) 46 | - [Yamaha DX7](https://en.wikipedia.org/wiki/Yamaha_DX7) 47 | - [RSF Kobol])() (see [this video](https://www.youtube.com/watch?v=tHKt0-ihEow)) 48 | - Roland JP-8000 and in particular its super saw (see _How to Emulate the Super 49 | Saw_) 50 | 51 | Specific topics 52 | =============== 53 | 54 | - [Moog ladder filters 55 | implementations](https://github.com/ddiakopoulos/MoogLadders) 56 | -------------------------------------------------------------------------------- /examples/song2.ml: -------------------------------------------------------------------------------- 1 | open Msynth 2 | open Stream 3 | 4 | let tempo = 130. 5 | 6 | let s = 7 | let synth = Pattern.concat [[0.,8.,`Chord([72;76;79],1.)];[0.,8.,`Chord([71;72;76;79],1.)];[0.,8.,`Chord([69;72;76;79],1.)];[0.,8.,`Chord([67;71;76;79],1.)]] in 8 | (* let synth = Pattern.merge synth (Pattern.transpose 24 (Pattern.amplify 1.5 (Pattern.arpeggiate tempo ~note:(1./.8.) `Up_down synth))) in *) 9 | (* let synth = Pattern.arpeggiate tempo ~note:(1./.8.) `Up_down synth in *) 10 | let synth = Pattern.transpose (-12) synth in 11 | let sound () = 12 | let square = square () in 13 | let saw = saw () in 14 | fun freq -> 15 | B.cmul 0.5 (B.add (square (freq *. 1.007)) (saw freq)) 16 | in 17 | let synth = Instrument.play (Note.simple sound) (Pattern.stream ~loop:true tempo synth) in 18 | let lp_q = OSC.float "/oscControl/slider1" ~min:0.1 ~max:5. 1. in 19 | let lp_freq = OSC.float ~mode:`Logarithmic "/oscControl/slider2" ~max:10000. 1500. in 20 | (* let lp_freq = lp_freq >>= print ~every:22000 "freq" in *) 21 | let slicer = Slicer.staccato () ~s:0.5 in 22 | let slicer lp_q lp_freq = slicer ~lp_q ~lp_freq (Note.duration tempo 0.5) in 23 | let synth = bind3 slicer lp_q lp_freq synth in 24 | let synth = B.cmul 0.2 synth in 25 | (* let synth = *) 26 | (* let flanger = flanger ~dt 0.01 in *) 27 | (* bind2 (fun wet -> flanger ~wet (1. /. Note.duration tempo 4.)) (OSC.float "/oscControl/slider2" ~max:0.8 0.1) synth *) 28 | (* in *) 29 | (* let synth = bind3 (Filter.biquad ~dt `High_pass) (OSC.float "/oscControl/slider3" ~min:0.01 ~max:5. 1.) (OSC.float ~mode:`Logarithmic "/oscControl/slider4" ~max:10000. 1500.) synth in *) 30 | (* let synth = synth >>= Distortion.convolver ~dt 0.4 in *) 31 | let synth = synth >>= stereo in 32 | (* let synth = let d = Note.duration tempo 0.5 in synth >>= Stereo.delay ~dt d ~feedback:0.1 ~ping_pong:d in *) 33 | let synth = synth >>= Stereo.dephase () 0.01 in 34 | let synth = Stereo.bmul (OSC.bool "/oscControl/toggle1" true) synth in 35 | let bass = [72;71;69;67] in 36 | let bass = List.map (fun n -> Pattern.repeat 4 [0.,2.,`Nop; 0.,0.5,`Note (n,1.); 0.5,0.5,`Note (n,1.)]) bass in 37 | let bass = Pattern.concat bass in 38 | let bass = Pattern.transpose (-24) bass in 39 | let bass = Instrument.play (Note.adsr ~r:(return 0.1) sine) (Pattern.stream ~loop:true tempo bass) in 40 | let bass = B.cmul 0.5 bass in 41 | let bass = bass >>= stereo >>= Stereo.dephase () (-0.02) in 42 | (* let kick = Instrument.kick ~dt ~vol:1. tempo >>= stereo in *) 43 | let pd = Instrument.play_drums ~snare:(fun ~on_die _ vol -> B.cmul vol (Note.Drum.snare ~on_die ~lp:2000. ())) in 44 | let drums = pd (Pattern.midi_drums ~loop:true tempo (Pattern.load_drums "c1.drums")) >>= stereo in 45 | let drums = Stereo.bmul (OSC.bool "/oscControl/toggle2" true) drums in 46 | let s = Stereo.mix [synth;drums;bass] in 47 | (* let s = s >>= Stereo.map (agc ~dt ()) (agc ~dt ()) in *) 48 | Stereo.cmul 0.6 s 49 | 50 | let () = 51 | OSC.server 10000; 52 | Output.play s 53 | -------------------------------------------------------------------------------- /examples/doc.ml: -------------------------------------------------------------------------------- 1 | open Msynth 2 | open Stream 3 | 4 | let () = 5 | let midi = MIDI.create () in 6 | let note () = 7 | let osc = saw () in 8 | let lp = Filter.biquad () `Low_pass in 9 | let q = MIDI.controller midi 0 ~min:0.1 ~max:5. 1. >>= print "q" in 10 | let f = MIDI.controller midi 1 ~mode:`Logarithmic ~max:10000. 1500. >>= print "f" in 11 | fun freq -> 12 | let* q = q in 13 | let* f = f in 14 | osc freq >>= lp q f 15 | in 16 | let s = Instrument.play (Note.adsr note) (MIDI.events midi) >>= clip in 17 | Output.play (s >>= stereo) 18 | 19 | let () = 20 | let s = 21 | let osc = saw () 440. in 22 | let lp = Filter.biquad () `Low_pass in 23 | let a = OSC.float "/oscControl/slider1" 0.5 in 24 | let lpq = OSC.float "/oscControl/slider2" ~min:0.1 ~max:5. 1. in 25 | let lpf = OSC.float ~mode:`Logarithmic "/oscControl/slider3" ~max:10000. 1500. in 26 | let a = a >>= print "a" in 27 | let lpq = lpq >>= print "q" in 28 | let lpf = lpf >>= print "f" in 29 | let* a = a in 30 | let* f = lpf in 31 | let* q = lpq in 32 | osc 33 | >>= lp q f 34 | >>= amp a 35 | >>= stereo 36 | in 37 | OSC.server 10000; 38 | Output.play s 39 | 40 | let () = 41 | let lfo = sine () 2. in 42 | let osc = square () in 43 | let s = 44 | let* lfo = lfo in 45 | let width = 0.5 +. 0.3 *. lfo in 46 | osc ~width 440. 47 | in 48 | Output.play (s >>= stereo) 49 | 50 | let () = 51 | let pair x y = return (x, y) in 52 | let osc = sine () 440. in 53 | let eval, osc = dup () osc in 54 | let s = eval >> bind2 pair osc osc in 55 | Output.play s 56 | 57 | let () = 58 | let pair x y = return (x, y) in 59 | let osc = sine () 440. in 60 | let s = 61 | let* x = osc in 62 | pair x x 63 | in 64 | Output.play s 65 | 66 | let () = 67 | let pair x y = return (x, y) in 68 | let osc = sine () 440. in 69 | let s = bind2 pair osc osc in 70 | Output.play s 71 | 72 | let pair x y = return (x, y) 73 | 74 | let () = 75 | let left = sine () 440. in 76 | let right = sine () 880. in 77 | let s = bind2 pair left right in 78 | Output.play s 79 | 80 | let () = 81 | let left = sine () 440. in 82 | let right = sine () 880. in 83 | let s = 84 | let* x = left in 85 | let* y = right in 86 | pair x y 87 | in 88 | Output.play s 89 | 90 | let () = 91 | let s = B.cadd 440. (B.cmul 10. (sine () 5.)) >>= sine () >>= stereo in 92 | Output.play s 93 | 94 | let () = 95 | let s = 96 | let* f = sine () 5. in 97 | sine () (440. +. 10. *. f) 98 | in 99 | Output.play (s >>= stereo) 100 | 101 | let () = 102 | let lfo = sine () in 103 | let vco = sine () in 104 | let s = 105 | let* f = lfo 5. in 106 | vco (440. +. 10. *. f) 107 | (* vco (440. *. 2. ** (0.5 *. f /. 12.)) *) 108 | in 109 | Output.play (s >>= stereo) 110 | 111 | let () = 112 | let s = bind stereo (sine () 440.) in 113 | Output.play s 114 | 115 | let () = 116 | let s = 117 | let* x = sine () 440. in 118 | stereo x 119 | in 120 | Output.play s 121 | 122 | let () = 123 | let s = sine () 440. >>= stereo in 124 | Output.play s 125 | 126 | -------------------------------------------------------------------------------- /src/note.ml: -------------------------------------------------------------------------------- 1 | (** Notes. *) 2 | 3 | open Stream 4 | 5 | (** A function for creating notes. It takes as arugment the events it can 6 | recieve, as well as an [on_die] function, which it should call when the note 7 | has finished playing (we cannot determine this externally in case there is 8 | some release), and returns a function which plays a note at given frequency 9 | and volume. *) 10 | type ('sample, 'event) t = event:('event Event.t) -> on_die:(unit -> unit) -> unit -> sample -> float -> 'sample stream 11 | 12 | (** Convert note height into frequency. *) 13 | let frequency ?(detune=0.) n = 14 | 440. *. (2. ** ((n +. detune -. 69.) /. 12.)) 15 | 16 | (** Duration of a note at given tempo. *) 17 | let duration tempo d = 18 | 60. /. tempo *. d 19 | 20 | (** Note from an oscillator. *) 21 | let simple f : _ t = 22 | fun ~event ~on_die () -> 23 | let alive = ref true in 24 | let handler = function 25 | | `Release -> alive := false; on_die () 26 | in 27 | Event.register event handler; 28 | let f = f () in 29 | fun freq vol -> 30 | B.bmul (stream_ref alive) (B.cmul vol (f freq)) 31 | 32 | (** Add a detuned note on top of the note. *) 33 | let detune ?(cents=return 7.) ?(wet=return 0.5) (note : _ t) : _ t = 34 | fun ~event ~on_die () -> 35 | let n = note ~event ~on_die () in 36 | let nd = note ~event ~on_die () in 37 | fun freq vol -> 38 | let cents = get cents in 39 | let wet = get wet in 40 | let freqd = freq *. (2. ** (cents /. 1200.)) in 41 | let* d = n freq vol in 42 | let* w = nd freqd vol in 43 | return (d +. wet *. w) 44 | 45 | (** Add two notes. *) 46 | let add n1 n2 : _ t = 47 | fun ~event ~on_die () -> 48 | let n1 = n1 ~dt ~event ~on_die in 49 | let n2 = n2 ~dt ~event ~on_die in 50 | fun freq vol -> 51 | add (n1 freq vol) (n2 freq vol) 52 | 53 | (** Basic (TR-808 type) drum notes. *) 54 | module Drum = struct 55 | let kick ?on_die () = 56 | let s = B.cmul 150. (Envelope.exponential () (-9.)) >>= sine () in 57 | let env = adsr () ~a:0.001 ~d:0.1 ~s:0.9 ~sustain:false ~r:0.8 ?on_die () in 58 | B.mul env s 59 | 60 | let snare ?on_die ?(a=0.01) ?(d=0.03) ?(s=0.7) ?(r=0.07) ?(lp=80000.) () = 61 | let env = adsr () ?on_die ~a ~d ~s ~sustain:false ~r ~release:`Exponential () in 62 | let s = noise () in 63 | let lpf = Filter.first_order () `Low_pass in 64 | let* e = env in 65 | let s = B.cmul e s in 66 | s >>= lpf (lp *. e) 67 | 68 | let crash ?on_die () = 69 | let s = noise () in 70 | let env = adsr () ?on_die ~a:0.01 ~d:0.05 ~s:0.8 ~sustain:false ~r:0.5 () in 71 | B.mul env s 72 | 73 | let closed_hat ?on_die () = 74 | let s = noise () in 75 | let env = adsr () ?on_die ~a:0.001 ~d:0.005 ~s:0.3 ~sustain:false ~r:0.01 () in 76 | let s = s >>= Filter.first_order () `High_pass 4000. in 77 | B.mul env s 78 | end 79 | 80 | (** Simple note with adsr envelope and volume. *) 81 | let adsr ?a ?d ?s ?r osc : _ t = 82 | fun ~event ~on_die () -> 83 | let g = function 84 | | Some x -> Some (get x) 85 | | None -> None 86 | in 87 | let env = adsr ~event ~on_die () ?a:(g a) ?d:(g d) ?s:(g s) ?r:(g r) () in 88 | let osc = osc () in 89 | fun freq vol -> 90 | let s = osc freq in 91 | let s = B.mul env s in 92 | B.cmul vol s 93 | -------------------------------------------------------------------------------- /examples/song1.ml: -------------------------------------------------------------------------------- 1 | open Msynth 2 | open Stream 3 | 4 | let tempo = 130. 5 | 6 | let s = 7 | let note ?(detune=false) ?(r=0.1) ?(s=0.5) f ~event ~on_die () = 8 | let env = adsr ~event ~on_die () ~a:0.01 ~d:0.1 ~s ~r () in 9 | let s = f () in 10 | let sd = f () in 11 | fun freq vol -> 12 | let s = s freq in 13 | let sd = sd (freq *. 1.007) in 14 | let s = if detune then B.cmul 0.8 (B.add s sd) else s in 15 | let s = B.mul env s in 16 | B.cmul vol s 17 | in 18 | let vm = 1. in 19 | let melody = 20 | [ 21 | 0.,0.75,`Note (77,vm); 22 | 1.,0.5,`Note (76,vm); 23 | 1.5,1.,`Note (72,vm); 24 | 0.,4.,`Nop; 25 | ] 26 | in 27 | let melody = Pattern.repeat 3 melody in 28 | let melody = Pattern.append melody [0.,4.,`Nop] in 29 | let melody = Instrument.play (note ~detune:false ~r:0.3 saw) (Pattern.stream ~loop:true tempo melody) in 30 | let melody = bind2 (Filter.first_order () `Low_pass) (B.add (cst 600.) (B.cmul 300. (sine () 10.))) melody in 31 | let melody = B.mul melody (OSC.float "/oscControl/fader2" 1.) in 32 | let melody = bind3 (Filter.biquad () `Low_pass) (OSC.float "/oscControl/fader3" ~min:0.1 ~max:20. 0.5) (OSC.float "/oscControl/fader4" ~max:10000. 10000.) melody in 33 | let melody = melody >>= Stereo.of_mono in 34 | let melody = melody >>= Stereo.dephase () 0.01 in 35 | let vs = 0.7 in 36 | let synth1 = Pattern.repeat 16 [0., 0.25, `Chord ([65;69;72],vs); 0.25, 0.25, `Nop] in 37 | let synth2 = Pattern.repeat 16 [0., 0.25, `Chord ([64;69;72],vs); 0.25, 0.25, `Nop] in 38 | let synth = Pattern.append synth1 synth2 in 39 | let synth = Instrument.play (note karplus_strong) (Pattern.stream ~loop:true tempo synth) in 40 | (* (\* let disto = add (cst (-1.)) (cmul 2. (OSC.float "/oscControl/fader4" 0.5)) in *\) *) 41 | (* (\* let synth = bind2 disto synth (distortion ~dt) in *\) *) 42 | let synth = B.mul (OSC.float "/oscControl/fader1" 0.5) synth in 43 | let synth = synth >>= flanger () ~wet:0.8 0.001 (Note.duration tempo 1.) in 44 | let vb = 1.1 in 45 | let bass = [0.,16.,`Nop;0.,3.,`Note (41, vb);4.,3.,`Note (38, vb);8.,3.,`Note (45, vb);12.,3.,`Note (45, vb)] in 46 | let bass = Instrument.play (note ~s:0.8 ~r:0.4 sine) (Pattern.stream ~loop:true tempo bass) in 47 | let kick = Pattern.repeat 16 [0.,0.25,`Note(69,1.8);0.,1.,`Nop] in 48 | let kick = Instrument.play_drum (fun ~on_die _ vol -> B.cmul vol (Note.Drum.kick ~on_die ())) (Pattern.stream ~loop:true tempo kick) in 49 | let snare = Pattern.repeat 16 [1.,0.25,`Note(69,0.8);0.,2.,`Nop] in 50 | let snare = Instrument.play_drum (fun ~on_die _ vol -> B.cmul vol (Note.Drum.snare ~on_die ())) (Pattern.stream ~loop:true tempo snare) in 51 | let s = synth in 52 | (* (\* let s = bind2 (integrate ~dt 100.) s (Filter.first_order ~dt `Low_pass) in *\) *) 53 | (* (\* let s = s >>= slicer ~dt 0.01 in *\) *) 54 | let s = s >>= Stereo.of_mono in 55 | (* (\* let deph = let deph = Stereo.dephase ~dt 0.1 in fun d x -> deph ~delay:d x in *\) *) 56 | (* (\* let s = bind2 (sub (cmul 0.1 (OSC.float "/oscControl/fader5" 0.51)) (cst 0.05)) s deph in *\) *) 57 | let s = Stereo.add s (bass >>= Stereo.of_mono >>= Stereo.dephase () (-0.02)) in 58 | let s = Stereo.add s (snare >>= Stereo.of_mono >>= Stereo.dephase () (-0.01)) in 59 | let s = Stereo.add s (kick >>= Stereo.of_mono) in 60 | let s = Stereo.add s melody in 61 | let s = Stereo.cmul 0.2 s in 62 | s 63 | 64 | let () = 65 | Output.play s 66 | -------------------------------------------------------------------------------- /src/visu.ml: -------------------------------------------------------------------------------- 1 | (** Visualization of streams. *) 2 | 3 | open Extlib 4 | open Stream 5 | 6 | (** Plot a stream. *) 7 | let graphics () = 8 | Graphics.open_graph ""; 9 | let x = ref 0 in 10 | let every = 441/2 in 11 | let e = ref (every-1) in 12 | let fg = Graphics.green in 13 | let bg = Graphics.black in 14 | let bar = Graphics.rgb 200 200 200 in 15 | Graphics.set_color bg; 16 | Graphics.fill_rect 0 0 (Graphics.size_x ()) (Graphics.size_y ()); 17 | fun v -> 18 | incr e; 19 | if !e = every then 20 | ( 21 | e := 0; 22 | let y = (v+.1.)/.2. in 23 | let sy = Graphics.size_y () in 24 | let y = int_of_float (y*.float sy) in 25 | Graphics.set_color bar; 26 | Graphics.moveto (!x+1) 0; 27 | Graphics.lineto (!x+1) sy; 28 | Graphics.set_color bg; 29 | Graphics.moveto !x 0; 30 | Graphics.lineto !x sy; 31 | Graphics.set_color fg; 32 | Graphics.plot !x y; 33 | incr x; 34 | if !x >= Graphics.size_x () then x := 0 35 | ); 36 | return v 37 | 38 | (** Plot a spectral analysis of the stream. *) 39 | let bands ?(bands=1024) ?(scale=`Logarithmic) ?(amp=1.) () = 40 | Graphics.open_graph ""; 41 | let fg = Graphics.red in 42 | let buflen = 2 * bands in 43 | let buf = Array.make buflen Complex.zero in 44 | let bufpos = ref 0 in 45 | let scale sx = 46 | match scale with 47 | | `Linear -> 48 | let w = sx / bands in 49 | (fun i -> i * w) 50 | | `Logarithmic -> 51 | let sx = float sx in 52 | let bands = float bands in 53 | (fun i -> int_of_float (log10 (float i/.bands*.9.+.1.) *. sx)) 54 | in 55 | fun x -> 56 | let* dt = dt in 57 | let every = int_of_float (0.5/.dt) in 58 | let e = ref (every-1) in 59 | buf.(!bufpos) <- Complex.real x; 60 | incr bufpos; 61 | if !bufpos = buflen then 62 | ( 63 | bufpos := 0; 64 | e := !e + buflen; 65 | if !e >= every then 66 | ( 67 | e := 0; 68 | let freq = Sample.fft (Spectral.Window.hamming buf) 0 (2*bands) in 69 | let scale = scale (Graphics.size_x ()) in 70 | let sy = float (Graphics.size_y ()) in 71 | Graphics.clear_graph (); 72 | Graphics.set_color fg; 73 | for i = 0 to bands - 1 do 74 | let h = int_of_float (Complex.norm freq.(i) *. amp *. sy) in 75 | Graphics.fill_rect (scale i) 0 (scale (i+1)) h 76 | done; 77 | let m = ref 0. in 78 | let mi = ref 0 in 79 | for i = 0 to buflen / 2 - 1 do 80 | let x = Complex.norm freq.(i) in 81 | if x > !m then (m := x; mi := i) 82 | done; 83 | Graphics.set_color Graphics.black; 84 | let t = Printf.sprintf "%f Hz (max: %f)" (float !mi /. float buflen /. dt) !m in 85 | let tx, ty = Graphics.text_size t in 86 | Graphics.moveto (Graphics.size_x () - tx) (Graphics.size_y () - ty); 87 | Graphics.draw_string t 88 | ) 89 | ); 90 | return x 91 | 92 | (** Operations on stereo streams. *) 93 | module Stereo = struct 94 | let bands = 95 | let b = bands in 96 | fun ?bands ?amp () -> 97 | let bands = b ?bands ?amp () in 98 | fun x -> Stereo.to_mono x >>= bands >>= drop >> return x 99 | end 100 | -------------------------------------------------------------------------------- /examples/trance.ml: -------------------------------------------------------------------------------- 1 | open Msynth 2 | open Stream 3 | 4 | let s = 5 | let tempo = 138. in 6 | let pad = Pattern.concat [ 7 | [0.,8.,`Chord([64;69;72],0.8);6.,1.,`Note(76,0.6);7.,1.,`Note(74,0.6)]; 8 | [0.,8.,`Chord([64;68;71],0.8);6.,1.,`Note(74,0.6);7.,1.,`Note(72,0.6)]; 9 | [0.,8.,`Chord([64;65;69],0.8);6.,1.,`Note(71,0.6);7.,1.,`Note(72,0.6)]; 10 | [0.,8.,`Chord([64;68;71],0.8)]; 11 | ] 12 | in 13 | let pad = Pattern.merge pad [0.,32.,`Note(40,2.5)] in 14 | let pad = Instrument.play (Note.simple sine) (Pattern.stream ~loop:true tempo pad) in 15 | let pad = pad >>= amp 0.07 >>= Stereo.schroeder () >>= Stereo.dephase () (-0.01) in 16 | let bass_note ~event ~on_die () = 17 | let adsr = adsr ~event ~on_die () ~a:0.01 ~d:0.1 ~r:0.001 () in 18 | let dup_adsr, adsr = dup () adsr in 19 | let fm = fm ~carrier:`Saw ~modulator:`Triangle () in 20 | (* let exp = Envelope.exponential_hl () in *) 21 | fun freq _ -> 22 | let s = dup_adsr >> B.cmul 500. adsr >>= (fun depth -> fm ~ratio:1. depth freq) in 23 | (* let r = exp (vol *. 0.04) in *) 24 | (* let r = cadd 500. (cmul (10000.*.vol**4.) r) in *) 25 | (* let s = bind2 (Filter.biquad ~dt `Low_pass 4.) r s in *) 26 | B.mul s adsr 27 | in 28 | let bass v = [0.,4.,`Nop; 0.,0.5,`Note (64,v); 0.75,0.5,`Note (64,v); 1.5,0.5,`Note (64,v); 2.5,0.5,`Note (64,v); 3.,0.5,`Note (65,v)] in 29 | let bass = Pattern.concat (List.map bass [0.6;0.7;0.8;1.]) in 30 | let bass = Pattern.transpose (-24) bass in 31 | let bass = Instrument.play bass_note (Pattern.stream ~loop:true tempo bass) in 32 | let bass = B.cmul 0.08 bass in 33 | (* let bass = bind3 (Filter.biquad ~dt `Low_pass) (OSC.float "/oscControl/fader3" ~min:0.1 ~max:20. 0.5) (OSC.float "/oscControl/fader4" ~min:1. ~max:5000. 5000.) bass in *) 34 | (* let bass = bass >>= stereo >>= Stereo.dephase ~dt 0.01 in *) 35 | let bass = bass >>= Stereo.schroeder2 () in 36 | let bass = let d = Note.duration tempo 0.5 in bass >>= Stereo.delay () d ~feedback:0.1 ~ping_pong:d in 37 | (* let bass2 = Instrument.play ~dt (Note.adsr ~a:0.01 ~d:0.05 ~r:0.1 (square ?width:None)) (Pattern.midi tempo bass2) in *) 38 | (* let bass2 = bass2 >>= amp 0.1 >>= Stereo.schroeder ~dt in *) 39 | (* let bass2 = let d = Note.duration tempo 0.5 in bass2 >>= Stereo.delay ~dt d ~feedback:0.1 ~ping_pong:d in *) 40 | (* let slice = [0.,8.,`Note(72,1.);8.,8.,`Note(71,1.)] in *) 41 | (* let slice = Instrument.play ~dt (Note.simple saw) (Pattern.midi tempo slice) in *) 42 | (* let slice = slice >>= Slicer.eurotrance ~dt (Note.duration tempo 1.) in *) 43 | (* let slice = slice >>= amp 0.4 >>= stereo in *) 44 | let pd = Instrument.play_drums ~snare:(fun ~on_die _ vol -> Note.Drum.snare ~on_die ~lp:2400. () >>= amp vol) in 45 | let drums = pd (Pattern.midi_drums ~loop:true tempo (Pattern.load_drums "basic.drums")) >>= amp 1. >>= stereo in 46 | (* let drums = *) 47 | (* let fv = Stereo.freeverb () in *) 48 | (* bind6 *) 49 | (* (fun roomsize damp width wet dry -> fv ~roomsize ~damp ~width ~dry ~wet) *) 50 | (* (OSC.float "/oscControl/fader1" 0.5) *) 51 | (* (OSC.float "/oscControl/fader2" ~min:1. ~max:0. 0.5) *) 52 | (* (OSC.float "/oscControl/fader3" 1.) *) 53 | (* (OSC.float "/oscControl/fader4" 0.3) *) 54 | (* (OSC.float "/oscControl/fader5" 0.3) *) 55 | (* drums *) 56 | (* in *) 57 | let s = Stereo.mix [bass;drums;pad] >>= Stereo.amp 0.3 in 58 | s 59 | (* s >>= Visu.Stereo.bands ~dt ~amp:5. () *) 60 | 61 | let () = 62 | OSC.server 10000; 63 | Output.play s 64 | -------------------------------------------------------------------------------- /src/pattern.ml: -------------------------------------------------------------------------------- 1 | (** Patterns are small musical phrases or chords. *) 2 | 3 | open Extlib 4 | 5 | (** Musical patterns. Events in patterns are (time,duration,event). All time units are bpm here. *) 6 | type 'event t = (float * float * 'event) list 7 | 8 | (* TODO: handle unsorted patterns? *) 9 | let duration (p:'a t) = 10 | List.fold_left (fun m (t,d,_) -> max m (t +. d)) 0. p 11 | 12 | let offset o (p:'a t) : 'a t = List.map (fun (t,d,e) -> t+.o,d,e) p 13 | 14 | let merge p1 p2 : 'a t = p1@p2 15 | 16 | let append p1 p2 = 17 | merge p1 (offset (duration p1) p2) 18 | 19 | let concat pp = List.fold_left append [] pp 20 | 21 | let repeat n p : 'a t = 22 | let d = duration p in 23 | let rec aux k = 24 | if k = n then [] else 25 | (offset (d *. float k) p)@(aux (k+1)) 26 | in 27 | aux 0 28 | 29 | let transpose t (p : 'a t) : 'a t = 30 | let f n = n + t in 31 | List.map 32 | (fun (t,d,e) -> 33 | t,d, 34 | match e with 35 | | `Chord (l,v) -> `Chord (List.map f l,v) 36 | | `Note (n,v) -> `Note (f n,v) 37 | | `Nop -> `Nop) 38 | p 39 | 40 | let amplify a (p : 'a t) : 'a t = 41 | List.map 42 | (fun (t,d,e) -> 43 | t,d, 44 | match e with 45 | | `Chord (l,v) -> `Chord(l,a*.v) 46 | | `Note (n,v) -> `Note (n,a*.v) 47 | | `Nop -> `Nop) 48 | p 49 | 50 | (** Arpeggiator. *) 51 | let arpeggiate ?(note=0.25) mode (p : 'a t) : 'a t = 52 | let ans = 53 | List.map 54 | (fun (t,d,e) -> 55 | match e with 56 | | `Chord (l,v) -> 57 | let ans = ref [] in 58 | let add t' d n = ans := (t+.t',d,`Note (n,v)) :: !ans in 59 | let notes = int_of_float (d /. note) in 60 | ( 61 | match mode with 62 | | `Up_down -> 63 | let n = match l with 64 | | [n1;n2;n3] -> [|n1;n2;n3;n1+12;n2+12;n1+12;n3;n2|] 65 | | [n1;n2;n3;n4] -> [|n1;n2;n3;n4;n1+12;n4;n3;n2|] 66 | | _ -> assert false 67 | in 68 | for i = 0 to notes - 1 do 69 | add (float i *. note) note n.(i mod 8) 70 | done 71 | | `Up -> 72 | let n = match l with 73 | | [n1] -> [|n1|] 74 | | [n1;n2;n3;n4] -> [|n1;n2;n3;n4|] 75 | | _ -> assert false 76 | in 77 | for i = 0 to notes - 1 do 78 | add (float i *. note) note n.(i mod Array.length n) 79 | done 80 | | `Staccato -> 81 | for i = 0 to notes - 1 do 82 | List.iter (fun n -> add (float i *. note) note n) l 83 | done 84 | ); 85 | !ans 86 | | e -> [t,d,e] 87 | ) p 88 | in 89 | List.flatten ans 90 | 91 | (** Convert a pattern to a stream of MIDI events. *) 92 | let stream ?loop bpm p : MIDI.stream = 93 | (* Timed midi events. *) 94 | let events = 95 | let duration = Note.duration bpm in 96 | let ans = ref [] in 97 | let emit t e = ans := (t,e) :: !ans in 98 | let rec aux = function 99 | | t,d,`Note (n,v) -> 100 | emit (duration t) (`Note_on (n,v)); 101 | emit (duration t +. duration d) (`Note_off n) 102 | | t,d,`Chord (l,v) -> 103 | let l = List.map (fun n -> t,d,`Note (n,v)) l in 104 | List.iter aux l 105 | | t,d,`Nop -> emit (duration t +. duration d) `Nop 106 | in 107 | List.iter aux p; 108 | List.sort (fun (t1,_) (t2,_) -> compare t1 t2) !ans 109 | in 110 | Stream.timed ?loop events 111 | 112 | let midi_drums ?loop bpm (p:'a t) = 113 | let events = 114 | let duration = Note.duration bpm in 115 | let ans = ref [] in 116 | let emit t e = ans := (t,e) :: !ans in 117 | let aux (t,d,e) = 118 | let t = if e = `Nop then duration (t+.d) else duration t in 119 | emit t e 120 | in 121 | List.iter aux p; 122 | List.sort (fun (t1,_) (t2,_) -> compare t1 t2) !ans 123 | in 124 | Stream.timed ?loop events 125 | 126 | let load_drums fname : 'a t = 127 | let open Re in 128 | let lines = Str.split (Str.regexp "\n") (File.to_string fname) in 129 | let ans = ref [] in 130 | let add t d e = ans := (t,d,e) :: !ans in 131 | let line_re = Str.regexp "^\\([a-zA-Z]+\\)(\\([0-9\\.]*\\))[ ]*:\\([X ]*\\)$" in 132 | (* TODO: parameter for duration of characters *) 133 | let duration = 1. /. 4. in 134 | List.iter (fun l -> 135 | assert (Str.string_match line_re l 0); 136 | let name = Str.matched_group 1 l in 137 | let vol = Str.matched_group 2 l in 138 | let vol = if vol = "" then 1. else float_of_string vol in 139 | let e = 140 | match name with 141 | | "KD" | "BD" -> `Kick vol 142 | | "SD" -> `Snare vol 143 | | "CH" -> `Closed_hat vol 144 | | _ -> `Nop 145 | in 146 | let pattern = Str.matched_group 3 l in 147 | let len = String.length pattern in 148 | add 0. (float len *. duration) `Nop; 149 | for i = 0 to len - 1 do 150 | if pattern.[i] = 'X' then 151 | add (float i *. duration) duration e 152 | done; 153 | ) lines; 154 | !ans 155 | -------------------------------------------------------------------------------- /src/output.ml: -------------------------------------------------------------------------------- 1 | (** Outputs. *) 2 | 3 | open Stream 4 | 5 | (* 6 | class pulseaudio ?(channels=2) samplerate = 7 | let sample = 8 | { Pulseaudio. 9 | sample_format = Pulseaudio.Sample_format_float32le; 10 | sample_rate = samplerate; 11 | sample_chans = 2; 12 | } 13 | in 14 | let o = Pulseaudio.Simple.create ~client_name:"ocamlsynth" ~dir:Pulseaudio.Dir_playback ~stream_name:"sound" ~sample () in 15 | object 16 | method buflen = 1024 17 | 18 | method write buf = 19 | Pulseaudio.Simple.write o buf 0 (Array.length buf.(0)) 20 | 21 | method close = (* TODO *) () 22 | end 23 | *) 24 | 25 | class alsa ?(channels=2) samplerate = 26 | let open Alsa in 27 | let dev, period_size = 28 | let buflen = 2048 in 29 | let periods = 4 in 30 | let dev = Pcm.open_pcm "default" [Pcm.Playback] [] in 31 | let params = Pcm.get_params dev in 32 | Pcm.set_access dev params Pcm.Access_rw_interleaved; 33 | Pcm.set_format dev params Pcm.Format_float; 34 | let _ = Pcm.set_rate_near dev params samplerate Dir_eq in 35 | Pcm.set_channels dev params channels; 36 | Pcm.set_buffer_size dev params buflen; 37 | Pcm.set_periods dev params periods Dir_eq; 38 | Pcm.set_params dev params; 39 | let period_size = Pcm.get_period_size params in 40 | Pcm.prepare dev; 41 | dev, period_size 42 | in 43 | let ba = Bigarray.Array1.create Bigarray.Float32 Bigarray.C_layout (channels * period_size) in 44 | object (self) 45 | method buflen = period_size 46 | 47 | method write buf = 48 | let buflen = self#buflen in 49 | for i = 0 to buflen - 1 do 50 | for c = 0 to channels - 1 do 51 | ba.{channels*i+c} <- buf.(c).(i) 52 | done 53 | done; 54 | try ignore (Pcm.writei_float_ba dev channels ba) 55 | with 56 | | Alsa.Buffer_xrun -> 57 | Printf.eprintf "ALSA: buffer xrun\n%!"; 58 | Pcm.prepare dev 59 | 60 | method close = () 61 | end 62 | 63 | (* 64 | class portaudio ?(channels=2) samplerate = 65 | let () = Portaudio.init () in 66 | let samplerate = float_of_int samplerate in 67 | let latency = 1. in 68 | let device = Portaudio.get_default_output_device () in 69 | let fmt = { Portaudio. channels; device; sample_format = Portaudio.format_float32; latency } in 70 | let stream = Portaudio.open_stream ~interleaved:false None (Some fmt) samplerate 0 [] in 71 | object 72 | method write buf = 73 | Portaudio.write_stream stream buf 0 (Array.length buf.(0)) 74 | 75 | method close = (* TODO *) () 76 | end 77 | *) 78 | 79 | class wav ?(channels=2) samplerate fname = 80 | let oc = open_out fname in 81 | object (self) 82 | initializer 83 | let bits_per_sample = 16 in 84 | self#output "RIFF"; 85 | self#output_int 0; 86 | self#output "WAVE"; 87 | (* Format *) 88 | self#output "fmt "; 89 | self#output_int 16; 90 | self#output_short 1; 91 | self#output_short channels; 92 | self#output_int samplerate; 93 | self#output_int (samplerate * channels * bits_per_sample / 8); 94 | self#output_short (channels * bits_per_sample / 8); 95 | self#output_short bits_per_sample; 96 | (* Data *) 97 | self#output "data"; 98 | (* size of the data, to be updated afterwards *) 99 | self#output_short 0xffff; 100 | self#output_short 0xffff 101 | 102 | method private output s = output_string oc s 103 | 104 | method private output_num b n = 105 | let s = Bytes.create b in 106 | for i = 0 to b - 1 do 107 | Bytes.set s i (char_of_int ((n lsr (8 * i)) land 0xff)) 108 | done; 109 | self#output (Bytes.to_string s) 110 | 111 | method private output_byte n = self#output_num 1 n 112 | 113 | method private output_short n = self#output_num 2 n 114 | 115 | method private output_int n = self#output_num 4 n 116 | 117 | method private output_short_float x = 118 | let x = min 32767 (max (-32767) (int_of_float (x *. 32767.))) in 119 | self#output_short x 120 | 121 | method write buf = 122 | assert (Array.length buf = channels); 123 | for i = 0 to Array.length buf.(0) - 1 do 124 | for c = 0 to channels - 1 do 125 | self#output_short_float buf.(c).(i) 126 | done 127 | done 128 | 129 | method close : unit = 130 | close_out oc 131 | end 132 | 133 | exception End_of_stream 134 | 135 | (** Play a stream using soundcard. *) 136 | let play ?(samplerate=44100) ?duration s = 137 | let s = 138 | match duration with 139 | | None -> s 140 | | Some t -> at () t >>= on (fun () -> raise End_of_stream) >> s 141 | in 142 | let dt = 1. /. float samplerate in 143 | Random.self_init (); 144 | let out = new alsa samplerate in 145 | let buflen = out#buflen in 146 | let buf = Array.init 2 (fun _ -> Array.make buflen 0.) in 147 | let wavout = new wav samplerate "output.wav" in 148 | try 149 | while true do 150 | for i = 0 to buflen - 1 do 151 | let l, r = s dt in 152 | buf.(0).(i) <- l; 153 | buf.(1).(i) <- r 154 | done; 155 | out#write buf; 156 | wavout#write buf 157 | done; 158 | with 159 | | End_of_stream -> 160 | out#close; 161 | wavout#close 162 | -------------------------------------------------------------------------------- /src/MIDI.ml: -------------------------------------------------------------------------------- 1 | (** Interfacing with MIDI keyboards and controllers. *) 2 | 3 | open Stream.Operations 4 | 5 | type event = 6 | [ `Note_on of int * float 7 | | `Note_off of int 8 | | `Controller of int * float 9 | | `Pitch_bend of int * float 10 | | `Program_change of int * int 11 | | `Nop (** Do not do anything. This is useful to extend repeated patterns. *) 12 | ] 13 | 14 | (** A stream of MIDI events. *) 15 | type stream = event list Stream.t 16 | 17 | type t = 18 | { 19 | mutex : Mutex.t; 20 | thread : Thread.t; 21 | map : int -> event -> (int * event); 22 | handlers : (int -> event -> unit) list ref; 23 | send : int -> event -> unit 24 | } 25 | 26 | let create ?(print=false) () = 27 | let mutex = Mutex.create () in 28 | let handlers = ref [] in 29 | let seq = Alsa.Sequencer.create "default" `Duplex in 30 | let thread = 31 | Thread.create 32 | (fun () -> 33 | let open Alsa in 34 | Sequencer.set_client_name seq "Monadic synth"; 35 | let port = Sequencer.create_port seq "Input" [Port_cap_write; Port_cap_subs_write] [Port_type_MIDI_generic] in 36 | Sequencer.subscribe_read_all seq port; 37 | Sequencer.subscribe_write_all seq port; 38 | Printf.printf "synth started\n%!"; 39 | let add c e = 40 | Mutex.lock mutex; 41 | List.iter (fun f -> f c e) !handlers; 42 | Mutex.unlock mutex 43 | in 44 | while true do 45 | match (Sequencer.input_event seq).ev_event with 46 | | Sequencer.Event.Note_on n -> 47 | let c, n, v = n.note_channel, n.note_note, float_of_int n.note_velocity /. 127. in 48 | if print then Printf.printf "note on (%d): %d at %f\n%!" c n v; 49 | add c (`Note_on (n, v)) 50 | | Sequencer.Event.Note_off n -> 51 | let c, n = n.note_channel, n.note_note in 52 | if print then Printf.printf "note off (%d): %d\n%!" c n; 53 | add c (`Note_off n) 54 | | Sequencer.Event.Controller c -> 55 | let c, n, v = c.controller_channel, c.controller_param, float c.controller_value /. 127. in 56 | if print then Printf.printf "controller (%d): %d at %f\n%!" c n v; 57 | add c (`Controller (n, v)) 58 | | Sequencer.Event.Pitch_bend c -> 59 | let c, n, v = c.controller_channel, c.controller_param, float c.controller_value /. 8192. in 60 | if print then Printf.printf "pitch bend (%d): %d at %f\n%!" c n v; 61 | add c (`Pitch_bend (n, v)) 62 | | Sequencer.Event.Program_change c -> 63 | let c, n, v = c.controller_channel, c.controller_param, c.controller_value in 64 | if print then Printf.printf "program change (%d): %d at %d\n%!" c n v; 65 | add c (`Program_change (n, v)) 66 | | _ -> 67 | if print then Printf.printf "unknown event\n%!" 68 | done 69 | ) () 70 | in 71 | let send chan e = 72 | let open Alsa in 73 | let e = match e with 74 | | `Note_on (n, v) -> 75 | let v = int_of_float (v *. 127.) in 76 | (* Printf.printf "note on: %d at %d\n%!" n v; *) 77 | Sequencer.Event.Note_on {Sequencer.Event. note_channel = chan; note_note = n; note_velocity = v; note_off_velocity = v; note_duration = 1000} 78 | | _ -> failwith "TODO" 79 | in 80 | Sequencer.output_event seq e 81 | in 82 | { 83 | mutex; 84 | thread; 85 | map = (fun c e -> (c,e)); 86 | handlers; 87 | send; 88 | } 89 | 90 | (** Register a handler of midi events. *) 91 | let register midi h = 92 | let h c e = 93 | let c, e = midi.map c e in 94 | h c e 95 | in 96 | midi.handlers := h :: !(midi.handlers) 97 | 98 | (** Map a function on all events. *) 99 | let map midi f = 100 | let map c e = 101 | let c, e = midi.map c e in 102 | f c e 103 | in 104 | { midi with map } 105 | 106 | (** Create a stream of midi events. *) 107 | let events ?channel midi : stream = 108 | let m = Mutex.create () in 109 | let nn = ref [] in 110 | let h c e = 111 | if channel = None || Some c = channel then 112 | ( 113 | Mutex.lock m; 114 | nn := e :: !nn; 115 | Mutex.unlock m 116 | ) 117 | in 118 | register midi h; 119 | let s () = 120 | Mutex.lock m; 121 | let ee = !nn in 122 | nn := []; 123 | Mutex.unlock m; 124 | ee 125 | in 126 | Stream.seq s 127 | 128 | let send midi = midi.send 129 | 130 | (** The value of a specific controller. *) 131 | let controller midi ?channel number ?mode ?min ?max init = 132 | let stretch = Math.stretch ?mode ?min ?max in 133 | let m = Mutex.create () in 134 | let x = ref init in 135 | let h c e = 136 | if channel = None || Some c = channel then 137 | match e with 138 | | `Controller (n,v) when n = number -> 139 | Mutex.lock m; 140 | x := stretch v; 141 | Mutex.unlock m 142 | | _ -> () 143 | in 144 | register midi h; 145 | Stream.stream_ref x 146 | 147 | let pitch_bend midi ?channel ?mode ?max () = 148 | let stretch = Math.stretch ?mode ?max in 149 | let m = Mutex.create () in 150 | let x = ref 0. in 151 | let h c e = 152 | if channel = None || Some c = channel then 153 | match e with 154 | | `Pitch_bend (_,v) -> 155 | Mutex.lock m; 156 | x := stretch v; 157 | Mutex.unlock m 158 | | _ -> () 159 | in 160 | register midi h; 161 | Stream.stream_ref x 162 | 163 | (** The value of a toggle controller. *) 164 | let toggle midi ?channel ?(init=false) number = 165 | let* x = controller midi ?channel number (if init then 1. else 0.) in 166 | return (x <> 0.) 167 | -------------------------------------------------------------------------------- /src/instrument.ml: -------------------------------------------------------------------------------- 1 | (** Instruments. *) 2 | 3 | open Extlib 4 | open Stream 5 | 6 | (** A note of an instrument. *) 7 | type ('sample, 'event) note = 8 | { 9 | note : int; (** Note: A4 is 69. *) 10 | stream : 'sample stream; 11 | event : 'event Event.t; 12 | mutable released : bool; 13 | alive : bool ref; (** is the note still playing? *) 14 | } 15 | 16 | (** Create an instrument. *) 17 | let create add ~event ?portamento (note:_ Note.t) = 18 | (* Currently playing notes. *) 19 | let playing = ref [] in 20 | let n = ref 0 in 21 | let stream = 22 | let* _ = dt in 23 | let ss = List.map (fun n -> n.stream) !playing in 24 | let* x = add ss in 25 | incr n; 26 | (* Regularly remove non-alive notes. *) 27 | if !n = 50000 then 28 | ( 29 | n := 0; 30 | playing := List.filter (fun n -> !(n.alive)) !playing 31 | ); 32 | return x 33 | in 34 | let last_freq = ref None in 35 | let handler = function 36 | | `Note_on (n,v) -> 37 | let event = Event.create () in 38 | let alive = ref true in 39 | let on_die () = alive := false in 40 | let freq = Note.frequency (float n) in 41 | (* let stream = note ~event ~on_die () freq v in *) 42 | let freq = 43 | match portamento with 44 | | None -> return freq 45 | | Some p -> 46 | ( 47 | match !last_freq with 48 | | None -> 49 | last_freq := Some freq; 50 | return freq 51 | | Some a -> 52 | let b = freq in 53 | last_freq := Some freq; 54 | let ramp = Envelope.ramp () in 55 | (* let ramp = exp_ramp in *) 56 | let* p = p in 57 | ramp ~from:a ~target:b p 58 | ) 59 | in 60 | let note = note ~event ~on_die () in 61 | let stream = 62 | let* freq = freq in 63 | note freq v 64 | in 65 | let note = 66 | { 67 | note = n; 68 | stream; 69 | event; 70 | released = false; 71 | alive; 72 | } 73 | in 74 | playing := note :: !playing 75 | | `Note_off n -> 76 | ( 77 | try 78 | (* Only kill oldest alive note. *) 79 | List.rev_iter (fun note -> if note.note = n && not note.released && !(note.alive) then (note.released <- true; Event.emit note.event `Release; raise Exit)) !playing 80 | with 81 | | Exit -> () 82 | ) 83 | (* playing := List.filter (fun (n',_) -> n' <> n) !playing *) 84 | | _ -> () 85 | in 86 | Event.register event handler; 87 | stream 88 | 89 | let create_stereo ~event = 90 | let (+.) (x1,y1) (x2,y2) = x1 +. x2, y1 +. y2 in 91 | let add = StreamList.fold_left (+.) (0.,0.) in 92 | create add ~event 93 | 94 | let create ~event = 95 | let add = StreamList.fold_left (+.) 0. in 96 | create add ~event 97 | 98 | (** Create a drum instrument. *) 99 | (* TODO: extend to polyphonic *) 100 | let create_drum ~event note = 101 | let stream = ref blank in 102 | let on_die () = stream := blank in 103 | let handler = function 104 | | `Note_on (n,v) -> 105 | let freq = Note.frequency (float n) in 106 | stream := note ~on_die freq v 107 | | `Note_off _ -> () 108 | | _ -> () 109 | in 110 | Event.register event handler; 111 | let* dt = dt in 112 | return (!stream dt) 113 | 114 | (* 115 | let emitter ?(loop=true) f l = 116 | let l0 = l in 117 | let l = ref l in 118 | let toff = ref 0. in 119 | let now = now () in 120 | let rec aux time = 121 | match !l with 122 | | (t,e) :: tl when t +. !toff <= time -> 123 | f e; 124 | l := tl; 125 | aux time 126 | | [] -> 127 | if loop then 128 | ( 129 | toff := time; 130 | l := l0; 131 | return () 132 | ) 133 | else 134 | return () 135 | | _ -> return () 136 | in 137 | now >>= aux 138 | *) 139 | 140 | (** Play a stream of lists events. *) 141 | let play ?portamento (note:_ Note.t) midi = 142 | let event = Event.create () in 143 | let s = create ?portamento ~event note in 144 | midi >>= Event.emitter event >> s 145 | 146 | let play_stereo ?portamento (note:_ Note.t) midi = 147 | let event = Event.create () in 148 | let s = create_stereo ?portamento ~event note in 149 | midi >>= Event.emitter event >> s 150 | 151 | let play_drum note midi = 152 | let event = Event.create () in 153 | let s = create_drum ~event note in 154 | midi >>= Event.emitter event >> s 155 | 156 | let play_drums ?kick ?snare ?closed_hat midi = 157 | let streams = ref [] in 158 | let create d note = 159 | let dnote ~on_die _ vol = B.cmul vol (d ~on_die) in 160 | let note = Option.value ~default:dnote note in 161 | let event = Event.create () in 162 | let s = create_drum ~event note in 163 | streams := s :: !streams; 164 | event 165 | in 166 | let kick = create (fun ~on_die -> Note.Drum.kick ~on_die ()) kick in 167 | let snare = create (fun ~on_die -> Note.Drum.snare ~on_die ()) snare in 168 | let closed_hat = create (fun ~on_die -> Note.Drum.closed_hat ~on_die ()) closed_hat in 169 | let emit = function 170 | | `Kick v -> Event.emit kick (`Note_on (0,v)) 171 | | `Snare v -> Event.emit snare (`Note_on (0,v)) 172 | | `Closed_hat v -> Event.emit closed_hat (`Note_on (0,v)) 173 | | `Nop -> () 174 | in 175 | midi >>= (fun l -> return (List.iter emit l)) >> B.mix !streams 176 | 177 | (** Generate a recurrent kick at given tempo. *) 178 | let kick tempo = 179 | let event = Event.create () in 180 | let note ~on_die _ _ = Note.Drum.kick ~on_die () in 181 | let instr = create_drum ~event note in 182 | let midi = Pattern.stream ~loop:true tempo [0.,1.,`Nop;0.,0.25,`Note(69,1.)] in 183 | let* l = midi in 184 | List.iter (Event.emit event) l; 185 | instr 186 | -------------------------------------------------------------------------------- /src/formal.ml: -------------------------------------------------------------------------------- 1 | (** Formal streams. *) 2 | 3 | (** Types. *) 4 | module T = struct 5 | (** A type. *) 6 | type _ t = 7 | | Float : float t 8 | | Pair : 'a t * 'b t -> ('a * 'b) t 9 | | Unit : unit t 10 | 11 | type ex_t = Ex : 'a t -> ex_t 12 | 13 | (** Proofs of type equlaity. *) 14 | type (_, _) eq = Refl : ('a, 'a) eq 15 | 16 | (** Decide whether two types are equal. *) 17 | let rec decide : type a b . a t -> b t -> (a, b) eq option = fun x y -> 18 | match x, y with 19 | | Float, Float -> Some Refl 20 | | Float, _ | _, Float -> None 21 | | Unit, Unit -> Some Refl 22 | | Unit, _ | _, Unit -> None 23 | | Pair (a, b), Pair (a', b') -> 24 | ( 25 | match decide a a', decide b b' with 26 | | Some Refl, Some Refl -> Some Refl 27 | | _ -> None 28 | ) 29 | 30 | (** Whether two types are equal. *) 31 | let eq : type a b . a t -> b t -> bool = fun x y -> decide x y <> None 32 | end 33 | 34 | (** Expressions. *) 35 | module E = struct 36 | (** A formal expression. *) 37 | type _ t = 38 | | Var : (string * 'a T.t) -> 'a t 39 | | Fun : environment option * (string * 'a T.t) * 'b t -> ('a -> 'b) t 40 | | App : ('a -> 'b) t * 'a t -> 'b t 41 | | Float : float -> float t 42 | | Seq : unit t * 'a t -> 'a t 43 | | Add : float t * float t -> float t 44 | | Pair : 'a t * 'b t -> ('a * 'b) t 45 | | Unit : unit t 46 | | Ref : string * 'a T.t -> 'a ref t 47 | | Get : 'a ref t -> 'a t 48 | | Set : 'a ref t * 'a t -> unit t 49 | 50 | (** A typed formal expression. *) 51 | (* aka "existential wrapper" *) 52 | and tt = TE : 'a T.t * 'a t -> tt 53 | 54 | (** A typing environment. *) 55 | and environment = (string * tt) list 56 | 57 | (** A state. *) 58 | type state = (string * tt ref) list 59 | 60 | (** Compute the value of an evaluated expression. *) 61 | let rec value : type a . a t -> a = function 62 | | Float x -> x 63 | | Unit -> () 64 | | Var _ -> assert false 65 | | Fun _ -> assert false 66 | | App _ -> assert false 67 | | Seq _ -> assert false 68 | | Add _ -> assert false 69 | | Ref _ -> assert false 70 | | Get _ -> assert false 71 | | Set _ -> assert false 72 | | Pair (t, u) -> (value t, value u) 73 | 74 | let is_value : type a . a t -> bool = fun x -> 75 | try ignore (value x); true 76 | with _ -> false 77 | 78 | (** Evaluate an expression. *) 79 | let rec eval : type a . state -> environment -> a t -> a t = fun state env -> function 80 | | Var (x,a) as var -> 81 | ( 82 | match List.assoc_opt x env with 83 | | Some (TE (a',t)) -> 84 | ( 85 | match T.decide a a' with 86 | | Some Refl -> t 87 | | _ -> var 88 | ) 89 | | _ -> var 90 | ) 91 | | Fun (None, x, t) -> Fun (Some env, x, t) 92 | | Fun (Some env, x, t) -> Fun (Some env, x, t) 93 | | App (t, u) -> 94 | let t = eval state env t in 95 | let u = eval state env u in 96 | ( 97 | match t with 98 | | Fun (Some env, (x, a), t) -> eval state ((x,TE(a,u))::env) t 99 | | _ -> App (t, u) 100 | ) 101 | | Float _ as t -> t 102 | | Seq (t, u) -> 103 | let t = eval state env t in 104 | let u = eval state env u in 105 | ( 106 | match t with 107 | | Unit -> u 108 | | _ -> Seq (t, u) 109 | ) 110 | | Add (t, u) -> 111 | let t = eval state env t in 112 | let u = eval state env u in 113 | ( 114 | match t, u with 115 | | Float x1, Float x2 -> Float (x1 +. x2) 116 | (* TODO: simplifications such as adding 0. *) 117 | | _ -> Add (t, u) 118 | ) 119 | | Pair (t, u) -> Pair (eval state env t, eval state env u) 120 | | Unit -> Unit 121 | | Ref _ as t -> t 122 | | Get r -> 123 | let r = eval state env r in 124 | ( 125 | match r with 126 | | Ref (r',a) -> 127 | ( 128 | match List.assoc_opt r' state with 129 | | Some { contents = TE (a', t) } -> 130 | ( 131 | match T.decide a a' with 132 | | Some Refl -> t 133 | | None -> assert false 134 | ) 135 | | None -> Get r 136 | ) 137 | | _ -> Get r 138 | ) 139 | | Set (t, u) -> 140 | let t = eval state env t in 141 | let u = eval state env u in 142 | ( 143 | match t with 144 | | Ref (r',a) -> 145 | ( 146 | match List.assoc_opt r' state with 147 | | Some ({ contents = TE (a', _) } as r) -> 148 | ( 149 | match T.decide a a' with 150 | | Some Refl -> r := TE (a, u); Unit 151 | | None -> assert false 152 | ) 153 | | None -> Set (t, u) 154 | ) 155 | | _ -> Set (t, u) 156 | ) 157 | end 158 | 159 | module Stream = struct 160 | open E 161 | 162 | (** A stream basically is an expression encoding a function which takes dt and 163 | returns a float. We also provide the list of defined references along with 164 | their type. *) 165 | type 'a t = (float -> 'a) E.t * (string * T.ex_t) list 166 | 167 | let expr : 'a t -> (float -> 'a) E.t = fst 168 | 169 | let refs : 'a t -> (string * T.ex_t) list = snd 170 | 171 | let dt = "dt", T.Float 172 | 173 | (** Current value of a stream. *) 174 | let value : 'a t -> 'a E.t = fun x -> App (expr x, Var dt) 175 | 176 | (** Return an expression as a constant stream. *) 177 | let return ?(refs=[]) (x : 'a E.t) : 'a t = Fun (None, dt, x), refs 178 | 179 | (** Constant float stream. *) 180 | let float x : float t = return (Float x) 181 | 182 | let bind (f : 'a E.t -> 'b t) (x : 'a t) : 'b t = 183 | let y = f (value x) in 184 | Fun (None, dt, value y), (refs x)@(refs y) 185 | 186 | let prod (x : 'a t) (y : 'b t) : ('a * 'b) t = 187 | return ~refs:((refs x)@(refs y)) (E.Pair (value x, value y)) 188 | 189 | module Operations = struct 190 | (** Return. *) 191 | let return = return 192 | 193 | (** Bind. *) 194 | let ( >>= ) x f = bind f x 195 | 196 | (** Bind with unit result. *) 197 | let ( >> ) x (f : unit t) = x >>= (fun _ -> f) 198 | 199 | (* (\** Functoriality. *\) *) 200 | (* let ( <$> ) = funct *) 201 | 202 | (* (\** Applicativity. *\) *) 203 | (* let ( <*> ) = apply *) 204 | 205 | (** Bind. *) 206 | let ( let* ) x f = bind f x 207 | 208 | (** Strength. *) 209 | let ( and* ) = prod 210 | end 211 | 212 | include Operations 213 | 214 | let dt : float t = Fun (None, dt, Var dt), [] 215 | end 216 | -------------------------------------------------------------------------------- /experiments/compiler/stream.ml: -------------------------------------------------------------------------------- 1 | (** Experimenting streams with state which we should both be able to execute and 2 | compile. Conclusion: this is very non-OCamlish since we have to replace every 3 | instruction by a "meta" (sequential composition, conditional branching, 4 | etc.). Implementing a proper dedicated compiler should be better. *) 5 | 6 | open Extlib 7 | 8 | module type Backend = sig 9 | type 'a t 10 | 11 | type 'a ref 12 | 13 | val float : float -> float t 14 | 15 | val seq : (unit -> unit t) -> 'a t -> 'a t 16 | 17 | val add : float t -> float t -> float t 18 | 19 | val mul : float t -> float t -> float t 20 | 21 | module Ref : sig 22 | val float : float t -> float ref t 23 | 24 | val get : 'a ref t -> 'a t 25 | 26 | val set : 'a ref t -> 'a t -> unit t 27 | end 28 | end 29 | 30 | module BackendOCaml : Backend = struct 31 | type 'a t = 'a 32 | 33 | type nonrec 'a ref = 'a ref 34 | 35 | let float x = x 36 | 37 | let seq c x = c (); x 38 | 39 | let add x y = x +. y 40 | 41 | let mul x y = x *. y 42 | 43 | module Ref = struct 44 | let float (x : float t) : float ref = ref x 45 | 46 | let get x = !x 47 | 48 | let set x v = x := v 49 | end 50 | end 51 | 52 | module BackendFormal : Backend = struct 53 | type 'a ref = int 54 | 55 | type 'a t = 56 | | Unit : unit t 57 | | Float : float -> float t 58 | | Seq : unit t * 'a t -> 'a t 59 | | Ref : 'a ref -> 'a ref t 60 | | Get : 'a ref t -> 'a t 61 | | Set : 'a ref t * 'a t -> unit t 62 | | Add : 'a t * 'a t -> 'a t 63 | | Mul : 'a t * 'a t -> 'a t 64 | 65 | let float x = Float x 66 | 67 | let seq c x = Seq (c (), x) 68 | 69 | let add x y = Add (x, y) 70 | 71 | let mul x y = Mul (x, y) 72 | 73 | module Ref = struct 74 | let floats = ref [||] 75 | 76 | let float = 77 | let n = Array.length !floats in 78 | fun x -> 79 | floats := Array.append !floats [|x|]; 80 | Ref n 81 | 82 | let get x = Get x 83 | 84 | let set x v = Set (x, v) 85 | end 86 | end 87 | 88 | module Make(Backend : Backend) = struct 89 | open Backend 90 | 91 | let ( +. ) = add 92 | 93 | let ( *. ) = mul 94 | 95 | let ref = Ref.float 96 | 97 | let ( ! ) = Ref.get 98 | 99 | let ( := ) = Ref.set 100 | 101 | let ( >> ) = seq 102 | 103 | (** Type for time differences. *) 104 | type dt = float 105 | 106 | (** The stream monad. *) 107 | type 'a t = dt -> 'a 108 | 109 | (** Return operation of the stream monad. *) 110 | let return : 'a -> 'a t = fun x dt -> x 111 | 112 | (** Bind operation of the stream monad. *) 113 | let bind : ('a -> 'b t) -> 'a t -> 'b t = 114 | fun f x dt -> f (x dt) dt 115 | 116 | let ( !* ) = return 117 | 118 | let ( let* ) x f = bind f x 119 | 120 | (** Functoriality of the stream monad. *) 121 | let funct : ('a -> 'b) -> 'a t -> 'b t = 122 | fun f x -> 123 | let* x = x in 124 | !* (f x) 125 | 126 | (** Functoriality in two arguments of the stream monad. *) 127 | let funct2 : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t = 128 | fun f x y -> 129 | let* x = x in 130 | let* y = y in 131 | !* (f x y) 132 | 133 | (** Current infinitesimal variation of a stream. *) 134 | let dt : float t = 135 | fun dt -> dt 136 | 137 | (** Current value of a stream (this function might be removed in the future). *) 138 | let get : 'a t -> 'a = 139 | fun f -> f 0. 140 | 141 | (** {2 Pure operations} *) 142 | 143 | (** Forget the result of the stream (this is [ignore] for streams). *) 144 | let drop _ = !* () 145 | 146 | (** Map a function on every sample of a stream. *) 147 | let map f x = !* (f x) 148 | 149 | (** Iterate a function on every sample of a stream. *) 150 | let iter f = map (fun x -> f x; x) 151 | 152 | (** Create a stream from a function indicating its value at each call. *) 153 | let seq f = 154 | let* _ = dt in 155 | !* (f ()) 156 | 157 | (** Value of the stream at previous instant. *) 158 | let prev (x0:'a) = 159 | let prev = ref x0 in 160 | fun x -> 161 | let ans = !prev in 162 | (fun () -> prev := x) >> 163 | ans 164 | 165 | (** {2 Arithmetic} *) 166 | 167 | (** Create a constant stream. *) 168 | let cst x = return x 169 | 170 | (** The constantly zero stream. *) 171 | let blank = cst 0. 172 | 173 | let add = funct Float.add 174 | 175 | let sub = funct Float.sub 176 | 177 | let mul = funct Float.mul 178 | 179 | let div = funct Float.div 180 | 181 | (** Multiply a stream by a boolean (interpreted as 0 / 1 for false / true). *) 182 | let bmul b x = 183 | let* b = b in 184 | let* x = x in 185 | if b then return x else return 0. 186 | 187 | (** Switched multiplication by a constant: if the first is 0, the second 188 | stream is not evaluated. *) 189 | let smul x s = 190 | let* x = x in 191 | (* TODO: this should actually be a "meta" if *) 192 | if x = float 0. then return (float 0.) 193 | else 194 | let* y = s in 195 | return (x *. y) 196 | 197 | (** Number of samples in a given amount of time. *) 198 | let samples t = 199 | let* dt = dt in 200 | !* (round (t /. dt)) 201 | 202 | (** {2 Time} *) 203 | 204 | (** Integrate a stream. *) 205 | let integrate ?(kind=`Euler) ?(init=float 0.) ?(periodic=false) () = 206 | let y = ref init in 207 | let return ans = 208 | (* if periodic && !y >= 1. then (y := !y -. 1.; on_reset ()); *) 209 | return ans 210 | in 211 | match kind with 212 | | `Euler -> 213 | fun x -> 214 | let* dt = dt in 215 | let ans = !y in 216 | (* y := !y +. x *. dt; *) 217 | (* return ans *) 218 | failwith "TODO.........." 219 | (* | `Trapezoidal -> *) 220 | (* let u = ref 0. in *) 221 | (* fun x -> *) 222 | (* let* dt = dt in *) 223 | (* let ans = !y in *) 224 | (* y := !u +. x /. 2.; *) 225 | (* u := !u +. x; *) 226 | (* return ans *) 227 | 228 | end 229 | 230 | (* 231 | type 'a typ = 232 | | Float : float typ 233 | (* | Bool : bool kind *) 234 | | Pair : ('a typ * 'b typ) -> ('a * 'b) typ 235 | 236 | (* existential type *) 237 | type types = 238 | | Type : 'a typ -> types 239 | 240 | type 'a reference = 'a typ * int 241 | 242 | type 'a value = 243 | | Unit : unit value 244 | | Float : float -> float value 245 | | Ref : 'a reference -> 'a reference value 246 | | Get : 'a reference -> 'a value 247 | | Set : 'a reference * 'a value -> unit value 248 | 249 | (** {2 The outer monad (which is roughly the indexed state monad) } *) 250 | 251 | (** State of an operator. *) 252 | type state = 253 | { 254 | cell : types array; (** all allocated cells *) 255 | } 256 | 257 | type dt = float 258 | 259 | (** The monad. *) 260 | type 'a t = state -> state * (dt -> 'a) 261 | 262 | let return : 'a -> 'a t = fun x st -> st, fun dt -> dt 263 | 264 | let bind : ('a -> 'b t) -> 'a t -> 'b t = fun f x -> 265 | fun st -> 266 | let st, x = x st in 267 | let st, _ = f (x 0.) st in 268 | st, 269 | fun dt -> 270 | let _, y = f (x dt) st in 271 | y dt 272 | 273 | let ( let* ) x f = bind f x 274 | 275 | (* let alloc : 'a typ -> 'a value -> 'a reference t = *) 276 | (* fun t i o -> *) 277 | (* let cell = Array.append o.cell [|Type t|] in *) 278 | (* let n = Array.length cell - 1 in *) 279 | (* { o with cell }, Ref (t, n) *) 280 | 281 | (* let alloc_float = alloc Float *) 282 | 283 | (* let get : 'a reference -> 'a t = *) 284 | (* fun r -> return (Get r) *) 285 | 286 | (* let set : 'a reference -> 'a value -> unit t = *) 287 | (* fun r x -> return (Set (r, x)) *) 288 | 289 | (* (\** {2 The stream monad} *\) *) 290 | 291 | 292 | (* (\** Pure streams. *\) *) 293 | (* type 'a stream = dt -> 'a *) 294 | *) 295 | -------------------------------------------------------------------------------- /examples/obx.ml: -------------------------------------------------------------------------------- 1 | (** Trying to recreate Oberheim OB-Xa. *) 2 | 3 | open Msynth 4 | open Extlib 5 | open Stream 6 | 7 | let synth 8 | ?(master_volume=cst 1.) 9 | ?(detune=cst 0.1) (* detuning in semitone *) 10 | ?(unison=cst 1) (* number of unison channels *) 11 | ?(stereo_amount=cst 0.5) 12 | ?(stereo_mode=cst `Spread) 13 | ?(lfo_form=cst `Sine) 14 | ?(lfo_rate=cst 2.) 15 | ?(lfo_pwm1=cst 0.5) 16 | ?(lfo_pwm2=cst 0.5) 17 | ?(osc1_shape=cst `Saw) 18 | ?(osc2_shape=cst `Square) 19 | ?(osc2_volume=cst 1.) 20 | ?(osc2_detune=cst 1.01) 21 | ?(sub_volume=cst 0.5) 22 | ?(noise_volume=cst 0.5) 23 | ?(a=cst 0.01) ?(d=cst 0.05) ?(s=cst 0.8) ?(r=cst 0.1) 24 | ?(lp_q=cst 1.) 25 | ?(lp_f=cst 5000.) 26 | ?(lp_a=cst 0.1) 27 | ?(lp_d=cst 10.) 28 | ?(lp_s=cst 0.1) 29 | ?(lp_r=cst 0.1) 30 | ?(lp_4pole=cst true) 31 | ?(portamento=cst 0.) 32 | ?(pitch_bend=cst 0.) 33 | ?(reverb=cst 0.5) 34 | ?(reverb_size=cst 1.) 35 | ?(delay_feedback=cst 0.) 36 | ?(delay_length=cst 0.5) 37 | e 38 | = 39 | let lfo = bind2 (osc ()) lfo_form lfo_rate in 40 | let lfo_, lfo = dup () lfo in 41 | let note : _ Note.t = 42 | fun ~event ~on_die () -> 43 | let tuning () = 44 | let d = get detune /. 12. in 45 | 1. +. Random.float ~min:(-.d) d 46 | in 47 | let unison = get unison in 48 | let stereo_amount = get stereo_amount in 49 | let stereo_mode = if stereo_amount = 0. then `Mono else get stereo_mode in 50 | let stereo_coeff () = let d = 0.1 *. stereo_amount in 1. +. Random.float ~min:(-.d) d in 51 | let stereo_coeff_l = stereo_coeff () in 52 | let stereo_coeff_r = stereo_coeff () in 53 | let osc () = 54 | let osc1 = osc () in 55 | let osc2 = osc () in 56 | fun freq -> 57 | let* s1 = osc1_shape in 58 | let* s2 = osc2_shape in 59 | let* lfo = lfo in 60 | let* lfo_pwm1 = lfo_pwm1 in 61 | let* lfo_pwm2 = lfo_pwm2 in 62 | let* detune2 = osc2_detune in 63 | let* x1 = osc1 ~width:((1. +. lfo *. lfo_pwm1) /. 2.) s1 freq in 64 | let o2 = osc2 ~width:((1. +. lfo *. lfo_pwm2) /. 2.) s2 (freq *. detune2) in 65 | let* v2 = osc2_volume in 66 | let* x2 = scmul v2 o2 in 67 | return (x1 +. x2) 68 | in 69 | let osc = 70 | List.init 71 | (if stereo_mode = `Spread then 2 * unison else unison) 72 | (fun i -> 73 | osc (), 74 | tuning (), 75 | match stereo_mode with 76 | | `Mono -> 0. 77 | | `Spread -> if i < unison then -.stereo_amount else stereo_amount 78 | | `Pan -> Random.float ~min:(-.stereo_amount) stereo_amount 79 | ) 80 | in 81 | let lp_adsr = adsr ~event () ~a:(get lp_a) ~d:(get lp_d) ~s:(get lp_s) ~r:(get lp_r) in 82 | let adsr = adsr ~event ~on_die () ~a:(get a) ~d:(get d) ~s:(get s) ~r:(get r) in 83 | let lpl = lp_4pole >>= switch (Filter.ladder () `Low_pass) (Filter.biquad () `Low_pass) in 84 | let lpr = lp_4pole >>= switch (Filter.ladder () `Low_pass) (Filter.biquad () `Low_pass) in 85 | (* Noise *) 86 | let noise = Stream.osc () `Noise 0. >>= smulc noise_volume >>= stereo in 87 | (* Sub-oscillator *) 88 | let sub = 89 | let osc = Stream.osc () `Saw in 90 | fun freq -> osc (freq /. 2.) >>= smulc sub_volume >>= stereo 91 | in 92 | fun freq vol -> 93 | (* Pitch bend *) 94 | let* pitch_bend = pitch_bend in 95 | let freq = freq *. (2. ** (pitch_bend /. 12.)) in 96 | (* Low pass filter *) 97 | let* lp_q = lp_q in 98 | let* lp_f = lp_f in 99 | let* lp_adsr = lp_adsr () in 100 | let lpl = lpl lp_q (lp_f *. lp_adsr *. stereo_coeff_l) in 101 | let lpr = lpr lp_q (lp_f *. lp_adsr *. stereo_coeff_r) in 102 | let l = List.map (fun (osc,d,p) -> osc (freq *. d) >>= Stereo.pan p) osc in 103 | let l = noise::(sub freq)::l in 104 | let* a = adsr () in 105 | Stereo.mix l >>= Stereo.map lpl lpr >>= Stereo.amp (a *. vol) 106 | in 107 | let delay = Stereo.delay () in 108 | let reverb_wet = reverb in 109 | let reverb = Stereo.freeverb () in 110 | let s = Instrument.play_stereo ~portamento note e in 111 | let* delay_length = delay_length in 112 | let* delay_feedback = delay_feedback in 113 | let* reverb_wet = reverb_wet in 114 | let* unison = unison in 115 | let* vol = master_volume in 116 | let* room_size = reverb_size in 117 | lfo_ 118 | >> s 119 | >>= Stereo.amp (0.1 *. vol /. float unison) 120 | >>= delay ~feedback:delay_feedback delay_length 121 | >>= reverb ~room_size ~wet:reverb_wet 122 | 123 | let () = 124 | let midi = MIDI.create ~print:true () in 125 | let shift = MIDI.toggle midi 36 in 126 | let midi = 127 | let t = shift in 128 | MIDI.map midi 129 | (fun c e -> 130 | match e with 131 | | `Controller (n, v) -> 132 | let n = if get t then n + 8 else n in 133 | c, `Controller (n, v) 134 | | e -> c, e 135 | ) 136 | in 137 | let knob n ?mode ?min ?max default = MIDI.controller midi n ?mode ?min ?max default in 138 | let detune = knob 0 ~max:0.25 0.01 in 139 | let stereo_amount = knob 4 0.5 >>= print "sa" in 140 | let osc2_volume = knob 1 1. in 141 | let lfo_rate = knob 5 ~max:10. 2. >>= print "lfo rate" in 142 | let lfo_pwm1 = knob 2 0.5 in 143 | let lfo_pwm2 = knob 6 0.5 in 144 | let lp_f = knob 3 ~mode:`Logarithmic ~min:10. ~max:20000. 10000. >>= print "lp f" in 145 | let lp_q = knob 7 ~min:0.1 ~max:5. 1. >>= print "lp q" in 146 | let a = knob 8 0.01 >>= print "a" in 147 | let d = knob 9 0.01 >>= print "d" in 148 | let s = knob 10 0.8 >>= print "s" in 149 | let r = knob 11 ~max:4. 0.1 >>= print "r" in 150 | let sustain = s in 151 | let lp_a = knob 12 0.01 >>= print "lpa" in 152 | let lp_d = knob 13 0.01 >>= print "lpd" in 153 | let lp_s = knob 14 0.8 >>= print "lps" in 154 | let lp_r = knob 15 ~max:4. 0.1 >>= print "lpr" in 155 | let master_volume = knob 16 0.5 >>= print "volume" in 156 | let reverb = knob 17 0.2 >>= print "reverb" in 157 | let reverb_size = knob 18 0.8 >>= print "room size" in 158 | let delay_feedback = knob 20 0. >>= print "delay feedback" in 159 | let delay_length = knob 21 0.5 ~max:2. >>= print "delay length" in 160 | let pitch_bend = MIDI.pitch_bend midi () in 161 | let s = synth ~master_volume ~detune ~stereo_amount ~osc2_volume ~lfo_rate ~lfo_pwm1 ~lfo_pwm2 ~lp_f ~lp_q ~a ~d ~s ~r ~lp_a ~lp_d ~lp_s ~lp_r ~pitch_bend ~reverb ~reverb_size ~delay_feedback ~delay_length (MIDI.events ~channel:0 midi) in 162 | let drums = 163 | let midi = 164 | MIDI.events ~channel:9 midi >>= 165 | Stream.map 166 | (List.filter_map 167 | (function 168 | | `Note_on (64,x) -> Some (`Kick x) 169 | | `Note_on (65,x) -> Some (`Snare x) 170 | | `Note_on (66,x) -> Some (`Closed_hat x) 171 | | _ -> None 172 | ) 173 | ) 174 | in 175 | Instrument.play_drums midi >>= stereo 176 | in 177 | let s = Stereo.add s drums in 178 | (* Board. *) 179 | let board = 180 | Board.create 181 | [ 182 | [ 183 | "detune",`Knob(0.,0.25,`Linear,detune); 184 | "osc2 vol",`Knob(0.,1.,`Linear,osc2_volume); 185 | "lfp pwm1",`Knob(0.,1.,`Linear,lfo_pwm1); 186 | "lp freq",`Knob(10.,20000.,`Logarithmic,lp_f); 187 | ]; 188 | [ 189 | "stereo",`Knob(0.,1.,`Linear,stereo_amount); 190 | "lfo rate",`Knob(0.,10.,`Linear,lfo_rate); 191 | "lfp pwm2",`Knob(0.,1.,`Linear,lfo_pwm2); 192 | "lp q",`Knob(0.1,5.,`Logarithmic,lp_q); 193 | ]; 194 | [ 195 | "a",`Knob(0.,1.,`Linear,a); 196 | "d",`Knob(0.,1.,`Linear,d); 197 | "s",`Knob(0.,1.,`Linear,sustain); 198 | "r",`Knob(0.,4.,`Linear,r); 199 | "shift",`Switch shift; 200 | ]; 201 | [ 202 | "lp a",`Knob(0.,1.,`Linear,lp_a); 203 | "lp d",`Knob(0.,1.,`Linear,lp_d); 204 | "lp s",`Knob(0.,1.,`Linear,lp_s); 205 | "lp r",`Knob(0.,4.,`Linear,lp_r); 206 | ]; 207 | [ 208 | "vol",`Knob(0.,1.,`Linear,master_volume); 209 | "reverb",`Knob(0.,1.,`Linear,reverb); 210 | "reverb size",`Knob(0.,1.,`Linear,reverb_size); 211 | ]; 212 | [ 213 | "delay",`Knob(0.,1.,`Linear,delay_feedback); 214 | "delay length",`Knob(0.,2.,`Linear,delay_length); 215 | ] 216 | ] 217 | in 218 | let s = board >> s in 219 | (* LED animation *) 220 | let _ = 221 | Thread.create 222 | (fun () -> 223 | for n = 0 to 16 do 224 | Unix.sleepf 0.04; 225 | MIDI.send midi 0 (`Note_on (n, 1.)); 226 | done; 227 | for n = 0 to 16 do 228 | Unix.sleepf 0.04; 229 | MIDI.send midi 0 (`Note_on (n, 0.)); 230 | done) () 231 | in 232 | Output.play s 233 | -------------------------------------------------------------------------------- /doc/github.css: -------------------------------------------------------------------------------- 1 | /* From https://github.com/otsaloma/markdown-css */ 2 | 3 | @font-face { 4 | font-family: octicons-link; 5 | src: url(data:font/woff;charset=utf-8;base64,d09GRgABAAAAAAZwABAAAAAACFQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABEU0lHAAAGaAAAAAgAAAAIAAAAAUdTVUIAAAZcAAAACgAAAAoAAQAAT1MvMgAAAyQAAABJAAAAYFYEU3RjbWFwAAADcAAAAEUAAACAAJThvmN2dCAAAATkAAAABAAAAAQAAAAAZnBnbQAAA7gAAACyAAABCUM+8IhnYXNwAAAGTAAAABAAAAAQABoAI2dseWYAAAFsAAABPAAAAZwcEq9taGVhZAAAAsgAAAA0AAAANgh4a91oaGVhAAADCAAAABoAAAAkCA8DRGhtdHgAAAL8AAAADAAAAAwGAACfbG9jYQAAAsAAAAAIAAAACABiATBtYXhwAAACqAAAABgAAAAgAA8ASm5hbWUAAAToAAABQgAAAlXu73sOcG9zdAAABiwAAAAeAAAAME3QpOBwcmVwAAAEbAAAAHYAAAB/aFGpk3jaTY6xa8JAGMW/O62BDi0tJLYQincXEypYIiGJjSgHniQ6umTsUEyLm5BV6NDBP8Tpts6F0v+k/0an2i+itHDw3v2+9+DBKTzsJNnWJNTgHEy4BgG3EMI9DCEDOGEXzDADU5hBKMIgNPZqoD3SilVaXZCER3/I7AtxEJLtzzuZfI+VVkprxTlXShWKb3TBecG11rwoNlmmn1P2WYcJczl32etSpKnziC7lQyWe1smVPy/Lt7Kc+0vWY/gAgIIEqAN9we0pwKXreiMasxvabDQMM4riO+qxM2ogwDGOZTXxwxDiycQIcoYFBLj5K3EIaSctAq2kTYiw+ymhce7vwM9jSqO8JyVd5RH9gyTt2+J/yUmYlIR0s04n6+7Vm1ozezUeLEaUjhaDSuXHwVRgvLJn1tQ7xiuVv/ocTRF42mNgZGBgYGbwZOBiAAFGJBIMAAizAFoAAABiAGIAznjaY2BkYGAA4in8zwXi+W2+MjCzMIDApSwvXzC97Z4Ig8N/BxYGZgcgl52BCSQKAA3jCV8CAABfAAAAAAQAAEB42mNgZGBg4f3vACQZQABIMjKgAmYAKEgBXgAAeNpjYGY6wTiBgZWBg2kmUxoDA4MPhGZMYzBi1AHygVLYQUCaawqDA4PChxhmh/8ODDEsvAwHgMKMIDnGL0x7gJQCAwMAJd4MFwAAAHjaY2BgYGaA4DAGRgYQkAHyGMF8NgYrIM3JIAGVYYDT+AEjAwuDFpBmA9KMDEwMCh9i/v8H8sH0/4dQc1iAmAkALaUKLgAAAHjaTY9LDsIgEIbtgqHUPpDi3gPoBVyRTmTddOmqTXThEXqrob2gQ1FjwpDvfwCBdmdXC5AVKFu3e5MfNFJ29KTQT48Ob9/lqYwOGZxeUelN2U2R6+cArgtCJpauW7UQBqnFkUsjAY/kOU1cP+DAgvxwn1chZDwUbd6CFimGXwzwF6tPbFIcjEl+vvmM/byA48e6tWrKArm4ZJlCbdsrxksL1AwWn/yBSJKpYbq8AXaaTb8AAHja28jAwOC00ZrBeQNDQOWO//sdBBgYGRiYWYAEELEwMTE4uzo5Zzo5b2BxdnFOcALxNjA6b2ByTswC8jYwg0VlNuoCTWAMqNzMzsoK1rEhNqByEyerg5PMJlYuVueETKcd/89uBpnpvIEVomeHLoMsAAe1Id4AAAAAAAB42oWQT07CQBTGv0JBhagk7HQzKxca2sJCE1hDt4QF+9JOS0nbaaYDCQfwCJ7Au3AHj+LO13FMmm6cl7785vven0kBjHCBhfpYuNa5Ph1c0e2Xu3jEvWG7UdPDLZ4N92nOm+EBXuAbHmIMSRMs+4aUEd4Nd3CHD8NdvOLTsA2GL8M9PODbcL+hD7C1xoaHeLJSEao0FEW14ckxC+TU8TxvsY6X0eLPmRhry2WVioLpkrbp84LLQPGI7c6sOiUzpWIWS5GzlSgUzzLBSikOPFTOXqly7rqx0Z1Q5BAIoZBSFihQYQOOBEdkCOgXTOHA07HAGjGWiIjaPZNW13/+lm6S9FT7rLHFJ6fQbkATOG1j2OFMucKJJsxIVfQORl+9Jyda6Sl1dUYhSCm1dyClfoeDve4qMYdLEbfqHf3O/AdDumsjAAB42mNgYoAAZQYjBmyAGYQZmdhL8zLdDEydARfoAqIAAAABAAMABwAKABMAB///AA8AAQAAAAAAAAAAAAAAAAABAAAAAA==) format('woff'); 6 | } 7 | 8 | body { 9 | -webkit-text-size-adjust: 100%; 10 | text-size-adjust: 100%; 11 | text-align: justify; 12 | color: #333; 13 | font-family: "Helvetica Neue", Helvetica, "Segoe UI", Arial, freesans, sans-serif, "Apple Color Emoji", "Segoe UI Emoji", "Segoe UI Symbol"; 14 | font-size: 16px; 15 | line-height: 1.6; 16 | word-wrap: break-word; 17 | width: 728px; 18 | max-width: 99%; 19 | box-sizing: border-box; 20 | padding: 30px 30px 8rem 30px; 21 | margin-left: auto; 22 | margin-right: auto; 23 | } 24 | 25 | body a { 26 | background-color: transparent; 27 | } 28 | 29 | body a:active, 30 | body a:hover { 31 | outline: 0; 32 | } 33 | 34 | body strong { 35 | font-weight: bold; 36 | } 37 | 38 | body h1 { 39 | font-size: 2em; 40 | margin: 0.67em 0; 41 | } 42 | 43 | body img { 44 | border: 0; 45 | } 46 | 47 | body hr { 48 | box-sizing: content-box; 49 | height: 0; 50 | } 51 | 52 | body pre { 53 | overflow: auto; 54 | } 55 | 56 | body code, 57 | body kbd, 58 | body pre { 59 | font-family: monospace, monospace; 60 | font-size: 1em; 61 | } 62 | 63 | body input { 64 | color: inherit; 65 | font: inherit; 66 | margin: 0; 67 | } 68 | 69 | body html input[disabled] { 70 | cursor: default; 71 | } 72 | 73 | body input { 74 | line-height: normal; 75 | } 76 | 77 | body input[type="checkbox"] { 78 | box-sizing: border-box; 79 | padding: 0; 80 | } 81 | 82 | body table { 83 | border-collapse: collapse; 84 | border-spacing: 0; 85 | } 86 | 87 | body td, 88 | body th { 89 | padding: 0; 90 | } 91 | 92 | body * { 93 | box-sizing: border-box; 94 | } 95 | 96 | body input { 97 | font: 13px / 1.4 Helvetica, arial, nimbussansl, liberationsans, freesans, clean, sans-serif, "Apple Color Emoji", "Segoe UI Emoji", "Segoe UI Symbol"; 98 | } 99 | 100 | body a { 101 | color: #4078c0; 102 | text-decoration: none; 103 | } 104 | 105 | body a:hover, 106 | body a:active { 107 | text-decoration: underline; 108 | } 109 | 110 | body hr { 111 | height: 0; 112 | margin: 15px 0; 113 | overflow: hidden; 114 | background: transparent; 115 | border: 0; 116 | border-bottom: 1px solid #ddd; 117 | } 118 | 119 | body hr:before { 120 | display: table; 121 | content: ""; 122 | } 123 | 124 | body hr:after { 125 | display: table; 126 | clear: both; 127 | content: ""; 128 | } 129 | 130 | body h1, 131 | body h2, 132 | body h3, 133 | body h4, 134 | body h5, 135 | body h6 { 136 | margin-top: 15px; 137 | margin-bottom: 15px; 138 | line-height: 1.1; 139 | } 140 | 141 | body h1 { 142 | font-size: 30px; 143 | } 144 | 145 | body h2 { 146 | font-size: 21px; 147 | } 148 | 149 | body h3 { 150 | font-size: 16px; 151 | } 152 | 153 | body h4 { 154 | font-size: 14px; 155 | } 156 | 157 | body h5 { 158 | font-size: 12px; 159 | } 160 | 161 | body h6 { 162 | font-size: 11px; 163 | } 164 | 165 | body blockquote { 166 | margin: 0; 167 | } 168 | 169 | body ul, 170 | body ol { 171 | padding: 0; 172 | margin-top: 0; 173 | margin-bottom: 0; 174 | } 175 | 176 | body ol ol, 177 | body ul ol { 178 | list-style-type: lower-roman; 179 | } 180 | 181 | body ul ul ol, 182 | body ul ol ol, 183 | body ol ul ol, 184 | body ol ol ol { 185 | list-style-type: lower-alpha; 186 | } 187 | 188 | body dd { 189 | margin-left: 0; 190 | } 191 | 192 | body code { 193 | font-family: Consolas, "Liberation Mono", Menlo, Courier, monospace; 194 | font-size: 12px; 195 | } 196 | 197 | body pre { 198 | margin-top: 0; 199 | margin-bottom: 0; 200 | font: 12px Consolas, "Liberation Mono", Menlo, Courier, monospace; 201 | } 202 | 203 | body .select::-ms-expand { 204 | opacity: 0; 205 | } 206 | 207 | body .octicon { 208 | font: normal normal normal 16px/1 octicons-link; 209 | display: inline-block; 210 | text-decoration: none; 211 | text-rendering: auto; 212 | -webkit-font-smoothing: antialiased; 213 | -moz-osx-font-smoothing: grayscale; 214 | -webkit-user-select: none; 215 | -moz-user-select: none; 216 | -ms-user-select: none; 217 | user-select: none; 218 | } 219 | 220 | body .octicon-link:before { 221 | content: '\f05c'; 222 | } 223 | 224 | body:before { 225 | display: table; 226 | content: ""; 227 | } 228 | 229 | body:after { 230 | display: table; 231 | clear: both; 232 | content: ""; 233 | } 234 | 235 | body>*:first-child { 236 | margin-top: 0 !important; 237 | } 238 | 239 | body>*:last-child { 240 | margin-bottom: 0 !important; 241 | } 242 | 243 | body a:not([href]) { 244 | color: inherit; 245 | text-decoration: none; 246 | } 247 | 248 | body .anchor { 249 | display: inline-block; 250 | padding-right: 2px; 251 | margin-left: -18px; 252 | } 253 | 254 | body .anchor:focus { 255 | outline: none; 256 | } 257 | 258 | body h1, 259 | body h2, 260 | body h3, 261 | body h4, 262 | body h5, 263 | body h6 { 264 | margin-top: 1em; 265 | margin-bottom: 16px; 266 | font-weight: bold; 267 | line-height: 1.4; 268 | } 269 | 270 | body h1 .octicon-link, 271 | body h2 .octicon-link, 272 | body h3 .octicon-link, 273 | body h4 .octicon-link, 274 | body h5 .octicon-link, 275 | body h6 .octicon-link { 276 | color: #000; 277 | vertical-align: middle; 278 | visibility: hidden; 279 | } 280 | 281 | body h1:hover .anchor, 282 | body h2:hover .anchor, 283 | body h3:hover .anchor, 284 | body h4:hover .anchor, 285 | body h5:hover .anchor, 286 | body h6:hover .anchor { 287 | text-decoration: none; 288 | } 289 | 290 | body h1:hover .anchor .octicon-link, 291 | body h2:hover .anchor .octicon-link, 292 | body h3:hover .anchor .octicon-link, 293 | body h4:hover .anchor .octicon-link, 294 | body h5:hover .anchor .octicon-link, 295 | body h6:hover .anchor .octicon-link { 296 | visibility: visible; 297 | } 298 | 299 | body h1 { 300 | padding-bottom: 0.3em; 301 | font-size: 1.75em; 302 | line-height: 1.2; 303 | } 304 | 305 | body h1 .anchor { 306 | line-height: 1; 307 | } 308 | 309 | body h2 { 310 | padding-bottom: 0.3em; 311 | font-size: 1.5em; 312 | line-height: 1.225; 313 | } 314 | 315 | body h2 .anchor { 316 | line-height: 1; 317 | } 318 | 319 | body h3 { 320 | font-size: 1.25em; 321 | line-height: 1.43; 322 | } 323 | 324 | body h3 .anchor { 325 | line-height: 1.2; 326 | } 327 | 328 | body h4 { 329 | font-size: 1em; 330 | } 331 | 332 | body h4 .anchor { 333 | line-height: 1.2; 334 | } 335 | 336 | body h5 { 337 | font-size: 1em; 338 | } 339 | 340 | body h5 .anchor { 341 | line-height: 1.1; 342 | } 343 | 344 | body h6 { 345 | font-size: 1em; 346 | color: #777; 347 | } 348 | 349 | body h6 .anchor { 350 | line-height: 1.1; 351 | } 352 | 353 | body p, 354 | body blockquote, 355 | body ul, 356 | body ol, 357 | body dl, 358 | body table, 359 | body pre { 360 | margin-top: 0; 361 | margin-bottom: 16px; 362 | } 363 | 364 | body hr { 365 | height: 4px; 366 | padding: 0; 367 | margin: 16px 0; 368 | background-color: #e7e7e7; 369 | border: 0 none; 370 | } 371 | 372 | body ul, 373 | body ol { 374 | padding-left: 2em; 375 | } 376 | 377 | body ul ul, 378 | body ul ol, 379 | body ol ol, 380 | body ol ul { 381 | margin-top: 0; 382 | margin-bottom: 0; 383 | } 384 | 385 | body li>p { 386 | margin-top: 16px; 387 | } 388 | 389 | body dl { 390 | padding: 0; 391 | } 392 | 393 | body dl dt { 394 | padding: 0; 395 | margin-top: 16px; 396 | font-size: 1em; 397 | font-style: italic; 398 | font-weight: bold; 399 | } 400 | 401 | body dl dd { 402 | padding: 0 16px; 403 | margin-bottom: 16px; 404 | } 405 | 406 | body blockquote { 407 | padding: 0 15px; 408 | color: #777; 409 | border-left: 4px solid #ddd; 410 | } 411 | 412 | body blockquote>:first-child { 413 | margin-top: 0; 414 | } 415 | 416 | body blockquote>:last-child { 417 | margin-bottom: 0; 418 | } 419 | 420 | body table { 421 | display: block; 422 | width: 100%; 423 | overflow: auto; 424 | word-break: normal; 425 | word-break: keep-all; 426 | } 427 | 428 | body table th { 429 | font-weight: bold; 430 | } 431 | 432 | body table th, 433 | body table td { 434 | padding: 6px 13px; 435 | border: 1px solid #ddd; 436 | } 437 | 438 | body table tr { 439 | background-color: #fff; 440 | border-top: 1px solid #ccc; 441 | } 442 | 443 | body table tr:nth-child(2n) { 444 | background-color: #f8f8f8; 445 | } 446 | 447 | body img { 448 | max-width: 100%; 449 | box-sizing: content-box; 450 | background-color: #fff; 451 | } 452 | 453 | body code { 454 | padding: 0; 455 | padding-top: 0; 456 | padding-bottom: 0; 457 | margin: 0; 458 | font-size: 85%; 459 | background-color: rgba(0,0,0,0.04); 460 | border-radius: 3px; 461 | } 462 | 463 | body code:before, 464 | body code:after { 465 | letter-spacing: -0.2em; 466 | content: "\00a0"; 467 | } 468 | 469 | body pre>code { 470 | padding: 0; 471 | margin: 0; 472 | font-size: 100%; 473 | word-break: normal; 474 | white-space: pre; 475 | background: transparent; 476 | border: 0; 477 | } 478 | 479 | body .highlight { 480 | margin-bottom: 16px; 481 | } 482 | 483 | body .highlight pre, 484 | body pre { 485 | padding: 16px; 486 | overflow: auto; 487 | font-size: 85%; 488 | line-height: 1.45; 489 | background-color: #f7f7f7; 490 | border-radius: 3px; 491 | } 492 | 493 | .sourceCode { 494 | background-color: #f7f7f7; 495 | } 496 | 497 | body .highlight pre { 498 | margin-bottom: 0; 499 | word-break: normal; 500 | } 501 | 502 | body pre { 503 | word-wrap: normal; 504 | } 505 | 506 | body pre code { 507 | display: inline; 508 | max-width: initial; 509 | padding: 0; 510 | margin: 0; 511 | overflow: initial; 512 | line-height: inherit; 513 | word-wrap: normal; 514 | background-color: transparent; 515 | border: 0; 516 | } 517 | 518 | body pre code:before, 519 | body pre code:after { 520 | content: normal; 521 | } 522 | 523 | body kbd { 524 | display: inline-block; 525 | padding: 3px 5px; 526 | font-size: 11px; 527 | line-height: 10px; 528 | color: #555; 529 | vertical-align: middle; 530 | background-color: #fcfcfc; 531 | border: solid 1px #ccc; 532 | border-bottom-color: #bbb; 533 | border-radius: 3px; 534 | box-shadow: inset 0 -1px 0 #bbb; 535 | } 536 | 537 | body .pl-c { 538 | color: #969896; 539 | } 540 | 541 | body .pl-c1, 542 | body .pl-s .pl-v { 543 | color: #0086b3; 544 | } 545 | 546 | body .pl-e, 547 | body .pl-en { 548 | color: #795da3; 549 | } 550 | 551 | body .pl-s .pl-s1, 552 | body .pl-smi { 553 | color: #333; 554 | } 555 | 556 | body .pl-ent { 557 | color: #63a35c; 558 | } 559 | 560 | body .pl-k { 561 | color: #a71d5d; 562 | } 563 | 564 | body .pl-pds, 565 | body .pl-s, 566 | body .pl-s .pl-pse .pl-s1, 567 | body .pl-sr, 568 | body .pl-sr .pl-cce, 569 | body .pl-sr .pl-sra, 570 | body .pl-sr .pl-sre { 571 | color: #183691; 572 | } 573 | 574 | body .pl-v { 575 | color: #ed6a43; 576 | } 577 | 578 | body .pl-id { 579 | color: #b52a1d; 580 | } 581 | 582 | body .pl-ii { 583 | background-color: #b52a1d; 584 | color: #f8f8f8; 585 | } 586 | 587 | body .pl-sr .pl-cce { 588 | color: #63a35c; 589 | font-weight: bold; 590 | } 591 | 592 | body .pl-ml { 593 | color: #693a17; 594 | } 595 | 596 | body .pl-mh, 597 | body .pl-mh .pl-en, 598 | body .pl-ms { 599 | color: #1d3e81; 600 | font-weight: bold; 601 | } 602 | 603 | body .pl-mq { 604 | color: #008080; 605 | } 606 | 607 | body .pl-mi { 608 | color: #333; 609 | font-style: italic; 610 | } 611 | 612 | body .pl-mb { 613 | color: #333; 614 | font-weight: bold; 615 | } 616 | 617 | body .pl-md { 618 | background-color: #ffecec; 619 | color: #bd2c00; 620 | } 621 | 622 | body .pl-mi1 { 623 | background-color: #eaffea; 624 | color: #55a532; 625 | } 626 | 627 | body .pl-mdr { 628 | color: #795da3; 629 | font-weight: bold; 630 | } 631 | 632 | body .pl-mo { 633 | color: #1d3e81; 634 | } 635 | 636 | body kbd { 637 | display: inline-block; 638 | padding: 3px 5px; 639 | font: 11px Consolas, "Liberation Mono", Menlo, Courier, monospace; 640 | line-height: 10px; 641 | color: #555; 642 | vertical-align: middle; 643 | background-color: #fcfcfc; 644 | border: solid 1px #ccc; 645 | border-bottom-color: #bbb; 646 | border-radius: 3px; 647 | box-shadow: inset 0 -1px 0 #bbb; 648 | } 649 | 650 | body .task-list-item { 651 | list-style-type: none; 652 | } 653 | 654 | body .task-list-item+.task-list-item { 655 | margin-top: 3px; 656 | } 657 | 658 | body .task-list-item input { 659 | margin: 0 0.35em 0.25em -1.6em; 660 | vertical-align: middle; 661 | } 662 | 663 | body :checked+.radio-label { 664 | z-index: 1; 665 | position: relative; 666 | border-color: #4078c0; 667 | } 668 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | Monadic synthesizers in OCaml 2 | ============================= 3 | 4 | This library called `msynth` is my own take at organizing the various classical 5 | functions for performing audio synthesis. The aim is to provide a clean 6 | programming environment in which one can easily try new ideas for synthesizers 7 | (performance is not a priority, although it is of course taken into 8 | account). Yes, I know that some people tend to spend more time making 9 | synthesizers than making actual music, and I am spending my time making 10 | libraries to make synthesizers to make sound. 11 | 12 | It is mainly based on the idea that audio streams can be represented as 13 | functions `float -> float`: such a function takes as argument the time _dt_ 14 | elapsed since the last sample and returns the current value for the 15 | sample. Typically, when the sampling rate is 44100, _dt_ will be 1/44100, but 16 | fancy effects might vary its value. The type 17 | 18 | ```ocaml 19 | type 'a stream = float -> 'a 20 | ``` 21 | 22 | is thus called a _stream_ of `'a`. It can be equipped with the structure of a 23 | [monad](https://en.wikipedia.org/wiki/Monad_(functional_programming)) which can 24 | be used to easily compose operations on streams, especially since the recent 25 | introduction of the dedicated [syntax for 26 | monads](https://caml.inria.fr/pub/docs/manual-ocaml/bindingops.html) in OCaml. 27 | 28 | ## Installing 29 | 30 | The easiest way to install the library is to clone the [github 31 | repository](https://github.com/smimram/monadic-synth) and type 32 | 33 | ```sh 34 | opam pin add . 35 | ``` 36 | 37 | which will use opam to install the library and its dependencies. 38 | 39 | ## Documentation 40 | 41 | The main documentation consists in 42 | 43 | - this file, 44 | - the [documentation generated from the source 45 | code comments](http://smimram.github.io/monadic-synth/odoc/msynth/), 46 | - the source code. 47 | 48 | # Tutorial 49 | 50 | In case you need it, most examples in this tutorial are [in this 51 | file](https://github.com/smimram/monadic-synth/blob/master/examples/doc.ml). 52 | 53 | ## Our first sines 54 | 55 | ### Playing a sound 56 | 57 | When creating synthesizers, you typically want to open the `Stream` module: 58 | 59 | ```ocaml 60 | open Stream 61 | ``` 62 | 63 | In subsequent code, we always suppose that this was done. Our first example 64 | consists in playing a sine at 440Hz, which can be obtained with 65 | 66 | ```ocaml 67 | let () = 68 | let s = sine () 440. >>= stereo in 69 | Output.play s 70 | ``` 71 | 72 | We use the function `sine` to create the oscillator (which oscillates 440 times 73 | per second between -1 and 1), then use `>>=` to pipe it to the `stereo` operator 74 | which converts a stream into a stereo one (a _stereo stream_ is a stream of 75 | pairs of floats), and finally use `Output.play` to stream the result. Another 76 | equivalent way to write this is 77 | 78 | ```ocaml 79 | let () = 80 | let s = 81 | let* x = sine () 440. in 82 | stereo x 83 | in 84 | Output.play s 85 | ``` 86 | 87 | where the expression `let* x = s in e` can be interpreted as _given `x` the 88 | current value of the stream `s` return `e`_. A last possible syntax (which is 89 | less clear in our opinion) would be 90 | 91 | ```ocaml 92 | let () = 93 | let s = bind stereo (sine () 440.) in 94 | Output.play s 95 | ``` 96 | 97 | Here, the `bind` operator has type 98 | 99 | ```ocaml 100 | ('a -> 'b t) -> ('a t -> 'b 't) 101 | ``` 102 | 103 | i.e. it transforms a function returning a stream so that it can take a stream as 104 | argument. 105 | 106 | ### Modulating parameters 107 | 108 | One of the main advantage of using the monadic syntax is that all arguments can 109 | vary over time. For instance, we can achieve a vibrato as follows: 110 | 111 | ```ocaml 112 | let () = 113 | let lfo = sine () in 114 | let vco = sine () in 115 | let s = 116 | let* f = lfo 5. in 117 | vco (440. +. 10. *. f) 118 | in 119 | Output.play (s >>= stereo) 120 | ``` 121 | 122 | Here, we begin by creating two oscillators respectively called `lfo` and `vco` 123 | (the names come from the 124 | [LFO](https://en.wikipedia.org/wiki/Low-frequency_oscillation) and 125 | [VCO](https://en.wikipedia.org/wiki/Voltage-controlled_oscillator) electric 126 | circuits) and state that the source `s` is the vco oscillator whose frequency is 127 | around 440 Hz, varying by ±10 Hz at the rate of 5 Hz (the rate of the lfo). Note 128 | that since the frequency is exponential with respect to notes, a vibrato of half 129 | a semitone should rather be achieved by replacing the last line in the 130 | definition of `s` by 131 | 132 | ```ocaml 133 | vco (440. *. 2. ** (0.5 *. f /. 12.)) 134 | ``` 135 | 136 | but we leave this kind of details to you. Here, it is important that the 137 | oscillators are created _beforehand_. If we try the code 138 | 139 | ```ocaml 140 | let () = 141 | let s = 142 | let* f = sine () 5. in 143 | sine () (440. +. 10. *. f) 144 | in 145 | Output.play (s >>= stereo) 146 | ``` 147 | 148 | we do not hear any sound: this is because we create a new oscillator at each 149 | sample, and thus always hear the first sample of the oscillator which is 0, and 150 | this is not what we want. The general rule is: declare all operators before the 151 | first `let*`. 152 | 153 | Another way to write the same program as above, with the `>>=` operator, would 154 | be 155 | 156 | ```ocaml 157 | let () = 158 | let s = B.cadd 440. (B.cmul 10. (sine () 5.)) >>= sine () >>= stereo in 159 | Output.play s 160 | ``` 161 | 162 | _Exercise_: play a sine with tremolo, which can be achieved by periodically 163 | varying its amplitude. 164 | 165 | As another example, instead of generating a sine, we are going to generate a 166 | square wave, using the `square` operator: by default, its value is 1 over half a 167 | period and -1 over the other half. However, there is no particular reason to do 168 | half and half, and we call the _width_ of a square wave, the portion of the 169 | period its value is 1 (by default, the width is thus 0.5). We can achieve nice 170 | sounds by periodically modulating this value, which is called [pulse width 171 | modulation](https://en.wikipedia.org/wiki/Pulse-width_modulation). For instance: 172 | 173 | ```ocaml 174 | let () = 175 | let lfo = sine () 2. in 176 | let osc = square () in 177 | let s = 178 | let* lfo = lfo in 179 | let width = 0.5 +. 0.3 *. lfo in 180 | osc ~width 440. 181 | in 182 | Output.play (s >>= stereo) 183 | ``` 184 | 185 | Here, we generate a square wave (`osc`) whose width is modulated between 0.2 and 186 | 0.8 by a sine oscillator (`lfo`) at the frequency of 2 Hz. 187 | 188 | ### Returning streams 189 | 190 | We can create constant streams with the `return` function, which creates a 191 | stream whose value is always the one given in the argument. For instance, we can 192 | define the pairing function with 193 | 194 | ```ocaml 195 | let pair x y = return (x, y) 196 | ``` 197 | 198 | Given two values `x` and `y`, it creates the stream whose value is always the 199 | pair `(x, y)`. We can then use it to play a sine at different frequency over 200 | each channel with 201 | 202 | ```ocaml 203 | let () = 204 | let left = sine () 440. in 205 | let right = sine () 880. in 206 | let s = 207 | let* x = left in 208 | let* y = right in 209 | pair x y 210 | in 211 | Output.play s 212 | ``` 213 | 214 | Another possible way to write this is using the `bind2` operators whose type is 215 | 216 | ```ocaml 217 | ('a -> 'b -> 'c t) -> ('a t -> 'b t -> 'c t) 218 | ``` 219 | 220 | i.e. it transforms a function with two arguments which returns a stream, so that 221 | it accepts streams as arguments: 222 | 223 | ```ocaml 224 | let () = 225 | let left = sine () 440. in 226 | let right = sine () 880. in 227 | let s = bind2 pair left right in 228 | Output.play s 229 | ``` 230 | 231 | ### Parameters from OSC 232 | 233 | One way to dynamically acquire parameters is to use the 234 | [OSC](https://en.wikipedia.org/wiki/Open_Sound_Control) which is supported by 235 | many software and hardware controllers (for instance, this [free app on 236 | Android](https://play.google.com/store/apps/details?id=com.ffsmultimedia.osccontroller)). In 237 | order to be able to use this, we should first call the function `OSC.server` 238 | (which takes the port number on which it should listen as argument). The value 239 | of a controller can then be acquired with the function `OSC.float`, which takes 240 | as argument the path of the controller and its initial value and returns a 241 | stream of its values. 242 | 243 | For instance, in the following, we can play a saw oscillator chained with a 244 | [low-pass filter](https://en.wikipedia.org/wiki/Low-pass_filter) where the 245 | global volume, the [Q factor](https://en.wikipedia.org/wiki/Q_factor) and 246 | [cutoff frequency](https://en.wikipedia.org/wiki/Cutoff_frequency) of the filter 247 | can be configured though OSC controls as follows. 248 | 249 | ```ocaml 250 | let () = 251 | let s = 252 | let osc = saw () 440. in 253 | let lp = Filter.biquad () `Low_pass in 254 | let a = OSC.float "/oscControl/slider1" 0.5 in 255 | let lpq = OSC.float "/oscControl/slider2" ~min:0.1 ~max:5. 1. in 256 | let lpf = OSC.float ~mode:`Logarithmic "/oscControl/slider3" ~max:10000. 1500. in 257 | let a = a >>= print "a" in 258 | let lpq = lpq >>= print "q" in 259 | let lpf = lpf >>= print "f" in 260 | let* a = a in 261 | let* f = lpf in 262 | let* q = lpq in 263 | osc 264 | >>= lp q f 265 | >>= amp a 266 | >>= stereo 267 | in 268 | OSC.server 10000; 269 | Output.play s 270 | ``` 271 | 272 | Here, we begin by creating the saw oscillator (`osc`) and the low-pass filter 273 | (`lp`), as well as the streams corresponding to the controllers for 274 | amplification, q and cutoff frequency. The line 275 | 276 | ```ocaml 277 | let a = a >>= print "a" in 278 | ``` 279 | 280 | makes the value for amplification `a` being printed on standard output when it 281 | changes, which is useful for debugging. Finally, the stream consists in the 282 | oscillator which goes through the filter, is amplified, and finally converted to 283 | stereo. 284 | 285 | ## Instruments 286 | 287 | Unless you are making [concrete 288 | music](https://en.wikipedia.org/wiki/Musique_concr%C3%A8te), you certainly want 289 | to play some notes. In order to illustrate this let's detail step by step how we 290 | can quickly recreate the song _[better off 291 | alone](https://www.youtube.com/watch?v=Lj9GzcHbJ-w)_ (sort of) by detailing 292 | [this 293 | example](https://github.com/smimram/monadic-synth/blob/master/examples/better_off_alone.ml). 294 | 295 | ### Playing notes 296 | 297 | We first have to learn how to play notes. A melody can be described as a 298 | _pattern_ which is a list of triples consisting of 299 | 300 | - the time of the note (in beats), 301 | - the duration of the note (in beats), 302 | - the actual note together with its height (in semitones, A4 is 69) and its 303 | volume (between 0 and 1). 304 | 305 | Our melody consists of two very similar patterns and can be described as 306 | 307 | ```ocaml 308 | let lead o = 309 | [ 310 | 0. , 0.5, `Note (71, 1.); 311 | 1. , 0.5, `Note (71, 1.); 312 | 1.5, 0.5, `Note (68, 1.); 313 | 2.5, 0.5, `Note (71, 1.); 314 | 3.5, 0.5, `Note (71, 1.); 315 | 4.5, 0.5, `Note (70, 1.); 316 | 5.5, 0.5, `Note (66, 1.); 317 | 6. , 0.5, `Note (78+o, 1.); 318 | 6.7, 0.5, `Note (78+o, 1.); 319 | 7.3, 0.5, `Note (75, 1.); 320 | 8. , 0. , `Nop 321 | ] 322 | in 323 | let lead = Pattern.append (lead 0) (lead (-2)) in 324 | ``` 325 | 326 | We can transform a pattern into a stream of MIDI events with `Pattern.stream`, 327 | 328 | ```ocaml 329 | let lead = Pattern.stream ~loop:true tempo lead in 330 | ``` 331 | 332 | which can in turn be played (i.e. converted into a sound stream) with 333 | `Instrument.play`. We can thus get a stream with 334 | 335 | ```ocaml 336 | let lead = Instrument.play (Note.simple saw) lead in 337 | ``` 338 | 339 | which can be played as usual (`Output.play (lead >>= stereo)`). Above, the first 340 | argument is the sound to play the melody: it describes one note, which here is 341 | simply a saw, without any envelope or anything fancy. 342 | 343 | ### Adding drums 344 | 345 | Drums can be added similarly with 346 | 347 | ```ocaml 348 | let drum = 349 | [ 350 | 0., `Kick 1.; 351 | 0.5, `Snare 1.; 352 | 1., `Nop; 353 | ] 354 | in 355 | let drum = Instrument.play_drums (Stream.timed ~loop:true ~tempo drum) >>= amp 2. in 356 | ``` 357 | 358 | where we loop on a simple pattern of one beat and use the dedicated function 359 | `Instrument.play_drums` to convert it to a stream. 360 | 361 | The two streams can be played together with 362 | 363 | ```ocaml 364 | let s = B.mix [lead; drum] >>= amp 0.2 in 365 | Output.play (s >>= stereo) 366 | ``` 367 | 368 | ### More advanced instruments 369 | 370 | The instrument we used for the lead is quite boring, let's try to do better now 371 | for the bass. We could play use a sound consisting of a saw with an ADSR 372 | envelope as a starting point: 373 | 374 | ```ocaml 375 | let bass = 376 | [ 377 | 0. , 4., `Note (40, 1.); 378 | 4. , 4., `Note (39, 1.); 379 | 8. , 4., `Note (44, 1.); 380 | 12., 4., `Note (42, 1.); 381 | ] 382 | in 383 | let note = Note.adsr saw in 384 | let bass = Instrument.play note (Pattern.stream ~loop:true tempo bass) in 385 | ``` 386 | 387 | However, we are not satisfied with the sound and would rather have a square 388 | oscillator with a low-pass filter closing down each time a note is played. This 389 | can be achieved by changing the definition of `note` to 390 | 391 | ```ocaml 392 | let note () = 393 | let osc = square () in 394 | let lp = Filter.biquad () `Low_pass 3. in 395 | let ramp = Envelope.ramp ~kind:`Exponential () ~from:5000. ~target:100. 0.5 in 396 | fun freq -> bind2 lp ramp (osc freq) 397 | in 398 | let note = Note.adsr note in 399 | ``` 400 | 401 | As you can see, `Note.adsr` takes as argument a function which, when applied to 402 | `()` creates a function which plays the stream corresponding to the note, at the 403 | given frequency. 404 | 405 | The long note takes too much space in the sound, let's chop it in small pieces: 406 | 407 | ```ocaml 408 | let bass = bass >>= Stream.Slicer.eurotrance () (60. /. tempo) in 409 | ``` 410 | 411 | ### Arpeggiators 412 | 413 | A pattern can also consist in chords. This is particularly useful in conjunction 414 | with arpeggiators, which play notes from the chords. For instance, we can add a 415 | small "harp like" synth with 416 | 417 | ```ocaml 418 | let chords = 419 | [ 420 | 0. , 4., `Chord ([40;44;47;52], 1.); 421 | 4. , 4., `Chord ([39;42;46;51], 1.); 422 | 8. , 4., `Chord ([44;47;51;56], 1.); 423 | 12., 4., `Chord ([42;46;49;54], 1.); 424 | ] 425 | in 426 | let arp = Pattern.arpeggiate `Up (Pattern.transpose 24 chords) in 427 | let arp = Instrument.play (Note.simple sine) (Pattern.stream ~loop:true tempo arp) in 428 | ``` 429 | 430 | If you were too lazy to try by yourself [your can hear the result 431 | here](https://youtu.be/F7q-wtJRgjM) (please remember that no further effects 432 | where applied, nor a decent mix was performed): 433 | 434 | https://user-images.githubusercontent.com/2012073/118515808-03838500-b736-11eb-9834-802613298758.mp4 435 | 436 | ### Live MIDI input 437 | 438 | An example of MIDI input (say, from a physical keyboard) in order to generates 439 | notes and values for parameters from physical controllers can be [found 440 | here](https://github.com/smimram/monadic-synth/blob/master/examples/midi.ml). 441 | 442 | In order to use MIDI, we should begin with using the function `MIDI.create` 443 | which provides us with a handle from which midi events can be drawn (with 444 | `MIDI.events`) as well as the value of controllers (with `MIDI.controller`). For 445 | instance, in the following example, we play the notes pressed on the keyboard 446 | with a saw instrument chained with a low pass filter whose Q parameter and 447 | cutoff frequency can be controlled by controller 0 and 1 respectively (you might 448 | have to change those numbers depending on your controller): 449 | 450 | ```ocaml 451 | let () = 452 | let midi = MIDI.create () in 453 | let note () = 454 | let osc = saw () in 455 | let lp = Filter.biquad () `Low_pass in 456 | let q = MIDI.controller midi 0 ~min:0.1 ~max:5. 1. >>= print "q" in 457 | let f = MIDI.controller midi 1 ~mode:`Logarithmic ~max:10000. 1500. >>= print "f" in 458 | fun freq -> 459 | let* q = q in 460 | let* f = f in 461 | osc freq >>= lp q f 462 | in 463 | let s = Instrument.play (Note.adsr note) (MIDI.events midi) >>= clip in 464 | Output.play (s >>= stereo) 465 | ``` 466 | 467 | # Going further 468 | 469 | If you have read everything up to there, you should know most of the principles 470 | you need to get started with the library the rest consist in 471 | 472 | - using effects, 473 | - combining functions, 474 | - finding the right parameters, 475 | - adding functions to the library, 476 | - using your imagination. 477 | 478 | As a matter of illustration, we provide 479 | 480 | - a [quick and dirty 481 | implementation](https://github.com/smimram/monadic-synth/blob/master/examples/theremin.ml) 482 | of a [Theremin](https://en.wikipedia.org/wiki/Theremin) 483 | - [the 484 | implementation](https://github.com/smimram/monadic-synth/blob/master/examples/obx.ml) 485 | of an emulation of the [Oberheim OB-Xa](https://en.wikipedia.org/wiki/Oberheim_OB-X) 486 | 487 | ## Some other examples 488 | 489 | You can also hear some demo songs, guaranteed 100% sample-free! Don't forget to turn the sound on (icon at the lower right of the video). 490 | 491 | - [THX](https://github.com/smimram/monadic-synth/blob/master/examples/thx.ml): 492 | a quick recreation of the [THX deep 493 | note](https://www.youtube.com/watch?v=uYMpMcmpfkI) by adding many saw 494 | oscillators, whose frequency is initially between 200 and 400 Hz, and slowly 495 | evolve to the same note at various octaves. 496 | 497 | https://github.com/smimram/monadic-synth/assets/2012073/31d8450b-03e8-48d1-9774-b6030c7f4b8d 498 | 499 | - [FM arpeggiator](https://github.com/smimram/monadic-synth/blob/master/examples/fm_arpeggiator.ml) 500 | 501 | https://github.com/smimram/monadic-synth/assets/2012073/72ca834b-bd7b-42a5-9391-ce9684ca4866 502 | 503 | - [Song 0](https://github.com/smimram/monadic-synth/blob/master/examples/song0.ml) 504 | 505 | https://github.com/smimram/monadic-synth/assets/2012073/8b48c1f6-20ed-44fa-9a70-76668ceaeb70 506 | 507 | - [Song 1](https://github.com/smimram/monadic-synth/blob/master/examples/song1.ml) 508 | 509 | https://github.com/smimram/monadic-synth/assets/2012073/ff157491-a41e-41d6-a8b7-0145f7432b4b 510 | 511 | - [Song 2](https://github.com/smimram/monadic-synth/blob/master/examples/song2.ml) 512 | 513 | https://github.com/smimram/monadic-synth/assets/2012073/bffd4660-7349-4cde-9e74-dd9ccc4f19ca 514 | 515 | - [Trance](https://github.com/smimram/monadic-synth/blob/master/examples/trance.ml) 516 | 517 | https://github.com/smimram/monadic-synth/assets/2012073/e67b7425-ec7d-4d98-ab13-3f509d4ca638 518 | 519 | # Advanced topics 520 | 521 | ## Using a stream multiple times 522 | 523 | Streams should not be used multiple times. For instance, if we want to play the 524 | same sine on the left and the right channel, we might be tempted two write 525 | 526 | ```ocaml 527 | let () = 528 | let pair x y = return (x, y) in 529 | let osc = sine () 440. in 530 | let s = bind2 pair osc osc in 531 | Output.play s 532 | ``` 533 | 534 | but the result is that we hear a sine at 880 Hz. The reason is that each time we 535 | pull a sample for `s`, we actually pull two samples from `osc`: once for the 536 | left channel and once for the right channel. One way to avoid this is to 537 | explicitly extract the value of the stream, and there is no problem in 538 | duplicated this value: 539 | 540 | ```ocaml 541 | let () = 542 | let pair x y = return (x, y) in 543 | let osc = sine () 440. in 544 | let s = 545 | let* x = osc in 546 | pair x x 547 | in 548 | Output.play s 549 | ``` 550 | 551 | Another way consists in using the `dup` operator, which returns a pair: the 552 | first one should be used first to evaluate the stream and the second one is a 553 | stream which can be used as many times as we want. We can thus rewrite our 554 | example as follows: 555 | 556 | ```ocaml 557 | let () = 558 | let pair x y = return (x, y) in 559 | let osc = sine () 440. in 560 | let eval, osc = dup () osc in 561 | let s = eval >> bind2 pair osc osc in 562 | Output.play s 563 | ``` 564 | 565 | ## General principles behind the library 566 | 567 | - Clean code is more important than efficient code (although we want to remain 568 | reasonably efficient). 569 | - The infinitesimal _dt_ is supposed to be very small. In particular, the stream 570 | at instant _t_ or _t+dt_ should be roughly the same. 571 | - The infinitesimal variations are supposed to be varying slowly, i.e. be 572 | "locally constant". In particular, this means that small buffers can assume 573 | that the _dt_ is the same for the whole buffer. 574 | 575 | ## Ideas for the future 576 | 577 | - Make a compiler (into, say, C) for our synthesizers, possibly by simply 578 | changing the monad. 579 | 580 | ## See also 581 | 582 | - [Haskell DSP library](https://hackage.haskell.org/package/dsp) 583 | - [Haskell synthesizer library](https://hackage.haskell.org/package/synthesizer-core) 584 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | GNU LESSER GENERAL PUBLIC LICENSE 2 | Version 2.1, February 1999 3 | 4 | Copyright (C) 1991, 1999 Free Software Foundation, Inc. 5 | 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 6 | Everyone is permitted to copy and distribute verbatim copies 7 | of this license document, but changing it is not allowed. 8 | 9 | [This is the first released version of the Lesser GPL. It also counts 10 | as the successor of the GNU Library Public License, version 2, hence 11 | the version number 2.1.] 12 | 13 | Preamble 14 | 15 | The licenses for most software are designed to take away your 16 | freedom to share and change it. By contrast, the GNU General Public 17 | Licenses are intended to guarantee your freedom to share and change 18 | free software--to make sure the software is free for all its users. 19 | 20 | This license, the Lesser General Public License, applies to some 21 | specially designated software packages--typically libraries--of the 22 | Free Software Foundation and other authors who decide to use it. You 23 | can use it too, but we suggest you first think carefully about whether 24 | this license or the ordinary General Public License is the better 25 | strategy to use in any particular case, based on the explanations below. 26 | 27 | When we speak of free software, we are referring to freedom of use, 28 | not price. Our General Public Licenses are designed to make sure that 29 | you have the freedom to distribute copies of free software (and charge 30 | for this service if you wish); that you receive source code or can get 31 | it if you want it; that you can change the software and use pieces of 32 | it in new free programs; and that you are informed that you can do 33 | these things. 34 | 35 | To protect your rights, we need to make restrictions that forbid 36 | distributors to deny you these rights or to ask you to surrender these 37 | rights. These restrictions translate to certain responsibilities for 38 | you if you distribute copies of the library or if you modify it. 39 | 40 | For example, if you distribute copies of the library, whether gratis 41 | or for a fee, you must give the recipients all the rights that we gave 42 | you. You must make sure that they, too, receive or can get the source 43 | code. If you link other code with the library, you must provide 44 | complete object files to the recipients, so that they can relink them 45 | with the library after making changes to the library and recompiling 46 | it. And you must show them these terms so they know their rights. 47 | 48 | We protect your rights with a two-step method: (1) we copyright the 49 | library, and (2) we offer you this license, which gives you legal 50 | permission to copy, distribute and/or modify the library. 51 | 52 | To protect each distributor, we want to make it very clear that 53 | there is no warranty for the free library. Also, if the library is 54 | modified by someone else and passed on, the recipients should know 55 | that what they have is not the original version, so that the original 56 | author's reputation will not be affected by problems that might be 57 | introduced by others. 58 | 59 | Finally, software patents pose a constant threat to the existence of 60 | any free program. We wish to make sure that a company cannot 61 | effectively restrict the users of a free program by obtaining a 62 | restrictive license from a patent holder. Therefore, we insist that 63 | any patent license obtained for a version of the library must be 64 | consistent with the full freedom of use specified in this license. 65 | 66 | Most GNU software, including some libraries, is covered by the 67 | ordinary GNU General Public License. This license, the GNU Lesser 68 | General Public License, applies to certain designated libraries, and 69 | is quite different from the ordinary General Public License. We use 70 | this license for certain libraries in order to permit linking those 71 | libraries into non-free programs. 72 | 73 | When a program is linked with a library, whether statically or using 74 | a shared library, the combination of the two is legally speaking a 75 | combined work, a derivative of the original library. The ordinary 76 | General Public License therefore permits such linking only if the 77 | entire combination fits its criteria of freedom. The Lesser General 78 | Public License permits more lax criteria for linking other code with 79 | the library. 80 | 81 | We call this license the "Lesser" General Public License because it 82 | does Less to protect the user's freedom than the ordinary General 83 | Public License. It also provides other free software developers Less 84 | of an advantage over competing non-free programs. These disadvantages 85 | are the reason we use the ordinary General Public License for many 86 | libraries. However, the Lesser license provides advantages in certain 87 | special circumstances. 88 | 89 | For example, on rare occasions, there may be a special need to 90 | encourage the widest possible use of a certain library, so that it becomes 91 | a de-facto standard. To achieve this, non-free programs must be 92 | allowed to use the library. A more frequent case is that a free 93 | library does the same job as widely used non-free libraries. In this 94 | case, there is little to gain by limiting the free library to free 95 | software only, so we use the Lesser General Public License. 96 | 97 | In other cases, permission to use a particular library in non-free 98 | programs enables a greater number of people to use a large body of 99 | free software. For example, permission to use the GNU C Library in 100 | non-free programs enables many more people to use the whole GNU 101 | operating system, as well as its variant, the GNU/Linux operating 102 | system. 103 | 104 | Although the Lesser General Public License is Less protective of the 105 | users' freedom, it does ensure that the user of a program that is 106 | linked with the Library has the freedom and the wherewithal to run 107 | that program using a modified version of the Library. 108 | 109 | The precise terms and conditions for copying, distribution and 110 | modification follow. Pay close attention to the difference between a 111 | "work based on the library" and a "work that uses the library". The 112 | former contains code derived from the library, whereas the latter must 113 | be combined with the library in order to run. 114 | 115 | GNU LESSER GENERAL PUBLIC LICENSE 116 | TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 117 | 118 | 0. This License Agreement applies to any software library or other 119 | program which contains a notice placed by the copyright holder or 120 | other authorized party saying it may be distributed under the terms of 121 | this Lesser General Public License (also called "this License"). 122 | Each licensee is addressed as "you". 123 | 124 | A "library" means a collection of software functions and/or data 125 | prepared so as to be conveniently linked with application programs 126 | (which use some of those functions and data) to form executables. 127 | 128 | The "Library", below, refers to any such software library or work 129 | which has been distributed under these terms. A "work based on the 130 | Library" means either the Library or any derivative work under 131 | copyright law: that is to say, a work containing the Library or a 132 | portion of it, either verbatim or with modifications and/or translated 133 | straightforwardly into another language. (Hereinafter, translation is 134 | included without limitation in the term "modification".) 135 | 136 | "Source code" for a work means the preferred form of the work for 137 | making modifications to it. For a library, complete source code means 138 | all the source code for all modules it contains, plus any associated 139 | interface definition files, plus the scripts used to control compilation 140 | and installation of the library. 141 | 142 | Activities other than copying, distribution and modification are not 143 | covered by this License; they are outside its scope. The act of 144 | running a program using the Library is not restricted, and output from 145 | such a program is covered only if its contents constitute a work based 146 | on the Library (independent of the use of the Library in a tool for 147 | writing it). Whether that is true depends on what the Library does 148 | and what the program that uses the Library does. 149 | 150 | 1. You may copy and distribute verbatim copies of the Library's 151 | complete source code as you receive it, in any medium, provided that 152 | you conspicuously and appropriately publish on each copy an 153 | appropriate copyright notice and disclaimer of warranty; keep intact 154 | all the notices that refer to this License and to the absence of any 155 | warranty; and distribute a copy of this License along with the 156 | Library. 157 | 158 | You may charge a fee for the physical act of transferring a copy, 159 | and you may at your option offer warranty protection in exchange for a 160 | fee. 161 | 162 | 2. You may modify your copy or copies of the Library or any portion 163 | of it, thus forming a work based on the Library, and copy and 164 | distribute such modifications or work under the terms of Section 1 165 | above, provided that you also meet all of these conditions: 166 | 167 | a) The modified work must itself be a software library. 168 | 169 | b) You must cause the files modified to carry prominent notices 170 | stating that you changed the files and the date of any change. 171 | 172 | c) You must cause the whole of the work to be licensed at no 173 | charge to all third parties under the terms of this License. 174 | 175 | d) If a facility in the modified Library refers to a function or a 176 | table of data to be supplied by an application program that uses 177 | the facility, other than as an argument passed when the facility 178 | is invoked, then you must make a good faith effort to ensure that, 179 | in the event an application does not supply such function or 180 | table, the facility still operates, and performs whatever part of 181 | its purpose remains meaningful. 182 | 183 | (For example, a function in a library to compute square roots has 184 | a purpose that is entirely well-defined independent of the 185 | application. Therefore, Subsection 2d requires that any 186 | application-supplied function or table used by this function must 187 | be optional: if the application does not supply it, the square 188 | root function must still compute square roots.) 189 | 190 | These requirements apply to the modified work as a whole. If 191 | identifiable sections of that work are not derived from the Library, 192 | and can be reasonably considered independent and separate works in 193 | themselves, then this License, and its terms, do not apply to those 194 | sections when you distribute them as separate works. But when you 195 | distribute the same sections as part of a whole which is a work based 196 | on the Library, the distribution of the whole must be on the terms of 197 | this License, whose permissions for other licensees extend to the 198 | entire whole, and thus to each and every part regardless of who wrote 199 | it. 200 | 201 | Thus, it is not the intent of this section to claim rights or contest 202 | your rights to work written entirely by you; rather, the intent is to 203 | exercise the right to control the distribution of derivative or 204 | collective works based on the Library. 205 | 206 | In addition, mere aggregation of another work not based on the Library 207 | with the Library (or with a work based on the Library) on a volume of 208 | a storage or distribution medium does not bring the other work under 209 | the scope of this License. 210 | 211 | 3. You may opt to apply the terms of the ordinary GNU General Public 212 | License instead of this License to a given copy of the Library. To do 213 | this, you must alter all the notices that refer to this License, so 214 | that they refer to the ordinary GNU General Public License, version 2, 215 | instead of to this License. (If a newer version than version 2 of the 216 | ordinary GNU General Public License has appeared, then you can specify 217 | that version instead if you wish.) Do not make any other change in 218 | these notices. 219 | 220 | Once this change is made in a given copy, it is irreversible for 221 | that copy, so the ordinary GNU General Public License applies to all 222 | subsequent copies and derivative works made from that copy. 223 | 224 | This option is useful when you wish to copy part of the code of 225 | the Library into a program that is not a library. 226 | 227 | 4. You may copy and distribute the Library (or a portion or 228 | derivative of it, under Section 2) in object code or executable form 229 | under the terms of Sections 1 and 2 above provided that you accompany 230 | it with the complete corresponding machine-readable source code, which 231 | must be distributed under the terms of Sections 1 and 2 above on a 232 | medium customarily used for software interchange. 233 | 234 | If distribution of object code is made by offering access to copy 235 | from a designated place, then offering equivalent access to copy the 236 | source code from the same place satisfies the requirement to 237 | distribute the source code, even though third parties are not 238 | compelled to copy the source along with the object code. 239 | 240 | 5. A program that contains no derivative of any portion of the 241 | Library, but is designed to work with the Library by being compiled or 242 | linked with it, is called a "work that uses the Library". Such a 243 | work, in isolation, is not a derivative work of the Library, and 244 | therefore falls outside the scope of this License. 245 | 246 | However, linking a "work that uses the Library" with the Library 247 | creates an executable that is a derivative of the Library (because it 248 | contains portions of the Library), rather than a "work that uses the 249 | library". The executable is therefore covered by this License. 250 | Section 6 states terms for distribution of such executables. 251 | 252 | When a "work that uses the Library" uses material from a header file 253 | that is part of the Library, the object code for the work may be a 254 | derivative work of the Library even though the source code is not. 255 | Whether this is true is especially significant if the work can be 256 | linked without the Library, or if the work is itself a library. The 257 | threshold for this to be true is not precisely defined by law. 258 | 259 | If such an object file uses only numerical parameters, data 260 | structure layouts and accessors, and small macros and small inline 261 | functions (ten lines or less in length), then the use of the object 262 | file is unrestricted, regardless of whether it is legally a derivative 263 | work. (Executables containing this object code plus portions of the 264 | Library will still fall under Section 6.) 265 | 266 | Otherwise, if the work is a derivative of the Library, you may 267 | distribute the object code for the work under the terms of Section 6. 268 | Any executables containing that work also fall under Section 6, 269 | whether or not they are linked directly with the Library itself. 270 | 271 | 6. As an exception to the Sections above, you may also combine or 272 | link a "work that uses the Library" with the Library to produce a 273 | work containing portions of the Library, and distribute that work 274 | under terms of your choice, provided that the terms permit 275 | modification of the work for the customer's own use and reverse 276 | engineering for debugging such modifications. 277 | 278 | You must give prominent notice with each copy of the work that the 279 | Library is used in it and that the Library and its use are covered by 280 | this License. You must supply a copy of this License. If the work 281 | during execution displays copyright notices, you must include the 282 | copyright notice for the Library among them, as well as a reference 283 | directing the user to the copy of this License. Also, you must do one 284 | of these things: 285 | 286 | a) Accompany the work with the complete corresponding 287 | machine-readable source code for the Library including whatever 288 | changes were used in the work (which must be distributed under 289 | Sections 1 and 2 above); and, if the work is an executable linked 290 | with the Library, with the complete machine-readable "work that 291 | uses the Library", as object code and/or source code, so that the 292 | user can modify the Library and then relink to produce a modified 293 | executable containing the modified Library. (It is understood 294 | that the user who changes the contents of definitions files in the 295 | Library will not necessarily be able to recompile the application 296 | to use the modified definitions.) 297 | 298 | b) Use a suitable shared library mechanism for linking with the 299 | Library. A suitable mechanism is one that (1) uses at run time a 300 | copy of the library already present on the user's computer system, 301 | rather than copying library functions into the executable, and (2) 302 | will operate properly with a modified version of the library, if 303 | the user installs one, as long as the modified version is 304 | interface-compatible with the version that the work was made with. 305 | 306 | c) Accompany the work with a written offer, valid for at 307 | least three years, to give the same user the materials 308 | specified in Subsection 6a, above, for a charge no more 309 | than the cost of performing this distribution. 310 | 311 | d) If distribution of the work is made by offering access to copy 312 | from a designated place, offer equivalent access to copy the above 313 | specified materials from the same place. 314 | 315 | e) Verify that the user has already received a copy of these 316 | materials or that you have already sent this user a copy. 317 | 318 | For an executable, the required form of the "work that uses the 319 | Library" must include any data and utility programs needed for 320 | reproducing the executable from it. However, as a special exception, 321 | the materials to be distributed need not include anything that is 322 | normally distributed (in either source or binary form) with the major 323 | components (compiler, kernel, and so on) of the operating system on 324 | which the executable runs, unless that component itself accompanies 325 | the executable. 326 | 327 | It may happen that this requirement contradicts the license 328 | restrictions of other proprietary libraries that do not normally 329 | accompany the operating system. Such a contradiction means you cannot 330 | use both them and the Library together in an executable that you 331 | distribute. 332 | 333 | 7. You may place library facilities that are a work based on the 334 | Library side-by-side in a single library together with other library 335 | facilities not covered by this License, and distribute such a combined 336 | library, provided that the separate distribution of the work based on 337 | the Library and of the other library facilities is otherwise 338 | permitted, and provided that you do these two things: 339 | 340 | a) Accompany the combined library with a copy of the same work 341 | based on the Library, uncombined with any other library 342 | facilities. This must be distributed under the terms of the 343 | Sections above. 344 | 345 | b) Give prominent notice with the combined library of the fact 346 | that part of it is a work based on the Library, and explaining 347 | where to find the accompanying uncombined form of the same work. 348 | 349 | 8. You may not copy, modify, sublicense, link with, or distribute 350 | the Library except as expressly provided under this License. Any 351 | attempt otherwise to copy, modify, sublicense, link with, or 352 | distribute the Library is void, and will automatically terminate your 353 | rights under this License. However, parties who have received copies, 354 | or rights, from you under this License will not have their licenses 355 | terminated so long as such parties remain in full compliance. 356 | 357 | 9. You are not required to accept this License, since you have not 358 | signed it. However, nothing else grants you permission to modify or 359 | distribute the Library or its derivative works. These actions are 360 | prohibited by law if you do not accept this License. Therefore, by 361 | modifying or distributing the Library (or any work based on the 362 | Library), you indicate your acceptance of this License to do so, and 363 | all its terms and conditions for copying, distributing or modifying 364 | the Library or works based on it. 365 | 366 | 10. Each time you redistribute the Library (or any work based on the 367 | Library), the recipient automatically receives a license from the 368 | original licensor to copy, distribute, link with or modify the Library 369 | subject to these terms and conditions. You may not impose any further 370 | restrictions on the recipients' exercise of the rights granted herein. 371 | You are not responsible for enforcing compliance by third parties with 372 | this License. 373 | 374 | 11. If, as a consequence of a court judgment or allegation of patent 375 | infringement or for any other reason (not limited to patent issues), 376 | conditions are imposed on you (whether by court order, agreement or 377 | otherwise) that contradict the conditions of this License, they do not 378 | excuse you from the conditions of this License. If you cannot 379 | distribute so as to satisfy simultaneously your obligations under this 380 | License and any other pertinent obligations, then as a consequence you 381 | may not distribute the Library at all. For example, if a patent 382 | license would not permit royalty-free redistribution of the Library by 383 | all those who receive copies directly or indirectly through you, then 384 | the only way you could satisfy both it and this License would be to 385 | refrain entirely from distribution of the Library. 386 | 387 | If any portion of this section is held invalid or unenforceable under any 388 | particular circumstance, the balance of the section is intended to apply, 389 | and the section as a whole is intended to apply in other circumstances. 390 | 391 | It is not the purpose of this section to induce you to infringe any 392 | patents or other property right claims or to contest validity of any 393 | such claims; this section has the sole purpose of protecting the 394 | integrity of the free software distribution system which is 395 | implemented by public license practices. Many people have made 396 | generous contributions to the wide range of software distributed 397 | through that system in reliance on consistent application of that 398 | system; it is up to the author/donor to decide if he or she is willing 399 | to distribute software through any other system and a licensee cannot 400 | impose that choice. 401 | 402 | This section is intended to make thoroughly clear what is believed to 403 | be a consequence of the rest of this License. 404 | 405 | 12. If the distribution and/or use of the Library is restricted in 406 | certain countries either by patents or by copyrighted interfaces, the 407 | original copyright holder who places the Library under this License may add 408 | an explicit geographical distribution limitation excluding those countries, 409 | so that distribution is permitted only in or among countries not thus 410 | excluded. In such case, this License incorporates the limitation as if 411 | written in the body of this License. 412 | 413 | 13. The Free Software Foundation may publish revised and/or new 414 | versions of the Lesser General Public License from time to time. 415 | Such new versions will be similar in spirit to the present version, 416 | but may differ in detail to address new problems or concerns. 417 | 418 | Each version is given a distinguishing version number. If the Library 419 | specifies a version number of this License which applies to it and 420 | "any later version", you have the option of following the terms and 421 | conditions either of that version or of any later version published by 422 | the Free Software Foundation. If the Library does not specify a 423 | license version number, you may choose any version ever published by 424 | the Free Software Foundation. 425 | 426 | 14. If you wish to incorporate parts of the Library into other free 427 | programs whose distribution conditions are incompatible with these, 428 | write to the author to ask for permission. For software which is 429 | copyrighted by the Free Software Foundation, write to the Free 430 | Software Foundation; we sometimes make exceptions for this. Our 431 | decision will be guided by the two goals of preserving the free status 432 | of all derivatives of our free software and of promoting the sharing 433 | and reuse of software generally. 434 | 435 | NO WARRANTY 436 | 437 | 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO 438 | WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. 439 | EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR 440 | OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY 441 | KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE 442 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR 443 | PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE 444 | LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME 445 | THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 446 | 447 | 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN 448 | WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY 449 | AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU 450 | FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR 451 | CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE 452 | LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING 453 | RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A 454 | FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF 455 | SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH 456 | DAMAGES. 457 | 458 | END OF TERMS AND CONDITIONS 459 | 460 | How to Apply These Terms to Your New Libraries 461 | 462 | If you develop a new library, and you want it to be of the greatest 463 | possible use to the public, we recommend making it free software that 464 | everyone can redistribute and change. You can do so by permitting 465 | redistribution under these terms (or, alternatively, under the terms of the 466 | ordinary General Public License). 467 | 468 | To apply these terms, attach the following notices to the library. It is 469 | safest to attach them to the start of each source file to most effectively 470 | convey the exclusion of warranty; and each file should have at least the 471 | "copyright" line and a pointer to where the full notice is found. 472 | 473 | 474 | Copyright (C) 475 | 476 | This library is free software; you can redistribute it and/or 477 | modify it under the terms of the GNU Lesser General Public 478 | License as published by the Free Software Foundation; either 479 | version 2.1 of the License, or (at your option) any later version. 480 | 481 | This library is distributed in the hope that it will be useful, 482 | but WITHOUT ANY WARRANTY; without even the implied warranty of 483 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 484 | Lesser General Public License for more details. 485 | 486 | You should have received a copy of the GNU Lesser General Public 487 | License along with this library; if not, write to the Free Software 488 | Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 489 | USA 490 | 491 | Also add information on how to contact you by electronic and paper mail. 492 | 493 | You should also get your employer (if you work as a programmer) or your 494 | school, if any, to sign a "copyright disclaimer" for the library, if 495 | necessary. Here is a sample; alter the names: 496 | 497 | Yoyodyne, Inc., hereby disclaims all copyright interest in the 498 | library `Frob' (a library for tweaking knobs) written by James Random 499 | Hacker. 500 | 501 | , 1 April 1990 502 | Ty Coon, President of Vice 503 | 504 | That's all there is to it! 505 | -------------------------------------------------------------------------------- /experiments/compiler/OCamlMakefile: -------------------------------------------------------------------------------- 1 | ########################################################################### 2 | # OCamlMakefile 3 | # Copyright (C) 1999- Markus Mottl 4 | # 5 | # For updates see: 6 | # http://www.ocaml.info/home/ocaml_sources.html 7 | # 8 | ########################################################################### 9 | 10 | # Modified by damien for .glade.ml compilation 11 | 12 | # Set these variables to the names of the sources to be processed and 13 | # the result variable. Order matters during linkage! 14 | 15 | ifndef SOURCES 16 | SOURCES := foo.ml 17 | endif 18 | export SOURCES 19 | 20 | ifndef RES_CLIB_SUF 21 | RES_CLIB_SUF := _stubs 22 | endif 23 | export RES_CLIB_SUF 24 | 25 | ifndef RESULT 26 | RESULT := foo 27 | endif 28 | export RESULT := $(strip $(RESULT)) 29 | 30 | export LIB_PACK_NAME 31 | 32 | ifndef DOC_FILES 33 | DOC_FILES := $(filter %.mli, $(SOURCES)) 34 | endif 35 | export DOC_FILES 36 | FIRST_DOC_FILE := $(firstword $(DOC_FILES)) 37 | 38 | export BCSUFFIX 39 | export NCSUFFIX 40 | 41 | ifndef TOPSUFFIX 42 | TOPSUFFIX := .top 43 | endif 44 | export TOPSUFFIX 45 | 46 | # Eventually set include- and library-paths, libraries to link, 47 | # additional compilation-, link- and ocamlyacc-flags 48 | # Path- and library information needs not be written with "-I" and such... 49 | # Define THREADS if you need it, otherwise leave it unset (same for 50 | # USE_CAMLP4)! 51 | 52 | export THREADS 53 | export VMTHREADS 54 | export ANNOTATE 55 | export USE_CAMLP4 56 | 57 | export INCDIRS 58 | export LIBDIRS 59 | export EXTLIBDIRS 60 | export RESULTDEPS 61 | export OCAML_DEFAULT_DIRS 62 | 63 | export LIBS 64 | export CLIBS 65 | export CFRAMEWORKS 66 | 67 | export OCAMLFLAGS 68 | export OCAMLNCFLAGS 69 | export OCAMLBCFLAGS 70 | 71 | export OCAMLLDFLAGS 72 | export OCAMLNLDFLAGS 73 | export OCAMLBLDFLAGS 74 | 75 | export OCAMLMKLIB_FLAGS 76 | 77 | ifndef OCAMLCPFLAGS 78 | OCAMLCPFLAGS := a 79 | endif 80 | export OCAMLCPFLAGS 81 | 82 | ifndef DOC_DIR 83 | DOC_DIR := doc 84 | endif 85 | export DOC_DIR 86 | 87 | export PPFLAGS 88 | 89 | export LFLAGS 90 | export YFLAGS 91 | export IDLFLAGS 92 | 93 | export OCAMLDOCFLAGS 94 | 95 | export OCAMLFIND_INSTFLAGS 96 | 97 | export DVIPSFLAGS 98 | 99 | export STATIC 100 | 101 | # Add a list of optional trash files that should be deleted by "make clean" 102 | export TRASH 103 | 104 | ECHO := echo 105 | 106 | ifdef REALLY_QUIET 107 | export REALLY_QUIET 108 | ECHO := true 109 | LFLAGS := $(LFLAGS) -q 110 | YFLAGS := $(YFLAGS) -q 111 | endif 112 | 113 | #################### variables depending on your OCaml-installation 114 | 115 | SYSTEM := $(shell ocamlc -config 2>/dev/null | grep system | sed 's/system: //') 116 | # This may be 117 | # - mingw 118 | # - win32 119 | # - cygwin 120 | # - some other string means Unix 121 | # - empty means ocamlc does not support -config 122 | 123 | ifeq ($(SYSTEM),mingw) 124 | MINGW=1 125 | endif 126 | ifeq ($(SYSTEM),win32) 127 | MSVC=1 128 | endif 129 | 130 | ifdef MINGW 131 | export MINGW 132 | WIN32 := 1 133 | # We are compiling with cygwin tools: 134 | CFLAGS_WIN32 := -mno-cygwin 135 | # The default value 'cc' makes 'ocamlc -cc "cc"' raises the error 'The 136 | # NTVDM CPU has encountered an illegal instruction'. 137 | CC := gcc 138 | # The OCaml C header files use this flag: 139 | CFLAGS += -D__MINGW32__ 140 | endif 141 | ifdef MSVC 142 | export MSVC 143 | WIN32 := 1 144 | ifndef STATIC 145 | CPPFLAGS_WIN32 := -DCAML_DLL 146 | endif 147 | CFLAGS_WIN32 += -nologo 148 | EXT_OBJ := obj 149 | EXT_LIB := lib 150 | ifeq ($(CC),gcc) 151 | # work around GNU Make default value 152 | ifdef THREADS 153 | CC := cl -MT 154 | else 155 | CC := cl 156 | endif 157 | endif 158 | ifeq ($(CXX),g++) 159 | # work around GNU Make default value 160 | CXX := $(CC) 161 | endif 162 | CFLAG_O := -Fo 163 | endif 164 | ifdef WIN32 165 | EXT_CXX := cpp 166 | EXE := .exe 167 | endif 168 | 169 | ifndef EXT_OBJ 170 | EXT_OBJ := o 171 | endif 172 | ifndef EXT_LIB 173 | EXT_LIB := a 174 | endif 175 | ifndef EXT_CXX 176 | EXT_CXX := cc 177 | endif 178 | ifndef EXE 179 | EXE := # empty 180 | endif 181 | ifndef CFLAG_O 182 | CFLAG_O := -o # do not delete this comment (preserves trailing whitespace)! 183 | endif 184 | 185 | export CC 186 | export CXX 187 | export CFLAGS 188 | export CXXFLAGS 189 | export LDFLAGS 190 | export CPPFLAGS 191 | 192 | ifndef RPATH_FLAG 193 | ifdef ELF_RPATH_FLAG 194 | RPATH_FLAG := $(ELF_RPATH_FLAG) 195 | else 196 | RPATH_FLAG := -R 197 | endif 198 | endif 199 | export RPATH_FLAG 200 | 201 | ifndef MSVC 202 | ifndef PIC_CFLAGS 203 | PIC_CFLAGS := -fPIC 204 | endif 205 | ifndef PIC_CPPFLAGS 206 | PIC_CPPFLAGS := -DPIC 207 | endif 208 | endif 209 | 210 | export PIC_CFLAGS 211 | export PIC_CPPFLAGS 212 | 213 | BCRESULT := $(addsuffix $(BCSUFFIX), $(RESULT)) 214 | NCRESULT := $(addsuffix $(NCSUFFIX), $(RESULT)) 215 | TOPRESULT := $(addsuffix $(TOPSUFFIX), $(RESULT)) 216 | 217 | ifndef OCAMLFIND 218 | OCAMLFIND := ocamlfind 219 | endif 220 | export OCAMLFIND 221 | 222 | ifndef OCAML 223 | OCAML := ocaml 224 | endif 225 | export OCAML 226 | 227 | ifndef OCAMLC 228 | OCAMLC := ocamlc 229 | endif 230 | export OCAMLC 231 | 232 | ifndef OCAMLOPT 233 | OCAMLOPT := ocamlopt 234 | endif 235 | export OCAMLOPT 236 | 237 | ifndef OCAMLMKTOP 238 | OCAMLMKTOP := ocamlmktop 239 | endif 240 | export OCAMLMKTOP 241 | 242 | ifndef OCAMLCP 243 | OCAMLCP := ocamlcp 244 | endif 245 | export OCAMLCP 246 | 247 | ifndef OCAMLDEP 248 | OCAMLDEP := ocamldep 249 | endif 250 | export OCAMLDEP 251 | 252 | ifndef OCAMLLEX 253 | OCAMLLEX := ocamllex 254 | endif 255 | export OCAMLLEX 256 | 257 | ifndef OCAMLYACC 258 | OCAMLYACC := ocamlyacc 259 | endif 260 | export OCAMLYACC 261 | 262 | ifndef OCAMLMKLIB 263 | OCAMLMKLIB := ocamlmklib 264 | endif 265 | export OCAMLMKLIB 266 | 267 | ifndef OCAML_GLADECC 268 | OCAML_GLADECC := lablgladecc2 269 | endif 270 | export OCAML_GLADECC 271 | 272 | ifndef OCAML_GLADECC_FLAGS 273 | OCAML_GLADECC_FLAGS := 274 | endif 275 | export OCAML_GLADECC_FLAGS 276 | 277 | ifndef CAMELEON_REPORT 278 | CAMELEON_REPORT := report 279 | endif 280 | export CAMELEON_REPORT 281 | 282 | ifndef CAMELEON_REPORT_FLAGS 283 | CAMELEON_REPORT_FLAGS := 284 | endif 285 | export CAMELEON_REPORT_FLAGS 286 | 287 | ifndef CAMELEON_ZOGGY 288 | CAMELEON_ZOGGY := camlp4o pa_zog.cma pr_o.cmo 289 | endif 290 | export CAMELEON_ZOGGY 291 | 292 | ifndef CAMELEON_ZOGGY_FLAGS 293 | CAMELEON_ZOGGY_FLAGS := 294 | endif 295 | export CAMELEON_ZOGGY_FLAGS 296 | 297 | ifndef OXRIDL 298 | OXRIDL := oxridl 299 | endif 300 | export OXRIDL 301 | 302 | ifndef CAMLIDL 303 | CAMLIDL := camlidl 304 | endif 305 | export CAMLIDL 306 | 307 | ifndef CAMLIDLDLL 308 | CAMLIDLDLL := camlidldll 309 | endif 310 | export CAMLIDLDLL 311 | 312 | ifndef NOIDLHEADER 313 | MAYBE_IDL_HEADER := -header 314 | endif 315 | export NOIDLHEADER 316 | 317 | export NO_CUSTOM 318 | 319 | ifndef CAMLP4 320 | CAMLP4 := camlp4 321 | endif 322 | export CAMLP4 323 | 324 | ifndef REAL_OCAMLFIND 325 | ifdef PACKS 326 | ifndef CREATE_LIB 327 | ifdef THREADS 328 | PACKS += threads 329 | endif 330 | endif 331 | empty := 332 | space := $(empty) $(empty) 333 | comma := , 334 | ifdef PREDS 335 | PRE_OCAML_FIND_PREDICATES := $(subst $(space),$(comma),$(PREDS)) 336 | PRE_OCAML_FIND_PACKAGES := $(subst $(space),$(comma),$(PACKS)) 337 | OCAML_FIND_PREDICATES := -predicates $(PRE_OCAML_FIND_PREDICATES) 338 | # OCAML_DEP_PREDICATES := -syntax $(PRE_OCAML_FIND_PREDICATES) 339 | OCAML_FIND_PACKAGES := $(OCAML_FIND_PREDICATES) -package $(PRE_OCAML_FIND_PACKAGES) 340 | OCAML_DEP_PACKAGES := $(OCAML_DEP_PREDICATES) -package $(PRE_OCAML_FIND_PACKAGES) 341 | else 342 | OCAML_FIND_PACKAGES := -package $(subst $(space),$(comma),$(PACKS)) 343 | OCAML_DEP_PACKAGES := 344 | endif 345 | OCAML_FIND_LINKPKG := -linkpkg 346 | REAL_OCAMLFIND := $(OCAMLFIND) 347 | endif 348 | endif 349 | 350 | export OCAML_FIND_PACKAGES 351 | export OCAML_DEP_PACKAGES 352 | export OCAML_FIND_LINKPKG 353 | export REAL_OCAMLFIND 354 | 355 | ifndef OCAMLDOC 356 | OCAMLDOC := ocamldoc 357 | endif 358 | export OCAMLDOC 359 | 360 | ifndef LATEX 361 | LATEX := latex 362 | endif 363 | export LATEX 364 | 365 | ifndef DVIPS 366 | DVIPS := dvips 367 | endif 368 | export DVIPS 369 | 370 | ifndef PS2PDF 371 | PS2PDF := ps2pdf 372 | endif 373 | export PS2PDF 374 | 375 | ifndef OCAMLMAKEFILE 376 | OCAMLMAKEFILE := OCamlMakefile 377 | endif 378 | export OCAMLMAKEFILE 379 | 380 | ifndef OCAMLLIBPATH 381 | OCAMLLIBPATH := \ 382 | $(shell $(OCAMLC) 2>/dev/null -where || echo /usr/lib/ocaml) 383 | endif 384 | export OCAMLLIBPATH 385 | 386 | ifndef OCAML_LIB_INSTALL 387 | OCAML_LIB_INSTALL := $(OCAMLLIBPATH)/contrib 388 | endif 389 | export OCAML_LIB_INSTALL 390 | 391 | ########################################################################### 392 | 393 | #################### change following sections only if 394 | #################### you know what you are doing! 395 | 396 | # delete target files when a build command fails 397 | .PHONY: .DELETE_ON_ERROR 398 | .DELETE_ON_ERROR: 399 | 400 | # for pedants using "--warn-undefined-variables" 401 | export MAYBE_IDL 402 | export REAL_RESULT 403 | export CAMLIDLFLAGS 404 | export THREAD_FLAG 405 | export RES_CLIB 406 | export MAKEDLL 407 | export ANNOT_FLAG 408 | export C_OXRIDL 409 | export SUBPROJS 410 | export CFLAGS_WIN32 411 | export CPPFLAGS_WIN32 412 | 413 | INCFLAGS := 414 | 415 | SHELL := /bin/sh 416 | 417 | MLDEPDIR := ._d 418 | BCDIDIR := ._bcdi 419 | NCDIDIR := ._ncdi 420 | 421 | FILTER_EXTNS := %.mli %.ml %.mll %.mly %.idl %.oxridl %.c %.m %.$(EXT_CXX) %.rep %.zog %.glade 422 | 423 | FILTERED := $(filter $(FILTER_EXTNS), $(SOURCES)) 424 | SOURCE_DIRS := $(filter-out ./, $(sort $(dir $(FILTERED)))) 425 | 426 | FILTERED_REP := $(filter %.rep, $(FILTERED)) 427 | DEP_REP := $(FILTERED_REP:%.rep=$(MLDEPDIR)/%.d) 428 | AUTO_REP := $(FILTERED_REP:.rep=.ml) 429 | 430 | FILTERED_ZOG := $(filter %.zog, $(FILTERED)) 431 | DEP_ZOG := $(FILTERED_ZOG:%.zog=$(MLDEPDIR)/%.d) 432 | AUTO_ZOG := $(FILTERED_ZOG:.zog=.ml) 433 | 434 | FILTERED_GLADE := $(filter %.glade, $(FILTERED)) 435 | DEP_GLADE := $(FILTERED_GLADE:%.glade=$(MLDEPDIR)/%.d) 436 | AUTO_GLADE := $(FILTERED_GLADE:.glade=.ml) 437 | 438 | FILTERED_ML := $(filter %.ml, $(FILTERED)) 439 | DEP_ML := $(FILTERED_ML:%.ml=$(MLDEPDIR)/%.d) 440 | 441 | FILTERED_MLI := $(filter %.mli, $(FILTERED)) 442 | DEP_MLI := $(FILTERED_MLI:.mli=.di) 443 | 444 | FILTERED_MLL := $(filter %.mll, $(FILTERED)) 445 | DEP_MLL := $(FILTERED_MLL:%.mll=$(MLDEPDIR)/%.d) 446 | AUTO_MLL := $(FILTERED_MLL:.mll=.ml) 447 | 448 | FILTERED_MLY := $(filter %.mly, $(FILTERED)) 449 | DEP_MLY := $(FILTERED_MLY:%.mly=$(MLDEPDIR)/%.d) $(FILTERED_MLY:.mly=.di) 450 | AUTO_MLY := $(FILTERED_MLY:.mly=.mli) $(FILTERED_MLY:.mly=.ml) 451 | 452 | FILTERED_IDL := $(filter %.idl, $(FILTERED)) 453 | DEP_IDL := $(FILTERED_IDL:%.idl=$(MLDEPDIR)/%.d) $(FILTERED_IDL:.idl=.di) 454 | C_IDL := $(FILTERED_IDL:%.idl=%_stubs.c) 455 | ifndef NOIDLHEADER 456 | C_IDL += $(FILTERED_IDL:.idl=.h) 457 | endif 458 | OBJ_C_IDL := $(FILTERED_IDL:%.idl=%_stubs.$(EXT_OBJ)) 459 | AUTO_IDL := $(FILTERED_IDL:.idl=.mli) $(FILTERED_IDL:.idl=.ml) $(C_IDL) 460 | 461 | FILTERED_OXRIDL := $(filter %.oxridl, $(FILTERED)) 462 | DEP_OXRIDL := $(FILTERED_OXRIDL:%.oxridl=$(MLDEPDIR)/%.d) $(FILTERED_OXRIDL:.oxridl=.di) 463 | AUTO_OXRIDL := $(FILTERED_OXRIDL:.oxridl=.mli) $(FILTERED_OXRIDL:.oxridl=.ml) $(C_OXRIDL) 464 | 465 | FILTERED_C_CXX := $(filter %.c %.m %.$(EXT_CXX), $(FILTERED)) 466 | OBJ_C_CXX := $(FILTERED_C_CXX:.c=.$(EXT_OBJ)) 467 | OBJ_C_CXX := $(OBJ_C_CXX:.m=.$(EXT_OBJ)) 468 | OBJ_C_CXX := $(OBJ_C_CXX:.$(EXT_CXX)=.$(EXT_OBJ)) 469 | 470 | PRE_TARGETS += $(AUTO_MLL) $(AUTO_MLY) $(AUTO_IDL) $(AUTO_OXRIDL) $(AUTO_ZOG) $(AUTO_REP) $(AUTO_GLADE) 471 | 472 | ALL_DEPS := $(DEP_ML) $(DEP_MLI) $(DEP_MLL) $(DEP_MLY) $(DEP_IDL) $(DEP_OXRIDL) $(DEP_ZOG) $(DEP_REP) $(DEP_GLADE) 473 | 474 | MLDEPS := $(filter %.d, $(ALL_DEPS)) 475 | MLIDEPS := $(filter %.di, $(ALL_DEPS)) 476 | BCDEPIS := $(MLIDEPS:%.di=$(BCDIDIR)/%.di) 477 | NCDEPIS := $(MLIDEPS:%.di=$(NCDIDIR)/%.di) 478 | 479 | ALLML := $(filter %.mli %.ml %.mll %.mly %.idl %.oxridl %.rep %.zog %.glade, $(FILTERED)) 480 | 481 | IMPLO_INTF := $(ALLML:%.mli=%.mli.__) 482 | IMPLO_INTF := $(foreach file, $(IMPLO_INTF), \ 483 | $(basename $(file)).cmi $(basename $(file)).cmo) 484 | IMPLO_INTF := $(filter-out %.mli.cmo, $(IMPLO_INTF)) 485 | IMPLO_INTF := $(IMPLO_INTF:%.mli.cmi=%.cmi) 486 | 487 | IMPLX_INTF := $(IMPLO_INTF:.cmo=.cmx) 488 | 489 | INTF := $(filter %.cmi, $(IMPLO_INTF)) 490 | IMPL_CMO := $(filter %.cmo, $(IMPLO_INTF)) 491 | IMPL_CMX := $(IMPL_CMO:.cmo=.cmx) 492 | IMPL_ASM := $(IMPL_CMO:.cmo=.asm) 493 | IMPL_S := $(IMPL_CMO:.cmo=.s) 494 | 495 | OBJ_LINK := $(OBJ_C_IDL) $(OBJ_C_CXX) 496 | OBJ_FILES := $(IMPL_CMO:.cmo=.$(EXT_OBJ)) $(OBJ_LINK) 497 | 498 | EXECS := $(addsuffix $(EXE), \ 499 | $(sort $(TOPRESULT) $(BCRESULT) $(NCRESULT))) 500 | ifdef WIN32 501 | EXECS += $(BCRESULT).dll $(NCRESULT).dll 502 | endif 503 | 504 | CLIB_BASE := $(RESULT)$(RES_CLIB_SUF) 505 | ifneq ($(strip $(OBJ_LINK)),) 506 | RES_CLIB := lib$(CLIB_BASE).$(EXT_LIB) 507 | endif 508 | 509 | ifdef WIN32 510 | DLLSONAME := dll$(CLIB_BASE).dll 511 | else 512 | DLLSONAME := dll$(CLIB_BASE).so 513 | endif 514 | 515 | NONEXECS := $(INTF) $(IMPL_CMO) $(IMPL_CMX) $(IMPL_ASM) $(IMPL_S) \ 516 | $(OBJ_FILES) $(PRE_TARGETS) $(BCRESULT).cma $(NCRESULT).cmxa \ 517 | $(NCRESULT).$(EXT_LIB) $(BCRESULT).cmi $(BCRESULT).cmo \ 518 | $(NCRESULT).cmi $(NCRESULT).cmx $(NCRESULT).$(EXT_OBJ) \ 519 | $(RES_CLIB) $(IMPL_CMO:.cmo=.annot) \ 520 | $(LIB_PACK_NAME).cmi $(LIB_PACK_NAME).cmo $(LIB_PACK_NAME).cmx \ 521 | $(LIB_PACK_NAME).$(EXT_OBJ) 522 | 523 | ifndef STATIC 524 | NONEXECS += $(DLLSONAME) 525 | endif 526 | 527 | ifndef LIBINSTALL_FILES 528 | LIBINSTALL_FILES := $(RESULT).mli $(RESULT).cmi $(RESULT).cma \ 529 | $(RESULT).cmxa $(RESULT).$(EXT_LIB) $(RES_CLIB) 530 | ifndef STATIC 531 | ifneq ($(strip $(OBJ_LINK)),) 532 | LIBINSTALL_FILES += $(DLLSONAME) 533 | endif 534 | endif 535 | endif 536 | 537 | export LIBINSTALL_FILES 538 | 539 | ifdef WIN32 540 | # some extra stuff is created while linking DLLs 541 | NONEXECS += $(BCRESULT).$(EXT_LIB) $(BCRESULT).exp $(NCRESULT).exp $(CLIB_BASE).exp $(CLIB_BASE).lib 542 | endif 543 | 544 | TARGETS := $(EXECS) $(NONEXECS) 545 | 546 | # If there are IDL-files 547 | ifneq ($(strip $(FILTERED_IDL)),) 548 | MAYBE_IDL := -cclib -lcamlidl 549 | endif 550 | 551 | ifdef USE_CAMLP4 552 | CAMLP4PATH := \ 553 | $(shell $(CAMLP4) -where 2>/dev/null || echo /usr/lib/camlp4) 554 | INCFLAGS := -I $(CAMLP4PATH) 555 | CINCFLAGS := -I$(CAMLP4PATH) 556 | endif 557 | 558 | INCFLAGS := $(INCFLAGS) $(INCDIRS:%=-I %) $(SOURCE_DIRS:%=-I %) $(OCAML_DEFAULT_DIRS:%=-I %) 559 | CINCFLAGS += $(SOURCE_DIRS:%=-I%) $(INCDIRS:%=-I%) $(OCAML_DEFAULT_DIRS:%=-I%) 560 | 561 | ifndef MSVC 562 | CLIBFLAGS += $(SOURCE_DIRS:%=-L%) $(LIBDIRS:%=-L%) \ 563 | $(EXTLIBDIRS:%=-L%) $(OCAML_DEFAULT_DIRS:%=-L%) 564 | 565 | ifeq ($(ELF_RPATH), yes) 566 | CLIBFLAGS += $(EXTLIBDIRS:%=-Wl,$(RPATH_FLAG)%) 567 | endif 568 | endif 569 | 570 | ifndef PROFILING 571 | INTF_OCAMLC := $(OCAMLC) 572 | else 573 | ifndef THREADS 574 | INTF_OCAMLC := $(OCAMLCP) -p $(OCAMLCPFLAGS) 575 | else 576 | # OCaml does not support profiling byte code 577 | # with threads (yet), therefore we force an error. 578 | ifndef REAL_OCAMLC 579 | $(error Profiling of multithreaded byte code not yet supported by OCaml) 580 | endif 581 | INTF_OCAMLC := $(OCAMLC) 582 | endif 583 | endif 584 | 585 | ifndef MSVC 586 | COMMON_LDFLAGS := $(LDFLAGS:%=-ccopt %) $(SOURCE_DIRS:%=-ccopt -L%) \ 587 | $(LIBDIRS:%=-ccopt -L%) $(EXTLIBDIRS:%=-ccopt -L%) \ 588 | $(EXTLIBDIRS:%=-ccopt -Wl $(OCAML_DEFAULT_DIRS:%=-ccopt -L%)) 589 | 590 | ifeq ($(ELF_RPATH),yes) 591 | COMMON_LDFLAGS += $(EXTLIBDIRS:%=-ccopt -Wl,$(RPATH_FLAG)%) 592 | endif 593 | else 594 | COMMON_LDFLAGS := -ccopt "/link -NODEFAULTLIB:LIBC $(LDFLAGS:%=%) $(SOURCE_DIRS:%=-LIBPATH:%) \ 595 | $(LIBDIRS:%=-LIBPATH:%) $(EXTLIBDIRS:%=-LIBPATH:%) \ 596 | $(OCAML_DEFAULT_DIRS:%=-LIBPATH:%) " 597 | endif 598 | 599 | CLIBS_OPTS := $(CLIBS:%=-cclib -l%) $(CFRAMEWORKS:%=-cclib '-framework %') 600 | ifdef MSVC 601 | ifndef STATIC 602 | # MSVC libraries do not have 'lib' prefix 603 | CLIBS_OPTS := $(CLIBS:%=-cclib %.lib) 604 | endif 605 | endif 606 | 607 | ifneq ($(strip $(OBJ_LINK)),) 608 | ifdef CREATE_LIB 609 | OBJS_LIBS := -cclib -l$(CLIB_BASE) $(CLIBS_OPTS) $(MAYBE_IDL) 610 | else 611 | OBJS_LIBS := $(OBJ_LINK) $(CLIBS_OPTS) $(MAYBE_IDL) 612 | endif 613 | else 614 | OBJS_LIBS := $(CLIBS_OPTS) $(MAYBE_IDL) 615 | endif 616 | 617 | ifdef LIB_PACK_NAME 618 | FOR_PACK_NAME := $(shell echo $(LIB_PACK_NAME) | awk '{print toupper(substr($$0,1,1))substr($$0,2)}') 619 | endif 620 | 621 | # If we have to make byte-code 622 | ifndef REAL_OCAMLC 623 | BYTE_OCAML := y 624 | 625 | # EXTRADEPS is added dependencies we have to insert for all 626 | # executable files we generate. Ideally it should be all of the 627 | # libraries we use, but it's hard to find the ones that get searched on 628 | # the path since I don't know the paths built into the compiler, so 629 | # just include the ones with slashes in their names. 630 | EXTRADEPS := $(addsuffix .cma,$(foreach i,$(LIBS),$(if $(findstring /,$(i)),$(i)))) 631 | 632 | 633 | ifndef LIB_PACK_NAME 634 | SPECIAL_OCAMLFLAGS := $(OCAMLBCFLAGS) 635 | else 636 | SPECIAL_OCAMLFLAGS := -for-pack $(FOR_PACK_NAME) $(OCAMLBCFLAGS) 637 | endif 638 | 639 | REAL_OCAMLC := $(INTF_OCAMLC) 640 | 641 | REAL_IMPL := $(IMPL_CMO) 642 | REAL_IMPL_INTF := $(IMPLO_INTF) 643 | IMPL_SUF := .cmo 644 | 645 | DEPFLAGS := 646 | MAKE_DEPS := $(MLDEPS) $(BCDEPIS) 647 | 648 | ifdef CREATE_LIB 649 | override CFLAGS := $(PIC_CFLAGS) $(CFLAGS) 650 | override CPPFLAGS := $(PIC_CPPFLAGS) $(CPPFLAGS) 651 | ifndef STATIC 652 | ifneq ($(strip $(OBJ_LINK)),) 653 | MAKEDLL := $(DLLSONAME) 654 | ALL_LDFLAGS := -dllib $(DLLSONAME) 655 | endif 656 | endif 657 | endif 658 | 659 | ifndef NO_CUSTOM 660 | ifneq "$(strip $(OBJ_LINK) $(THREADS) $(MAYBE_IDL) $(CLIBS) $(CFRAMEWORKS))" "" 661 | ALL_LDFLAGS += -custom 662 | endif 663 | endif 664 | 665 | ALL_LDFLAGS += $(INCFLAGS) $(OCAMLLDFLAGS) $(OCAMLBLDFLAGS) \ 666 | $(COMMON_LDFLAGS) $(LIBS:%=%.cma) 667 | CAMLIDLDLLFLAGS := 668 | 669 | ifdef THREADS 670 | ifdef VMTHREADS 671 | THREAD_FLAG := -vmthread 672 | else 673 | THREAD_FLAG := -thread 674 | endif 675 | ALL_LDFLAGS := $(THREAD_FLAG) $(ALL_LDFLAGS) 676 | ifndef CREATE_LIB 677 | ifndef REAL_OCAMLFIND 678 | ALL_LDFLAGS := unix.cma threads.cma $(ALL_LDFLAGS) 679 | endif 680 | endif 681 | endif 682 | 683 | # we have to make native-code 684 | else 685 | EXTRADEPS := $(addsuffix .cmxa,$(foreach i,$(LIBS),$(if $(findstring /,$(i)),$(i)))) 686 | ifndef PROFILING 687 | SPECIAL_OCAMLFLAGS := $(OCAMLNCFLAGS) 688 | PLDFLAGS := 689 | else 690 | SPECIAL_OCAMLFLAGS := -p $(OCAMLNCFLAGS) 691 | PLDFLAGS := -p 692 | endif 693 | 694 | ifndef LIB_PACK_NAME 695 | SPECIAL_OCAMLFLAGS := $(OCAMLNCFLAGS) 696 | else 697 | SPECIAL_OCAMLFLAGS := -for-pack $(FOR_PACK_NAME) $(OCAMLNCFLAGS) 698 | endif 699 | REAL_IMPL := $(IMPL_CMX) 700 | REAL_IMPL_INTF := $(IMPLX_INTF) 701 | IMPL_SUF := .cmx 702 | 703 | override CPPFLAGS := -DNATIVE_CODE $(CPPFLAGS) 704 | 705 | DEPFLAGS := -native 706 | MAKE_DEPS := $(MLDEPS) $(NCDEPIS) 707 | 708 | ALL_LDFLAGS := $(PLDFLAGS) $(INCFLAGS) $(OCAMLLDFLAGS) \ 709 | $(OCAMLNLDFLAGS) $(COMMON_LDFLAGS) 710 | CAMLIDLDLLFLAGS := -opt 711 | 712 | ifndef CREATE_LIB 713 | ALL_LDFLAGS += $(LIBS:%=%.cmxa) 714 | else 715 | override CFLAGS := $(PIC_CFLAGS) $(CFLAGS) 716 | override CPPFLAGS := $(PIC_CPPFLAGS) $(CPPFLAGS) 717 | endif 718 | 719 | ifdef THREADS 720 | THREAD_FLAG := -thread 721 | ALL_LDFLAGS := $(THREAD_FLAG) $(ALL_LDFLAGS) 722 | ifndef CREATE_LIB 723 | ifndef REAL_OCAMLFIND 724 | ALL_LDFLAGS := unix.cmxa threads.cmxa $(ALL_LDFLAGS) 725 | endif 726 | endif 727 | endif 728 | endif 729 | 730 | export MAKE_DEPS 731 | 732 | ifdef ANNOTATE 733 | ANNOT_FLAG := -bin-annot 734 | else 735 | endif 736 | 737 | ALL_OCAMLCFLAGS := $(THREAD_FLAG) $(ANNOT_FLAG) $(OCAMLFLAGS) \ 738 | $(INCFLAGS) $(SPECIAL_OCAMLFLAGS) 739 | 740 | ifdef make_deps 741 | -include $(MAKE_DEPS) 742 | PRE_TARGETS := 743 | endif 744 | 745 | ########################################################################### 746 | # USER RULES 747 | 748 | # Call "OCamlMakefile QUIET=" to get rid of all of the @'s. 749 | QUIET=@ 750 | 751 | # generates byte-code (default) 752 | byte-code: $(PRE_TARGETS) 753 | $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT) \ 754 | REAL_RESULT="$(BCRESULT)" make_deps=yes 755 | bc: byte-code 756 | 757 | byte-code-nolink: $(PRE_TARGETS) 758 | $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) nolink \ 759 | REAL_RESULT="$(BCRESULT)" make_deps=yes 760 | bcnl: byte-code-nolink 761 | 762 | top: $(PRE_TARGETS) 763 | $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(TOPRESULT) \ 764 | REAL_RESULT="$(BCRESULT)" make_deps=yes 765 | 766 | # generates native-code 767 | 768 | native-code: $(PRE_TARGETS) 769 | $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(NCRESULT) \ 770 | REAL_RESULT="$(NCRESULT)" \ 771 | REAL_OCAMLC="$(OCAMLOPT)" \ 772 | make_deps=yes 773 | nc: native-code 774 | 775 | native-code-nolink: $(PRE_TARGETS) 776 | $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) nolink \ 777 | REAL_RESULT="$(NCRESULT)" \ 778 | REAL_OCAMLC="$(OCAMLOPT)" \ 779 | make_deps=yes 780 | ncnl: native-code-nolink 781 | 782 | # generates byte-code libraries 783 | byte-code-library: $(PRE_TARGETS) 784 | $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ 785 | $(RES_CLIB) $(BCRESULT).cma \ 786 | REAL_RESULT="$(BCRESULT)" \ 787 | CREATE_LIB=yes \ 788 | make_deps=yes 789 | bcl: byte-code-library 790 | 791 | # generates native-code libraries 792 | native-code-library: $(PRE_TARGETS) 793 | $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ 794 | $(RES_CLIB) $(NCRESULT).cmxa \ 795 | REAL_RESULT="$(NCRESULT)" \ 796 | REAL_OCAMLC="$(OCAMLOPT)" \ 797 | CREATE_LIB=yes \ 798 | make_deps=yes 799 | ncl: native-code-library 800 | 801 | ifdef WIN32 802 | # generates byte-code dll 803 | byte-code-dll: $(PRE_TARGETS) 804 | $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ 805 | $(RES_CLIB) $(BCRESULT).dll \ 806 | REAL_RESULT="$(BCRESULT)" \ 807 | make_deps=yes 808 | bcd: byte-code-dll 809 | 810 | # generates native-code dll 811 | native-code-dll: $(PRE_TARGETS) 812 | $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ 813 | $(RES_CLIB) $(NCRESULT).dll \ 814 | REAL_RESULT="$(NCRESULT)" \ 815 | REAL_OCAMLC="$(OCAMLOPT)" \ 816 | make_deps=yes 817 | ncd: native-code-dll 818 | endif 819 | 820 | # generates byte-code with debugging information 821 | debug-code: $(PRE_TARGETS) 822 | $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT) \ 823 | REAL_RESULT="$(BCRESULT)" make_deps=yes \ 824 | OCAMLFLAGS="-g $(OCAMLFLAGS)" \ 825 | OCAMLLDFLAGS="-g $(OCAMLLDFLAGS)" 826 | dc: debug-code 827 | 828 | debug-code-nolink: $(PRE_TARGETS) 829 | $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) nolink \ 830 | REAL_RESULT="$(BCRESULT)" make_deps=yes \ 831 | OCAMLFLAGS="-g $(OCAMLFLAGS)" \ 832 | OCAMLLDFLAGS="-g $(OCAMLLDFLAGS)" 833 | dcnl: debug-code-nolink 834 | 835 | # generates byte-code with debugging information (native code) 836 | debug-native-code: $(PRE_TARGETS) 837 | $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(NCRESULT) \ 838 | REAL_RESULT="$(NCRESULT)" make_deps=yes \ 839 | REAL_OCAMLC="$(OCAMLOPT)" \ 840 | OCAMLFLAGS="-g $(OCAMLFLAGS)" \ 841 | OCAMLLDFLAGS="-g $(OCAMLLDFLAGS)" 842 | dnc: debug-native-code 843 | 844 | debug-native-code-nolink: $(PRE_TARGETS) 845 | $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) nolink \ 846 | REAL_RESULT="$(NCRESULT)" make_deps=yes \ 847 | REAL_OCAMLC="$(OCAMLOPT)" \ 848 | OCAMLFLAGS="-g $(OCAMLFLAGS)" \ 849 | OCAMLLDFLAGS="-g $(OCAMLLDFLAGS)" 850 | dncnl: debug-native-code-nolink 851 | 852 | # generates byte-code libraries with debugging information 853 | debug-code-library: $(PRE_TARGETS) 854 | $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ 855 | $(RES_CLIB) $(BCRESULT).cma \ 856 | REAL_RESULT="$(BCRESULT)" make_deps=yes \ 857 | CREATE_LIB=yes \ 858 | OCAMLFLAGS="-g $(OCAMLFLAGS)" \ 859 | OCAMLLDFLAGS="-g $(OCAMLLDFLAGS)" 860 | dcl: debug-code-library 861 | 862 | # generates byte-code libraries with debugging information (native code) 863 | debug-native-code-library: $(PRE_TARGETS) 864 | $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ 865 | $(RES_CLIB) $(NCRESULT).cmxa \ 866 | REAL_RESULT="$(NCRESULT)" make_deps=yes \ 867 | REAL_OCAMLC="$(OCAMLOPT)" \ 868 | CREATE_LIB=yes \ 869 | OCAMLFLAGS="-g $(OCAMLFLAGS)" \ 870 | OCAMLLDFLAGS="-g $(OCAMLLDFLAGS)" 871 | dncl: debug-native-code-library 872 | 873 | # generates byte-code for profiling 874 | profiling-byte-code: $(PRE_TARGETS) 875 | $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT) \ 876 | REAL_RESULT="$(BCRESULT)" PROFILING="y" \ 877 | make_deps=yes 878 | pbc: profiling-byte-code 879 | 880 | # generates native-code 881 | 882 | profiling-native-code: $(PRE_TARGETS) 883 | $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(NCRESULT) \ 884 | REAL_RESULT="$(NCRESULT)" \ 885 | REAL_OCAMLC="$(OCAMLOPT)" \ 886 | PROFILING="y" \ 887 | make_deps=yes 888 | pnc: profiling-native-code 889 | 890 | # generates byte-code libraries 891 | profiling-byte-code-library: $(PRE_TARGETS) 892 | $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ 893 | $(RES_CLIB) $(BCRESULT).cma \ 894 | REAL_RESULT="$(BCRESULT)" PROFILING="y" \ 895 | CREATE_LIB=yes \ 896 | make_deps=yes 897 | pbcl: profiling-byte-code-library 898 | 899 | # generates native-code libraries 900 | profiling-native-code-library: $(PRE_TARGETS) 901 | $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ 902 | $(RES_CLIB) $(NCRESULT).cmxa \ 903 | REAL_RESULT="$(NCRESULT)" PROFILING="y" \ 904 | REAL_OCAMLC="$(OCAMLOPT)" \ 905 | CREATE_LIB=yes \ 906 | make_deps=yes 907 | pncl: profiling-native-code-library 908 | 909 | # packs byte-code objects 910 | pack-byte-code: $(PRE_TARGETS) 911 | $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT).cmo \ 912 | REAL_RESULT="$(BCRESULT)" \ 913 | PACK_LIB=yes make_deps=yes 914 | pabc: pack-byte-code 915 | 916 | # packs native-code objects 917 | pack-native-code: $(PRE_TARGETS) 918 | $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ 919 | $(NCRESULT).cmx $(NCRESULT).$(EXT_OBJ) \ 920 | REAL_RESULT="$(NCRESULT)" \ 921 | REAL_OCAMLC="$(OCAMLOPT)" \ 922 | PACK_LIB=yes make_deps=yes 923 | panc: pack-native-code 924 | 925 | # generates HTML-documentation 926 | htdoc: $(DOC_DIR)/$(RESULT)/html/index.html 927 | 928 | # generates Latex-documentation 929 | ladoc: $(DOC_DIR)/$(RESULT)/latex/doc.tex 930 | 931 | # generates PostScript-documentation 932 | psdoc: $(DOC_DIR)/$(RESULT)/latex/doc.ps 933 | 934 | # generates PDF-documentation 935 | pdfdoc: $(DOC_DIR)/$(RESULT)/latex/doc.pdf 936 | 937 | # generates all supported forms of documentation 938 | doc: htdoc ladoc psdoc pdfdoc 939 | 940 | ########################################################################### 941 | # LOW LEVEL RULES 942 | 943 | $(REAL_RESULT): $(REAL_IMPL_INTF) $(OBJ_LINK) $(EXTRADEPS) $(RESULTDEPS) 944 | $(REAL_OCAMLFIND) $(REAL_OCAMLC) \ 945 | $(OCAML_FIND_PACKAGES) $(OCAML_FIND_LINKPKG) \ 946 | $(OBJS_LIBS) $(ALL_LDFLAGS) -o $@$(EXE) \ 947 | $(REAL_IMPL) 948 | 949 | nolink: $(REAL_IMPL_INTF) $(OBJ_LINK) 950 | 951 | ifdef WIN32 952 | $(REAL_RESULT).dll: $(REAL_IMPL_INTF) $(OBJ_LINK) 953 | $(CAMLIDLDLL) $(CAMLIDLDLLFLAGS) $(OBJ_LINK) $(CLIBS) \ 954 | -o $@ $(REAL_IMPL) 955 | endif 956 | 957 | %$(TOPSUFFIX): $(REAL_IMPL_INTF) $(OBJ_LINK) $(EXTRADEPS) 958 | $(REAL_OCAMLFIND) $(OCAMLMKTOP) \ 959 | $(OCAML_FIND_PACKAGES) $(OCAML_FIND_LINKPKG) \ 960 | $(OBJS_LIBS) $(ALL_LDFLAGS) -o $@$(EXE) \ 961 | $(REAL_IMPL) 962 | 963 | .SUFFIXES: .mli .ml .cmi .cmo .cmx .cma .cmxa .$(EXT_OBJ) \ 964 | .mly .di .d .$(EXT_LIB) .idl %.oxridl .c .m .$(EXT_CXX) .h .so \ 965 | .rep .zog .glade 966 | 967 | ifndef STATIC 968 | ifdef MINGW 969 | # From OCaml 3.11.0, ocamlmklib is available on windows 970 | OCAMLMLIB_EXISTS = $(shell which $(OCAMLMKLIB)) 971 | ifeq ($(strip $(OCAMLMLIB_EXISTS)),) 972 | $(DLLSONAME): $(OBJ_LINK) 973 | $(CC) $(CFLAGS) $(CFLAGS_WIN32) $(OBJ_LINK) -shared -o $@ \ 974 | $(wildcard $(foreach dir,$(LIBDIRS),$(CLIBS:%=$(dir)/lib%.a))) \ 975 | '$(OCAMLLIBPATH)/ocamlrun.a' \ 976 | -Wl,--whole-archive \ 977 | -Wl,--export-all-symbols \ 978 | -Wl,--allow-multiple-definition \ 979 | -Wl,--enable-auto-import 980 | else 981 | $(DLLSONAME): $(OBJ_LINK) 982 | $(OCAMLMKLIB) $(INCFLAGS) $(CLIBFLAGS) \ 983 | -o $(CLIB_BASE) $(OBJ_LINK) $(CLIBS:%=-l%) \ 984 | $(CFRAMEWORKS:%=-framework %) \ 985 | $(OCAMLMKLIB_FLAGS) 986 | endif 987 | else 988 | ifdef MSVC 989 | $(DLLSONAME): $(OBJ_LINK) 990 | link /NOLOGO /DLL /OUT:$@ $(OBJ_LINK) \ 991 | $(wildcard $(foreach dir,$(LIBDIRS),$(CLIBS:%=$(dir)/%.lib))) \ 992 | '$(OCAMLLIBPATH)/ocamlrun.lib' 993 | 994 | else 995 | $(DLLSONAME): $(OBJ_LINK) 996 | $(OCAMLMKLIB) $(INCFLAGS) $(CLIBFLAGS) \ 997 | -o $(CLIB_BASE) $(OBJ_LINK) $(CLIBS:%=-l%) $(CFRAMEWORKS:%=-framework %) \ 998 | $(OCAMLMKLIB_FLAGS) 999 | endif 1000 | endif 1001 | endif 1002 | 1003 | ifndef LIB_PACK_NAME 1004 | $(RESULT).cma: $(REAL_IMPL_INTF) $(MAKEDLL) $(EXTRADEPS) $(RESULTDEPS) 1005 | $(REAL_OCAMLFIND) $(REAL_OCAMLC) -a $(OBJS_LIBS) $(ALL_LDFLAGS) -o $@ $(REAL_IMPL) 1006 | 1007 | $(RESULT).cmxa $(RESULT).$(EXT_LIB): $(REAL_IMPL_INTF) $(EXTRADEPS) $(RESULTDEPS) 1008 | $(REAL_OCAMLFIND) $(OCAMLOPT) -a $(OBJS_LIBS) $(ALL_LDFLAGS) -o $@ $(REAL_IMPL) 1009 | else 1010 | # Packing a bytecode library 1011 | LIB_PACK_NAME_MLI = $(wildcard $(LIB_PACK_NAME).mli) 1012 | ifeq ($(LIB_PACK_NAME_MLI),) 1013 | LIB_PACK_NAME_CMI = $(LIB_PACK_NAME).cmi 1014 | else 1015 | # $(LIB_PACK_NAME).mli exists, it likely depends on other compiled interfaces 1016 | LIB_PACK_NAME_CMI = 1017 | $(LIB_PACK_NAME).cmi: $(REAL_IMPL_INTF) 1018 | endif 1019 | ifdef BYTE_OCAML 1020 | $(LIB_PACK_NAME_CMI) $(LIB_PACK_NAME).cmo: $(REAL_IMPL_INTF) 1021 | $(REAL_OCAMLFIND) $(REAL_OCAMLC) -pack -o $(LIB_PACK_NAME).cmo $(OCAMLLDFLAGS) $(REAL_IMPL) 1022 | # Packing into a unit which can be transformed into a library 1023 | # Remember the .ml's must have been compiled with -for-pack $(LIB_PACK_NAME) 1024 | else 1025 | $(LIB_PACK_NAME_CMI) $(LIB_PACK_NAME).cmx: $(REAL_IMPL_INTF) 1026 | $(REAL_OCAMLFIND) $(OCAMLOPT) -pack -o $(LIB_PACK_NAME).cmx $(OCAMLLDFLAGS) $(REAL_IMPL) 1027 | endif 1028 | 1029 | $(RESULT).cma: $(LIB_PACK_NAME).cmi $(LIB_PACK_NAME).cmo $(MAKEDLL) $(EXTRADEPS) $(RESULTDEPS) 1030 | $(REAL_OCAMLFIND) $(REAL_OCAMLC) -a $(OBJS_LIBS) $(ALL_LDFLAGS) -o $@ $(LIB_PACK_NAME).cmo 1031 | 1032 | $(RESULT).cmxa $(RESULT).$(EXT_LIB): $(LIB_PACK_NAME).cmi $(LIB_PACK_NAME).cmx $(EXTRADEPS) $(RESULTDEPS) 1033 | $(REAL_OCAMLFIND) $(OCAMLOPT) -a $(OBJS_LIBS) $(filter-out -custom, $(ALL_LDFLAGS)) -o $@ $(LIB_PACK_NAME).cmx 1034 | endif 1035 | 1036 | $(RES_CLIB): $(OBJ_LINK) 1037 | ifndef MSVC 1038 | ifneq ($(strip $(OBJ_LINK)),) 1039 | $(AR) rcs $@ $(OBJ_LINK) 1040 | endif 1041 | else 1042 | ifneq ($(strip $(OBJ_LINK)),) 1043 | lib -nologo -debugtype:cv -out:$(RES_CLIB) $(OBJ_LINK) 1044 | endif 1045 | endif 1046 | 1047 | %.cmi: %.mli $(EXTRADEPS) 1048 | $(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \ 1049 | if [ -z "$$pp" ]; then \ 1050 | $(ECHO) $(REAL_OCAMLFIND) $(INTF_OCAMLC) $(OCAML_FIND_PACKAGES) \ 1051 | -c $(THREAD_FLAG) $(ANNOT_FLAG) \ 1052 | $(OCAMLFLAGS) $(INCFLAGS) $<; \ 1053 | $(REAL_OCAMLFIND) $(INTF_OCAMLC) $(OCAML_FIND_PACKAGES) \ 1054 | -c $(THREAD_FLAG) $(ANNOT_FLAG) \ 1055 | $(OCAMLFLAGS) $(INCFLAGS) $<; \ 1056 | else \ 1057 | $(ECHO) $(REAL_OCAMLFIND) $(INTF_OCAMLC) $(OCAML_FIND_PACKAGES) \ 1058 | -c -pp \"$$pp $(PPFLAGS)\" $(THREAD_FLAG) $(ANNOT_FLAG) \ 1059 | $(OCAMLFLAGS) $(INCFLAGS) $<; \ 1060 | $(REAL_OCAMLFIND) $(INTF_OCAMLC) $(OCAML_FIND_PACKAGES) \ 1061 | -c -pp "$$pp $(PPFLAGS)" $(THREAD_FLAG) $(ANNOT_FLAG) \ 1062 | $(OCAMLFLAGS) $(INCFLAGS) $<; \ 1063 | fi 1064 | 1065 | %.cmi: %$(IMPL_SUF); 1066 | 1067 | %$(IMPL_SUF) %.$(EXT_OBJ): %.ml $(EXTRADEPS) 1068 | $(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \ 1069 | if [ -z "$$pp" ]; then \ 1070 | $(ECHO) $(REAL_OCAMLFIND) $(REAL_OCAMLC) $(OCAML_FIND_PACKAGES) \ 1071 | -c $(ALL_OCAMLCFLAGS) $<; \ 1072 | $(REAL_OCAMLFIND) $(REAL_OCAMLC) $(OCAML_FIND_PACKAGES) \ 1073 | -c $(ALL_OCAMLCFLAGS) $<; \ 1074 | else \ 1075 | $(ECHO) $(REAL_OCAMLFIND) $(REAL_OCAMLC) $(OCAML_FIND_PACKAGES) \ 1076 | -c -pp \"$$pp $(PPFLAGS)\" $(ALL_OCAMLCFLAGS) $<; \ 1077 | $(REAL_OCAMLFIND) $(REAL_OCAMLC) $(OCAML_FIND_PACKAGES) \ 1078 | -c -pp "$$pp $(PPFLAGS)" $(ALL_OCAMLCFLAGS) $<; \ 1079 | fi 1080 | 1081 | .PRECIOUS: %.ml 1082 | %.ml: %.mll 1083 | $(OCAMLLEX) $(LFLAGS) $< 1084 | 1085 | .PRECIOUS: %.ml %.mli 1086 | %.ml %.mli: %.mly 1087 | $(OCAMLYACC) $(YFLAGS) $< 1088 | $(QUIET)pp=`sed -n -e 's/.*(\*pp \([^*]*\) \*).*/\1/p;q' $<`; \ 1089 | if [ ! -z "$$pp" ]; then \ 1090 | mv $*.ml $*.ml.temporary; \ 1091 | echo "(*pp $$pp $(PPFLAGS)*)" > $*.ml; \ 1092 | cat $*.ml.temporary >> $*.ml; \ 1093 | rm $*.ml.temporary; \ 1094 | mv $*.mli $*.mli.temporary; \ 1095 | echo "(*pp $$pp $(PPFLAGS)*)" > $*.mli; \ 1096 | cat $*.mli.temporary >> $*.mli; \ 1097 | rm $*.mli.temporary; \ 1098 | fi 1099 | 1100 | 1101 | .PRECIOUS: %.ml 1102 | %.ml: %.rep 1103 | $(CAMELEON_REPORT) $(CAMELEON_REPORT_FLAGS) -gen $< 1104 | 1105 | .PRECIOUS: %.ml 1106 | %.ml: %.zog 1107 | $(CAMELEON_ZOGGY) $(CAMELEON_ZOGGY_FLAGS) -impl $< > $@ 1108 | 1109 | .PRECIOUS: %.ml 1110 | %.ml: %.glade 1111 | $(OCAML_GLADECC) $(OCAML_GLADECC_FLAGS) $< > $@ 1112 | 1113 | .PRECIOUS: %.ml %.mli 1114 | %.ml %.mli: %.oxridl 1115 | $(OXRIDL) $< 1116 | 1117 | .PRECIOUS: %.ml %.mli %_stubs.c %.h 1118 | %.ml %.mli %_stubs.c %.h: %.idl 1119 | $(CAMLIDL) $(MAYBE_IDL_HEADER) $(IDLFLAGS) \ 1120 | $(CAMLIDLFLAGS) $< 1121 | $(QUIET)if [ $(NOIDLHEADER) ]; then touch $*.h; fi 1122 | 1123 | %.$(EXT_OBJ): %.c 1124 | $(OCAMLC) -c -cc "$(CC)" -ccopt "$(CFLAGS) \ 1125 | $(CPPFLAGS) $(CPPFLAGS_WIN32) \ 1126 | $(CFLAGS_WIN32) $(CINCFLAGS) $(CFLAG_O)$@ " $< 1127 | 1128 | %.$(EXT_OBJ): %.m 1129 | $(CC) -c $(CFLAGS) $(CINCFLAGS) $(CPPFLAGS) \ 1130 | -I'$(OCAMLLIBPATH)' \ 1131 | $< $(CFLAG_O)$@ 1132 | 1133 | %.$(EXT_OBJ): %.$(EXT_CXX) 1134 | $(CXX) -c $(CXXFLAGS) $(CINCFLAGS) $(CPPFLAGS) \ 1135 | -I'$(OCAMLLIBPATH)' \ 1136 | $< $(CFLAG_O)$@ 1137 | 1138 | $(MLDEPDIR)/%.d: %.ml 1139 | $(QUIET)if [ ! -d $(@D) ]; then mkdir -p $(@D); fi 1140 | $(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \ 1141 | if [ -z "$$pp" ]; then \ 1142 | $(ECHO) $(REAL_OCAMLFIND) $(OCAMLDEP) $(OCAML_DEP_PACKAGES) \ 1143 | $(INCFLAGS) $< \> $@; \ 1144 | $(REAL_OCAMLFIND) $(OCAMLDEP) $(OCAML_DEP_PACKAGES) \ 1145 | $(INCFLAGS) $< > $@; \ 1146 | else \ 1147 | $(ECHO) $(REAL_OCAMLFIND) $(OCAMLDEP) $(OCAML_DEP_PACKAGES) \ 1148 | -pp \"$$pp $(PPFLAGS)\" $(INCFLAGS) $< \> $@; \ 1149 | $(REAL_OCAMLFIND) $(OCAMLDEP) $(OCAML_DEP_PACKAGES) \ 1150 | -pp "$$pp $(PPFLAGS)" $(INCFLAGS) $< > $@; \ 1151 | fi 1152 | 1153 | $(BCDIDIR)/%.di $(NCDIDIR)/%.di: %.mli 1154 | $(QUIET)if [ ! -d $(@D) ]; then mkdir -p $(@D); fi 1155 | $(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \ 1156 | if [ -z "$$pp" ]; then \ 1157 | $(ECHO) $(REAL_OCAMLFIND) $(OCAMLDEP) $(DEPFLAGS) $(INCFLAGS) $< \> $@; \ 1158 | $(REAL_OCAMLFIND) $(OCAMLDEP) $(DEPFLAGS) $(INCFLAGS) $< > $@; \ 1159 | else \ 1160 | $(ECHO) $(REAL_OCAMLFIND) $(OCAMLDEP) $(DEPFLAGS) \ 1161 | -pp \"$$pp $(PPFLAGS)\" $(INCFLAGS) $< \> $@; \ 1162 | $(REAL_OCAMLFIND) $(OCAMLDEP) $(DEPFLAGS) \ 1163 | -pp "$$pp $(PPFLAGS)" $(INCFLAGS) $< > $@; \ 1164 | fi 1165 | 1166 | $(DOC_DIR)/$(RESULT)/html: 1167 | mkdir -p $@ 1168 | 1169 | $(DOC_DIR)/$(RESULT)/html/index.html: $(DOC_DIR)/$(RESULT)/html $(DOC_FILES) 1170 | rm -rf $