mbarbin / fingerboard / 118

Committed 23 Dec 2025 10:30PM UTC coverage: 92.134% (-3.0%) from 95.087%

Build # 118

Build Type

Pull #11

github

Committed by

web-flow

Commit Message

Merge b17e74f06 into ccb9da732

Pull Request Pull Request #11: Reduce deps

Run Details

323 of 528 new or added lines in 29 files covered. (61.17%)

1 existing line in 1 file now uncovered.

3830 of 4157 relevant lines covered (92.13%)

20265.99 hits per line

Source File
Press 'n' to go to next uncovered line, 'b' for previous

94.5

/src/interval.ml

(**********************************************************************************)
(*  Fingerboard - a microtonal geography of the cello fingerboard                 *)
(*  Copyright (C) 2022-2024 Mathieu Barbin <mathieu.barbin@gmail.com>             *)
(*                                                                                *)
(*  This file is part of Fingerboard.                                             *)
(*                                                                                *)
(*  Fingerboard is free software: you can redistribute it and/or modify it under  *)
(*  the terms of the GNU Affero General Public License as published by the Free   *)
(*  Software Foundation, either version 3 of the License, or any later version.   *)
(*                                                                                *)
(*  Fingerboard is distributed in the hope that it will be useful, but WITHOUT    *)
(*  ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or         *)
(*  FITNESS FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License   *)
(*  for more details.                                                             *)
(*                                                                                *)
(*  You should have received a copy of the GNU Affero General Public License      *)
(*  along with Fingerboard. If not, see <https://www.gnu.org/licenses/>.          *)
(**********************************************************************************)

let make_name constructor_name =
  constructor_name
  |> String.uncapitalize_ascii
  |> String.map ~f:(function
    | '_' -> ' '
    | c -> c)
;;

module Quality = struct
  type t =
    | Doubly_diminished
    | Diminished
    | Minor
    | Perfect
    | Major
    | Augmented
    | Doubly_augmented

  let all =
    [ Doubly_diminished; Diminished; Minor; Perfect; Major; Augmented; Doubly_augmented ]
  ;;

  let constructor_rank = function
    | Doubly_diminished -> 0
    | Diminished -> 1
    | Minor -> 2
    | Perfect -> 3
    | Major -> 4
    | Augmented -> 5
    | Doubly_augmented -> 6
  ;;

  let constructor_name = function
    | Doubly_diminished -> "Doubly_diminished"
    | Diminished -> "Diminished"
    | Minor -> "Minor"
    | Perfect -> "Perfect"
    | Major -> "Major"
    | Augmented -> "Augmented"
    | Doubly_augmented -> "Doubly_augmented"
  ;;

  let name t = make_name (constructor_name t)
  let compare t1 t2 = Int.compare (constructor_rank t1) (constructor_rank t2)
  let equal t1 t2 = Int.equal (constructor_rank t1) (constructor_rank t2)
  let to_dyn t = Dyn.Variant (constructor_name t, [])
  let repeat str ~times = String.concat (List.init times ~f:(Fun.const str)) ~sep:""

  let rec prefix_notation = function
    | Doubly_diminished -> repeat (prefix_notation Diminished) ~times:2
    | Diminished -> "d"
    | Minor -> "m"
    | Perfect -> "P"
    | Major -> "M"
    | Augmented -> "A"
    | Doubly_augmented -> repeat (prefix_notation Augmented) ~times:2
  ;;

  let succ t ~accepts_minor_major_quality =
    match t with
    | Doubly_diminished -> Some Diminished
    | Diminished -> Some (if accepts_minor_major_quality then Minor else Perfect)
    | Minor -> Some Major
    | Perfect -> Some Augmented
    | Major -> Some Augmented
    | Augmented -> Some Doubly_augmented
    | Doubly_augmented -> None
  ;;

  let pred t ~accepts_minor_major_quality =
    match t with
    | Doubly_diminished -> None
    | Diminished -> Some Doubly_diminished
    | Minor -> Some Diminished
    | Perfect -> Some Diminished
    | Major -> Some Minor
    | Augmented -> Some (if accepts_minor_major_quality then Major else Perfect)
    | Doubly_augmented -> Some Augmented
  ;;
end

module Number = struct
  type t =
    | Unison
    | Second
    | Third
    | Fourth
    | Fifth
    | Sixth
    | Seventh
    | Octave

  let all = [ Unison; Second; Third; Fourth; Fifth; Sixth; Seventh; Octave ]

  let constructor_rank = function
    | Unison -> 0
    | Second -> 1
    | Third -> 2
    | Fourth -> 3
    | Fifth -> 4
    | Sixth -> 5
    | Seventh -> 6
    | Octave -> 7
  ;;

  let constructor_name = function
    | Unison -> "Unison"
    | Second -> "Second"
    | Third -> "Third"
    | Fourth -> "Fourth"
    | Fifth -> "Fifth"
    | Sixth -> "Sixth"
    | Seventh -> "Seventh"
    | Octave -> "Octave"
  ;;

  let name t = make_name (constructor_name t)
  let compare t1 t2 = Int.compare (constructor_rank t1) (constructor_rank t2)
  let equal t1 t2 = Int.equal (constructor_rank t1) (constructor_rank t2)
  let to_dyn t = Dyn.Variant (constructor_name t, [])
  let to_int t = 1 + constructor_rank t

  let of_int i =
    List.nth_opt all (i - 1)
    |> function
    | Some t -> t
    | None -> Code_error.raise "Index out of bounds." [ "i", i |> Dyn.int ]
  ;;

  let accepts_minor_major_quality = function
    | Unison | Fourth | Fifth | Octave -> false
    | Second | Third | Sixth | Seventh -> true
  ;;

  let basis_for_number_of_semitons = function
    | Unison -> 0
    | Second -> 2
    | Third -> 4
    | Fourth -> 5
    | Fifth -> 7
    | Sixth -> 9
    | Seventh -> 11
    | Octave -> 12
  ;;
end

type t =
  { number : Number.t
  ; quality : Quality.t
  ; additional_octaves : int
  }

let hash (t : t) = Hashtbl.hash t

let equal t ({ number; quality; additional_octaves } as t2) =
  phys_equal t t2
  || (Number.equal t.number number
      && Quality.equal t.quality quality
      && Int.equal t.additional_octaves additional_octaves)
;;

let compare t ({ number; quality; additional_octaves } as t2) : Ordering.t =
  if phys_equal t t2
  then Eq
  else (
    match Number.compare t.number number with
    | (Lt | Gt) as r -> r
    | Eq ->
      (match Quality.compare t.quality quality with
       | (Lt | Gt) as r -> r
       | Eq -> Int.compare t.additional_octaves additional_octaves))
;;

let to_dyn { number; quality; additional_octaves } =
  Dyn.record
    [ "number", number |> Number.to_dyn
    ; "quality", quality |> Quality.to_dyn
    ; "additional_octaves", additional_octaves |> Dyn.int
    ]
;;

let to_string { number; quality; additional_octaves } =
  let skip_quality =
    match quality with
    | Perfect -> true
    | Doubly_diminished | Diminished | Minor | Major | Augmented | Doubly_augmented ->
      false
  in
  let skip_unison =
    Number.equal number Unison && skip_quality && additional_octaves >= 1
  in
  (if additional_octaves = 1
   then Printf.sprintf "P8%s" (if skip_unison then "" else " + ")
   else if additional_octaves >= 2
   then Printf.sprintf "%d P8%s" additional_octaves (if skip_unison then "" else " + ")
   else "")
  ^
  if skip_unison
  then ""
  else Quality.prefix_notation quality ^ (Number.to_int number |> Int.to_string)
;;

let name { number; quality; additional_octaves } =
  let skip_quality =
    match quality with
    | Perfect -> true
    | Doubly_diminished | Diminished | Minor | Major | Augmented | Doubly_augmented ->
      false
  in
  let skip_unison =
    Number.equal number Unison && skip_quality && additional_octaves >= 1
  in
  (if additional_octaves = 1
   then Printf.sprintf "octave%s" (if skip_unison then "" else " + ")
   else if additional_octaves >= 2
   then
     Printf.sprintf "%d octaves%s" additional_octaves (if skip_unison then "" else " + ")
   else "")
  ^ (if skip_quality then "" else Quality.name quality ^ " ")
  ^ if skip_unison then "" else Number.name number
;;

let number_of_semitons t =
  let accepts_minor_major_quality = Number.accepts_minor_major_quality t.number in
  let basis = Number.basis_for_number_of_semitons t.number in
  let shift =
    match t.quality with
    | Perfect -> 0
    | Major -> 0
    | Minor -> -1
    | Augmented -> 1
    | Diminished -> if accepts_minor_major_quality then -2 else -1
    | Doubly_augmented -> 2
    | Doubly_diminished -> if accepts_minor_major_quality then -3 else -2
  in
  (t.additional_octaves * 12) + basis + shift
;;

let compute ~(from : Note.t) ~(to_ : Note.t) () =
  let ( let* ) x f = Option.bind x ~f in
  let* number_of_letter_names, number_of_semitons =
    let rec aux number_of_letter_names number_of_semitons letter_name octave_designation =
      if octave_designation > to_.octave_designation
      then None
      else if
        Note.Letter_name.equal letter_name to_.letter_name
        && octave_designation = to_.octave_designation
      then
        Option.some
          ( number_of_letter_names
          , number_of_semitons
            - Note.Symbol.semitons_shift from.symbol
            + Note.Symbol.semitons_shift to_.symbol )
      else
        aux
          (Int.succ number_of_letter_names)
          (number_of_semitons + Note.Letter_name.semitons_step ~from:letter_name)
          (Note.Letter_name.succ letter_name)
          (Note.Letter_name.succ_octave_designation letter_name ~octave_designation)
    in
    aux 0 0 from.letter_name from.octave_designation
  in
  let number_of_letter_names, number_of_semitons, additional_octaves =
    if number_of_letter_names >= 7 && number_of_semitons >= 12
    then (
      let additional_octaves = number_of_letter_names / 7 in
      ( number_of_letter_names - (7 * additional_octaves)
      , number_of_semitons - (12 * additional_octaves)
      , additional_octaves ))
    else number_of_letter_names, number_of_semitons, 0
  in
  let* () =
    if number_of_semitons < 0 || number_of_letter_names > 7 then None else Option.some ()
  in
  let number = Number.of_int (number_of_letter_names + 1) in
  let basis = Number.basis_for_number_of_semitons number in
  let accepts_minor_major_quality = Number.accepts_minor_major_quality number in
  let basis_quality =
    if accepts_minor_major_quality then Quality.Major else Quality.Perfect
  in
  let* quality =
    let rec aux missing quality =
      if Int.equal missing 0
      then Option.some quality
      else if missing > 0
      then
        let* quality = Quality.succ quality ~accepts_minor_major_quality in
        aux (Int.pred missing) quality
      else
        let* quality = Quality.pred quality ~accepts_minor_major_quality in
        aux (Int.succ missing) quality
    in
    aux (number_of_semitons - basis) basis_quality
  in
  Option.some { number; quality; additional_octaves }
;;

let shift_up
      ({ number; quality = _; additional_octaves } as interval)
      ({ Note.letter_name; symbol = _; octave_designation } as from)
  =
  let ( let* ) x f = Option.bind x ~f in
  let step = Number.to_int number - 1 + (7 * additional_octaves) in
  let target =
    let rec aux step letter_name octave_designation =
      if step = 0
      then { Note.letter_name; symbol = from.symbol; octave_designation }
      else
        aux
          (Int.pred step)
          (Note.Letter_name.succ letter_name)
          (Note.Letter_name.succ_octave_designation letter_name ~octave_designation)
    in
    aux step letter_name octave_designation
  in
  let* candidate = compute ~from ~to_:target () in
  let semiton_shift = number_of_semitons interval - number_of_semitons candidate in
  let* symbol =
    let rec aux shift symbol =
      if shift = 0
      then Some symbol
      else if shift > 0
      then
        let* symbol = Note.Symbol.succ symbol in
        aux (Int.pred shift) symbol
      else
        let* symbol = Note.Symbol.pred symbol in
        aux (Int.succ shift) symbol
    in
    aux semiton_shift target.symbol
  in
  Option.some { target with symbol }
;;

let shift_down
      ({ number; quality = _; additional_octaves } as interval)
      ({ Note.letter_name; symbol = _; octave_designation } as to_)
  =
  let step = Number.to_int number - 1 + (7 * additional_octaves) in
  let target =
    let rec aux step letter_name octave_designation =
      if step = 0
      then { Note.letter_name; symbol = to_.symbol; octave_designation }
      else
        aux
          (Int.pred step)
          (Note.Letter_name.pred letter_name)
          (Note.Letter_name.pred_octave_designation letter_name ~octave_designation)
    in
    aux step letter_name octave_designation
  in
  let ( let* ) x f = Option.bind x ~f in
  let* candidate = compute ~from:target ~to_ () in
  let semiton_shift = number_of_semitons interval - number_of_semitons candidate in
  let* symbol =
    let rec aux shift symbol =
      if shift = 0
      then Some symbol
      else if shift > 0
      then
        let* symbol = Note.Symbol.pred symbol in
        aux (Int.pred shift) symbol
      else
        let* symbol = Note.Symbol.succ symbol in
        aux (Int.succ shift) symbol
    in
    aux semiton_shift target.symbol
  in
  Option.some { target with symbol }
;;

let unison = { number = Unison; quality = Perfect; additional_octaves = 0 }

1	(**********************************************************************************)
2	(* Fingerboard - a microtonal geography of the cello fingerboard *)
3	(* Copyright (C) 2022-2024 Mathieu Barbin <mathieu.barbin@gmail.com> *)
4	(* *)
5	(* This file is part of Fingerboard. *)
6	(* *)
7	(* Fingerboard is free software: you can redistribute it and/or modify it under *)
8	(* the terms of the GNU Affero General Public License as published by the Free *)
9	(* Software Foundation, either version 3 of the License, or any later version. *)
10	(* *)
11	(* Fingerboard is distributed in the hope that it will be useful, but WITHOUT *)
12	(* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or *)
13	(* FITNESS FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License *)
14	(* for more details. *)
15	(* *)
16	(* You should have received a copy of the GNU Affero General Public License *)
17	(* along with Fingerboard. If not, see <https://www.gnu.org/licenses/>. *)
18	(**********************************************************************************)
19
20	let make_name constructor_name =
21	constructor_name	325✔
22	\|> String.uncapitalize_ascii
23	\|> String.map ~f:(function	325✔
24	\| '_' -> ' '	50✔
25	\| c -> c)	2,509✔
26	;;
27
28	module Quality = struct
29	type t =
30	\| Doubly_diminished
31	\| Diminished
32	\| Minor
33	\| Perfect
34	\| Major
35	\| Augmented
36	\| Doubly_augmented
37
38	let all =
39	[ Doubly_diminished; Diminished; Minor; Perfect; Major; Augmented; Doubly_augmented ]
40	;;
41
42	let constructor_rank = function
43	\| Doubly_diminished -> 0	3,048✔
44	\| Diminished -> 1	4,442✔
45	\| Minor -> 2	3,191✔
46	\| Perfect -> 3	2,757✔
47	\| Major -> 4	3,290✔
48	\| Augmented -> 5	4,877✔
49	\| Doubly_augmented -> 6	4,421✔
50	;;
51
52	let constructor_name = function
53	\| Doubly_diminished -> "Doubly_diminished"	42✔
54	\| Diminished -> "Diminished"	50✔
55	\| Minor -> "Minor"	41✔
56	\| Perfect -> "Perfect"	57✔
57	\| Major -> "Major"	40✔
58	\| Augmented -> "Augmented"	58✔
59	\| Doubly_augmented -> "Doubly_augmented"	57✔
60	;;
61
62	let name t = make_name (constructor_name t)	153✔
63	let compare t1 t2 = Int.compare (constructor_rank t1) (constructor_rank t2)	60✔
64	let equal t1 t2 = Int.equal (constructor_rank t1) (constructor_rank t2)	12,953✔
65	let to_dyn t = Dyn.Variant (constructor_name t, [])	192✔
66	let repeat str ~times = String.concat (List.init times ~f:(Fun.const str)) ~sep:""	63✔
67
68	let rec prefix_notation = function
69	\| Doubly_diminished -> repeat (prefix_notation Diminished) ~times:2	27✔
70	\| Diminished -> "d"	59✔
71	\| Minor -> "m"	2,295✔
72	\| Perfect -> "P"	34✔
73	\| Major -> "M"	2,476✔
74	\| Augmented -> "A"	72✔
75	\| Doubly_augmented -> repeat (prefix_notation Augmented) ~times:2	36✔
76	;;
77
78	let succ t ~accepts_minor_major_quality =
79	match t with	17,919✔
80	\| Doubly_diminished -> Some Diminished	×
81	\| Diminished -> Some (if accepts_minor_major_quality then Minor else Perfect)	×
82	\| Minor -> Some Major	×
83	\| Perfect -> Some Augmented	4,449✔
84	\| Major -> Some Augmented	4,128✔
85	\| Augmented -> Some Doubly_augmented	5,640✔
86	\| Doubly_augmented -> None	3,702✔
87	;;
88
89	let pred t ~accepts_minor_major_quality =
90	match t with	27,220✔
91	\| Doubly_diminished -> None	2,258✔
92	\| Diminished -> Some Doubly_diminished	3,631✔
93	\| Minor -> Some Diminished	2,914✔
94	\| Perfect -> Some Diminished	3,064✔
95	\| Major -> Some Minor	15,353✔
96	\| Augmented -> Some (if accepts_minor_major_quality then Major else Perfect)	×
97	\| Doubly_augmented -> Some Augmented	×
98	;;
99	end
100
101	module Number = struct
102	type t =
103	\| Unison
104	\| Second
105	\| Third
106	\| Fourth
107	\| Fifth
108	\| Sixth
109	\| Seventh
110	\| Octave
111
112	let all = [ Unison; Second; Third; Fourth; Fifth; Sixth; Seventh; Octave ]
113
114	let constructor_rank = function
115	\| Unison -> 0	11,222✔
116	\| Second -> 1	19,749✔
117	\| Third -> 2	15,988✔
118	\| Fourth -> 3	9,652✔
119	\| Fifth -> 4	9,433✔
120	\| Sixth -> 5	14,012✔
121	\| Seventh -> 6	8,742✔
122	\| Octave -> 7	1,387✔
123	;;
124
125	let constructor_name = function
126	\| Unison -> "Unison"	23✔
127	\| Second -> "Second"	44✔
128	\| Third -> "Third"	53✔
129	\| Fourth -> "Fourth"	44✔
130	\| Fifth -> "Fifth"	88✔
131	\| Sixth -> "Sixth"	53✔
132	\| Seventh -> "Seventh"	51✔
133	\| Octave -> "Octave"	8✔
134	;;
135
136	let name t = make_name (constructor_name t)	172✔
137	let compare t1 t2 = Int.compare (constructor_rank t1) (constructor_rank t2)	170✔
138	let equal t1 t2 = Int.equal (constructor_rank t1) (constructor_rank t2)	23,519✔
139	let to_dyn t = Dyn.Variant (constructor_name t, [])	192✔
140	let to_int t = 1 + constructor_rank t	42,807✔
141
142	let of_int i =
143	List.nth_opt all (i - 1)	55,465✔
144	\|> function	55,465✔
145	\| Some t -> t	55,465✔
146	\| None -> Code_error.raise "Index out of bounds." [ "i", i \|> Dyn.int ]	×
147	;;
148
149	let accepts_minor_major_quality = function
150	\| Unison \| Fourth \| Fifth \| Octave -> false	1,204✔
151	\| Second \| Third \| Sixth \| Seventh -> true	12,532✔
152	;;
153
154	let basis_for_number_of_semitons = function
155	\| Unison -> 0	10,789✔
156	\| Second -> 2	41,428✔
157	\| Third -> 4	18,361✔
158	\| Fourth -> 5	13,683✔
159	\| Fifth -> 7	14,030✔
160	\| Sixth -> 9	15,702✔
161	\| Seventh -> 11	11,962✔
162	\| Octave -> 12	1,057✔
163	;;
164	end
165
166	type t =
167	{ number : Number.t
168	; quality : Quality.t
169	; additional_octaves : int
170	}
171
172	let hash (t : t) = Hashtbl.hash t	11,981✔
173
174	let equal t ({ number; quality; additional_octaves } as t2) =
NEW 175	phys_equal t t2	×
176	\|\| (Number.equal t.number number	18,402✔
177	&& Quality.equal t.quality quality	12,944✔
178	&& Int.equal t.additional_octaves additional_octaves)	11,689✔
179	;;
180
181	let compare t ({ number; quality; additional_octaves } as t2) : Ordering.t =
182	if phys_equal t t2	170✔
NEW 183	then Eq	×
184	else (	170✔
185	match Number.compare t.number number with
186	\| (Lt \| Gt) as r -> r	66✔
NEW 187	\| Eq ->	×
188	(match Quality.compare t.quality quality with
NEW 189	\| (Lt \| Gt) as r -> r	×
NEW 190	\| Eq -> Int.compare t.additional_octaves additional_octaves))	×
191	;;
192
193	let to_dyn { number; quality; additional_octaves } =
194	Dyn.record	192✔
195	[ "number", number \|> Number.to_dyn	192✔
196	; "quality", quality \|> Quality.to_dyn	192✔
197	; "additional_octaves", additional_octaves \|> Dyn.int	192✔
198	]
199	;;
200
201	let to_string { number; quality; additional_octaves } =
202	let skip_quality =	4,939✔
203	match quality with
204	\| Perfect -> true	37✔
205	\| Doubly_diminished \| Diminished \| Minor \| Major \| Augmented \| Doubly_augmented ->	27✔
206	false
207	in
208	let skip_unison =
209	Number.equal number Unison && skip_quality && additional_octaves >= 1	5✔
210	in
211	(if additional_octaves = 1
212	then Printf.sprintf "P8%s" (if skip_unison then "" else " + ")	1✔
213	else if additional_octaves >= 2	4,903✔
214	then Printf.sprintf "%d P8%s" additional_octaves (if skip_unison then "" else " + ")	2✔
215	else "")	4,831✔
216	^
217	if skip_unison
218	then ""	3✔
219	else Quality.prefix_notation quality ^ (Number.to_int number \|> Int.to_string)	4,936✔
220	;;
221
222	let name { number; quality; additional_octaves } =
223	let skip_quality =	178✔
224	match quality with
225	\| Perfect -> true	25✔
226	\| Doubly_diminished \| Diminished \| Minor \| Major \| Augmented \| Doubly_augmented ->	21✔
227	false
228	in
229	let skip_unison =
230	Number.equal number Unison && skip_quality && additional_octaves >= 1	9✔
231	in
232	(if additional_octaves = 1
233	then Printf.sprintf "octave%s" (if skip_unison then "" else " + ")	2✔
234	else if additional_octaves >= 2	140✔
235	then
236	Printf.sprintf "%d octaves%s" additional_octaves (if skip_unison then "" else " + ")	4✔
237	else "")	63✔
238	^ (if skip_quality then "" else Quality.name quality ^ " ")	25✔
239	^ if skip_unison then "" else Number.name number	6✔
240	;;
241
242	let number_of_semitons t =
243	let accepts_minor_major_quality = Number.accepts_minor_major_quality t.number in	71,547✔
244	let basis = Number.basis_for_number_of_semitons t.number in	71,547✔
245	let shift =	71,547✔
246	match t.quality with
247	\| Perfect -> 0	13,818✔
248	\| Major -> 0	27,083✔
249	\| Minor -> -1	14,285✔
250	\| Augmented -> 1	5,284✔
251	\| Diminished -> if accepts_minor_major_quality then -2 else -1	1,938✔
252	\| Doubly_augmented -> 2	3,912✔
253	\| Doubly_diminished -> if accepts_minor_major_quality then -3 else -2	1,335✔
254	in
255	(t.additional_octaves * 12) + basis + shift
256	;;
257
258	let compute ~(from : Note.t) ~(to_ : Note.t) () =
259	let ( let* ) x f = Option.bind x ~f in	85,349✔
260	let* number_of_letter_names, number_of_semitons =
261	let rec aux number_of_letter_names number_of_semitons letter_name octave_designation =
262	if octave_designation > to_.octave_designation	522,467✔
263	then None	27,653✔
264	else if	494,814✔
265	Note.Letter_name.equal letter_name to_.letter_name	494,814✔
266	&& octave_designation = to_.octave_designation	96,694✔
267	then
268	Option.some	57,696✔
269	( number_of_letter_names
270	, number_of_semitons
271	- Note.Symbol.semitons_shift from.symbol	57,696✔
272	+ Note.Symbol.semitons_shift to_.symbol )	57,696✔
273	else
274	aux	437,118✔
275	(Int.succ number_of_letter_names)	437,118✔
276	(number_of_semitons + Note.Letter_name.semitons_step ~from:letter_name)
277	(Note.Letter_name.succ letter_name)	437,118✔
278	(Note.Letter_name.succ_octave_designation letter_name ~octave_designation)	437,118✔
279	in
280	aux 0 0 from.letter_name from.octave_designation	85,349✔
281	in
282	let number_of_letter_names, number_of_semitons, additional_octaves =	57,696✔
283	if number_of_letter_names >= 7 && number_of_semitons >= 12	24,979✔
284	then (	24,211✔
285	let additional_octaves = number_of_letter_names / 7 in
286	( number_of_letter_names - (7 * additional_octaves)
287	, number_of_semitons - (12 * additional_octaves)
288	, additional_octaves ))
289	else number_of_letter_names, number_of_semitons, 0	33,485✔
290	in
291	let* () =
292	if number_of_semitons < 0 \|\| number_of_letter_names > 7 then None else Option.some ()	327✔
293	in
294	let number = Number.of_int (number_of_letter_names + 1) in	55,465✔
295	let basis = Number.basis_for_number_of_semitons number in	55,465✔
296	let accepts_minor_major_quality = Number.accepts_minor_major_quality number in	55,465✔
297	let basis_quality =	55,465✔
298	if accepts_minor_major_quality then Quality.Major else Quality.Perfect	17,856✔
299	in
300	let* quality =
301	let rec aux missing quality =
302	if Int.equal missing 0	94,644✔
303	then Option.some quality	49,505✔
304	else if missing > 0	45,139✔
305	then
306	let* quality = Quality.succ quality ~accepts_minor_major_quality in	17,919✔
307	aux (Int.pred missing) quality	14,217✔
308	else
309	let* quality = Quality.pred quality ~accepts_minor_major_quality in	27,220✔
310	aux (Int.succ missing) quality	24,962✔
311	in
312	aux (number_of_semitons - basis) basis_quality	55,465✔
313	in
314	Option.some { number; quality; additional_octaves }	49,505✔
315	;;
316
317	let shift_up
318	({ number; quality = _; additional_octaves } as interval)
319	({ Note.letter_name; symbol = _; octave_designation } as from)
320	=
321	let ( let* ) x f = Option.bind x ~f in	20,094✔
322	let step = Number.to_int number - 1 + (7 * additional_octaves) in	20,094✔
323	let target =
324	let rec aux step letter_name octave_designation =
325	if step = 0	136,576✔
326	then { Note.letter_name; symbol = from.symbol; octave_designation }	20,094✔
327	else
328	aux	116,482✔
329	(Int.pred step)	116,482✔
330	(Note.Letter_name.succ letter_name)	116,482✔
331	(Note.Letter_name.succ_octave_designation letter_name ~octave_designation)	116,482✔
332	in
333	aux step letter_name octave_designation	20,094✔
334	in
335	let* candidate = compute ~from ~to_:target () in	20,094✔
336	let semiton_shift = number_of_semitons interval - number_of_semitons candidate in	20,094✔
337	let* symbol =
338	let rec aux shift symbol =
339	if shift = 0	37,615✔
340	then Some symbol	20,094✔
341	else if shift > 0	17,521✔
342	then
343	let* symbol = Note.Symbol.succ symbol in	9,351✔
344	aux (Int.pred shift) symbol	9,351✔
345	else
346	let* symbol = Note.Symbol.pred symbol in	8,170✔
347	aux (Int.succ shift) symbol	8,170✔
348	in
349	aux semiton_shift target.symbol	20,094✔
350	in
351	Option.some { target with symbol }	20,094✔
352	;;
353
354	let shift_down
355	({ number; quality = _; additional_octaves } as interval)
356	({ Note.letter_name; symbol = _; octave_designation } as to_)
357	=
358	let step = Number.to_int number - 1 + (7 * additional_octaves) in	12,481✔
359	let target =
360	let rec aux step letter_name octave_designation =
361	if step = 0	122,406✔
362	then { Note.letter_name; symbol = to_.symbol; octave_designation }	12,481✔
363	else
364	aux	109,925✔
365	(Int.pred step)	109,925✔
366	(Note.Letter_name.pred letter_name)	109,925✔
367	(Note.Letter_name.pred_octave_designation letter_name ~octave_designation)	109,925✔
368	in
369	aux step letter_name octave_designation	12,481✔
370	in
371	let ( let* ) x f = Option.bind x ~f in	39,252✔
372	let* candidate = compute ~from:target ~to_ () in	12,481✔
373	let semiton_shift = number_of_semitons interval - number_of_semitons candidate in	12,481✔
374	let* symbol =
375	let rec aux shift symbol =
376	if shift = 0	26,771✔
377	then Some symbol	12,481✔
378	else if shift > 0	14,290✔
379	then
380	let* symbol = Note.Symbol.pred symbol in	7,681✔
381	aux (Int.pred shift) symbol	7,681✔
382	else
383	let* symbol = Note.Symbol.succ symbol in	6,609✔
384	aux (Int.succ shift) symbol	6,609✔
385	in
386	aux semiton_shift target.symbol	12,481✔
387	in
388	Option.some { target with symbol }	12,481✔
389	;;
390
391	let unison = { number = Unison; quality = Perfect; additional_octaves = 0 }

mbarbin / fingerboard / 118

Source File Press 'n' to go to next uncovered line, 'b' for previous

Source File
Press 'n' to go to next uncovered line, 'b' for previous