1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
let syllables = [ ("do", 0); ("ut", 0); ("re", 2); ("ré", 2); ("mi", 4); ("fa", 5); ("sol", 7); ("la", 9); ("si", 11) ]
let split_syllable (word : string) : (int * string) option =
List.find_map
(fun (name, semitone) ->
let n = String.length name in
if String.length word >= n && String.lowercase_ascii (String.sub word 0 n) = name then
Some (semitone, String.sub word n (String.length word - n))
else None)
(List.sort (fun (a, _) (b, _) -> compare (String.length b) (String.length a)) syllables)
let fraction (s : string) : float option =
match String.split_on_char '/' s with
| [ a ] -> float_of_string_opt a
| [ a; b ] -> ( match (float_of_string_opt a, float_of_string_opt b) with Some a, Some b when b <> 0. -> Some (a /. b) | _ -> None)
| _ -> None
type voice = { mutable time : float; mutable events : Abc.event list }
let parse (text : string) : (Abc.tune, string) result =
let beat = ref 0.5 and octave = ref 4 in
let voices = ref [] and current = ref None in
let voice () =
match !current with
| Some v -> v
| None ->
let v = { time = 0.; events = [] } in
voices := !voices @ [ v ];
current := Some v;
v
in
let emit notes beats =
let v = voice () in
let length = beats *. !beat in
v.events <- { Abc.start = v.time; length; notes } :: v.events;
v.time <- v.time +. length
in
let with_length (word : string) : (string * float, string) result =
match String.index_opt word ':' with
| None -> Ok (word, 1.)
| Some i -> (
match fraction (String.sub word (i + 1) (String.length word - i - 1)) with
| Some beats -> Ok (String.sub word 0 i, beats)
| None -> Error ("not a length: " ^ word))
in
let error = ref None in
let rec words = function
| [] -> ()
| ("voix" | "voice") :: rest ->
current := None;
words rest
| "tempo" :: bpm :: rest ->
(match float_of_string_opt bpm with Some n when n > 0. -> beat := 60. /. n | _ -> error := Some ("not a tempo: " ^ bpm));
words rest
| "|" :: rest -> words rest
| word :: rest ->
(match with_length word with
| Error e -> error := Some e
| Ok ("-", beats) -> emit [] beats
| Ok (w, beats) -> (
match split_syllable w with
| None -> error := Some ("not a note: " ^ word)
| Some (semitone, tail) ->
let (accidental, tail) =
if tail <> "" && tail.[0] = '#' then (1, String.sub tail 1 (String.length tail - 1))
else if tail <> "" && tail.[0] = 'b' then (-1, String.sub tail 1 (String.length tail - 1))
else (0, tail)
in
if tail <> "" then (
match int_of_string_opt tail with
| Some o when o >= -1 && o <= 9 -> octave := o
| _ -> error := Some ("not an octave: " ^ word));
emit [ ((!octave + 1) * 12) + semitone + accidental ] beats));
if !error = None then words rest
in
String.split_on_char '\n' text
|> List.iter (fun line ->
let line = match String.index_opt line '%' with Some i -> String.sub line 0 i | None -> line in
if !error = None then
words (List.filter (( <> ) "") (String.split_on_char ' ' (String.map (fun c -> if c = '\t' then ' ' else c) line))));
match !error with
| Some e -> Error e
| None ->
let voices = List.map (fun v -> List.rev v.events) !voices in
if List.for_all (( = ) []) voices then Error "no notes"
else Ok { Abc.title = ""; voices; drums = List.map (fun _ -> false) voices }