mbarbin / fingerboard / 116

Committed 23 Dec 2025 04:57PM UTC coverage: 95.087% (-0.5%) from 95.592%

Build # 116

Build Type

push

github

Committed by

mbarbin

Commit Message

Use Code_error.raise

Run Details

40 of 84 new or added lines in 8 files covered. (47.62%)

77 existing lines in 10 files now uncovered.

3716 of 3908 relevant lines covered (95.09%)

18681.79 hits per line

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

96.43

/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
  |> Stdlib.String.uncapitalize_ascii
  |> String.map ~f:(function
    | '_' -> ' '
    | c -> c)
;;

module Quality = struct
  type t =
    | Doubly_diminished
    | Diminished
    | Minor
    | Perfect
    | Major
    | Augmented
    | Doubly_augmented
  [@@deriving compare, enumerate, equal, hash]

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

  let to_dyn t = Dyn.Variant (constructor_name t, [])
  let name t = make_name (constructor_name t)
  let repeat str ~times = String.concat (List.init times ~f:(Fn.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
  [@@deriving compare, enumerate, equal, hash]

  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 to_dyn t = Dyn.Variant (constructor_name t, [])
  let name t = make_name (constructor_name t)
  let to_int t = 1 + constructor_rank t

  let of_int i =
    List.nth 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
  }
[@@deriving compare, equal, hash]

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 open Option.Let_syntax in
  let%bind 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
        return
          ( 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%bind () =
    if number_of_semitons < 0 || number_of_letter_names > 7 then None else return ()
  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%map quality =
    let rec aux missing quality =
      if Int.equal missing 0
      then return quality
      else if missing > 0
      then (
        let%bind quality = Quality.succ quality ~accepts_minor_major_quality in
        aux (Int.pred missing) quality)
      else (
        let%bind quality = Quality.pred quality ~accepts_minor_major_quality in
        aux (Int.succ missing) quality)
    in
    aux (number_of_semitons - basis) basis_quality
  in
  { number; quality; additional_octaves }
;;

let shift_up
      ({ number; quality = _; additional_octaves } as interval)
      ({ Note.letter_name; symbol = _; octave_designation } as from)
  =
  let open Option.Let_syntax 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%bind candidate = compute ~from ~to_:target () in
  let semiton_shift = number_of_semitons interval - number_of_semitons candidate in
  let%map symbol =
    let rec aux shift symbol =
      if shift = 0
      then Some symbol
      else if shift > 0
      then (
        let%bind symbol = Note.Symbol.succ symbol in
        aux (Int.pred shift) symbol)
      else (
        let%bind symbol = Note.Symbol.pred symbol in
        aux (Int.succ shift) symbol)
    in
    aux semiton_shift target.symbol
  in
  { 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 open Option.Let_syntax in
  let%bind candidate = compute ~from:target ~to_ () in
  let semiton_shift = number_of_semitons interval - number_of_semitons candidate in
  let%map symbol =
    let rec aux shift symbol =
      if shift = 0
      then Some symbol
      else if shift > 0
      then (
        let%bind symbol = Note.Symbol.pred symbol in
        aux (Int.pred shift) symbol)
      else (
        let%bind symbol = Note.Symbol.succ symbol in
        aux (Int.succ shift) symbol)
    in
    aux semiton_shift target.symbol
  in
  { 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	\|> Stdlib.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 =	12,419✔
30	\| Doubly_diminished	1,418✔
31	\| Diminished	2,073✔
32	\| Minor	1,482✔
33	\| Perfect	1,308✔
34	\| Major	1,517✔
35	\| Augmented	2,428✔
36	\| Doubly_augmented	2,018✔
37	[@@deriving compare, enumerate, equal, hash]
38
39	let constructor_name = function
40	\| Doubly_diminished -> "Doubly_diminished"	42✔
41	\| Diminished -> "Diminished"	50✔
42	\| Minor -> "Minor"	41✔
43	\| Perfect -> "Perfect"	57✔
44	\| Major -> "Major"	40✔
45	\| Augmented -> "Augmented"	58✔
46	\| Doubly_augmented -> "Doubly_augmented"	57✔
47	;;
48
49	let to_dyn t = Dyn.Variant (constructor_name t, [])	192✔
50	let name t = make_name (constructor_name t)	153✔
51	let repeat str ~times = String.concat (List.init times ~f:(Fn.const str)) ~sep:""	63✔
52
53	let rec prefix_notation = function
54	\| Doubly_diminished -> repeat (prefix_notation Diminished) ~times:2	27✔
55	\| Diminished -> "d"	59✔
56	\| Minor -> "m"	2,295✔
57	\| Perfect -> "P"	34✔
58	\| Major -> "M"	2,476✔
59	\| Augmented -> "A"	72✔
60	\| Doubly_augmented -> repeat (prefix_notation Augmented) ~times:2	36✔
61	;;
62
63	let succ t ~accepts_minor_major_quality =
64	match t with	17,919✔
UNCOV 65	\| Doubly_diminished -> Some Diminished	×
66	\| Diminished -> Some (if accepts_minor_major_quality then Minor else Perfect)	×
67	\| Minor -> Some Major	×
68	\| Perfect -> Some Augmented	4,449✔
69	\| Major -> Some Augmented	4,128✔
70	\| Augmented -> Some Doubly_augmented	5,640✔
71	\| Doubly_augmented -> None	3,702✔
72	;;
73
74	let pred t ~accepts_minor_major_quality =
75	match t with	27,220✔
76	\| Doubly_diminished -> None	2,258✔
77	\| Diminished -> Some Doubly_diminished	3,631✔
78	\| Minor -> Some Diminished	2,914✔
79	\| Perfect -> Some Diminished	3,064✔
80	\| Major -> Some Minor	15,353✔
UNCOV 81	\| Augmented -> Some (if accepts_minor_major_quality then Major else Perfect)	×
82	\| Doubly_augmented -> Some Augmented	×
83	;;
84	end
85
86	module Number = struct
87	type t =	20,297✔
88	\| Unison	1,339✔
89	\| Second	1,980✔
90	\| Third	2,106✔
91	\| Fourth	1,720✔
92	\| Fifth	1,595✔
93	\| Sixth	1,698✔
94	\| Seventh	1,565✔
95	\| Octave	241✔
96	[@@deriving compare, enumerate, equal, hash]
97
98	let constructor_rank = function
99	\| Unison -> 0	2,576✔
100	\| Second -> 1	12,650✔
101	\| Third -> 2	7,052✔
102	\| Fourth -> 3	3,582✔
103	\| Fifth -> 4	3,794✔
104	\| Sixth -> 5	6,071✔
105	\| Seventh -> 6	3,256✔
106	\| Octave -> 7	515✔
107	;;
108
109	let constructor_name = function
110	\| Unison -> "Unison"	23✔
111	\| Second -> "Second"	44✔
112	\| Third -> "Third"	53✔
113	\| Fourth -> "Fourth"	44✔
114	\| Fifth -> "Fifth"	88✔
115	\| Sixth -> "Sixth"	53✔
116	\| Seventh -> "Seventh"	51✔
117	\| Octave -> "Octave"	8✔
118	;;
119
120	let to_dyn t = Dyn.Variant (constructor_name t, [])	192✔
121	let name t = make_name (constructor_name t)	172✔
122	let to_int t = 1 + constructor_rank t	39,496✔
123
124	let of_int i =
125	List.nth all (i - 1)	55,465✔
126	\|> function	55,465✔
127	\| Some t -> t	55,465✔
NEW 128	\| None -> Code_error.raise "Index out of bounds." [ "i", i \|> Dyn.int ]	×
129	;;
130
131	let accepts_minor_major_quality = function
132	\| Unison \| Fourth \| Fifth \| Octave -> false	1,004✔
133	\| Second \| Third \| Sixth \| Seventh -> true	11,774✔
134	;;
135
136	let basis_for_number_of_semitons = function
137	\| Unison -> 0	10,689✔
138	\| Second -> 2	40,951✔
139	\| Third -> 4	17,894✔
140	\| Fourth -> 5	13,106✔
141	\| Fifth -> 7	13,496✔
142	\| Sixth -> 9	15,025✔
143	\| Seventh -> 11	11,583✔
144	\| Octave -> 12	957✔
145	;;
146	end
147
148	type t =	12,244✔
149	{ number : Number.t	45,540✔
UNCOV 150	; quality : Quality.t	×
151	; additional_octaves : int
152	}
153	[@@deriving compare, equal, hash]
154
155	let to_dyn { number; quality; additional_octaves } =
156	Dyn.record	192✔
157	[ "number", number \|> Number.to_dyn	192✔
158	; "quality", quality \|> Quality.to_dyn	192✔
159	; "additional_octaves", additional_octaves \|> Dyn.int	192✔
160	]
161	;;
162
163	let to_string { number; quality; additional_octaves } =
164	let skip_quality =	4,939✔
165	match quality with
166	\| Perfect -> true	37✔
167	\| Doubly_diminished \| Diminished \| Minor \| Major \| Augmented \| Doubly_augmented ->	27✔
168	false
169	in
170	let skip_unison =
171	Number.equal number Unison && skip_quality && additional_octaves >= 1	5✔
172	in
173	(if additional_octaves = 1
174	then Printf.sprintf "P8%s" (if skip_unison then "" else " + ")	1✔
175	else if additional_octaves >= 2	4,903✔
176	then Printf.sprintf "%d P8%s" additional_octaves (if skip_unison then "" else " + ")	2✔
177	else "")	4,831✔
178	^
179	if skip_unison
180	then ""	3✔
181	else Quality.prefix_notation quality ^ (Number.to_int number \|> Int.to_string)	4,936✔
182	;;
183
184	let name { number; quality; additional_octaves } =
185	let skip_quality =	178✔
186	match quality with
187	\| Perfect -> true	25✔
188	\| Doubly_diminished \| Diminished \| Minor \| Major \| Augmented \| Doubly_augmented ->	21✔
189	false
190	in
191	let skip_unison =
192	Number.equal number Unison && skip_quality && additional_octaves >= 1	9✔
193	in
194	(if additional_octaves = 1
195	then Printf.sprintf "octave%s" (if skip_unison then "" else " + ")	2✔
196	else if additional_octaves >= 2	140✔
197	then
198	Printf.sprintf "%d octaves%s" additional_octaves (if skip_unison then "" else " + ")	4✔
199	else "")	63✔
200	^ (if skip_quality then "" else Quality.name quality ^ " ")	25✔
201	^ if skip_unison then "" else Number.name number	6✔
202	;;
203
204	let number_of_semitons t =
205	let accepts_minor_major_quality = Number.accepts_minor_major_quality t.number in	68,236✔
206	let basis = Number.basis_for_number_of_semitons t.number in	68,236✔
207	let shift =	68,236✔
208	match t.quality with
209	\| Perfect -> 0	12,507✔
210	\| Major -> 0	25,083✔
211	\| Minor -> -1	14,285✔
212	\| Augmented -> 1	5,284✔
213	\| Diminished -> if accepts_minor_major_quality then -2 else -1	1,938✔
214	\| Doubly_augmented -> 2	3,912✔
215	\| Doubly_diminished -> if accepts_minor_major_quality then -3 else -2	1,335✔
216	in
217	(t.additional_octaves * 12) + basis + shift
218	;;
219
220	let compute ~(from : Note.t) ~(to_ : Note.t) () =
221	let open Option.Let_syntax in	85,349✔
222	let%bind number_of_letter_names, number_of_semitons =
223	let rec aux number_of_letter_names number_of_semitons letter_name octave_designation =
224	if octave_designation > to_.octave_designation	522,467✔
225	then None	27,653✔
226	else if	494,814✔
227	Note.Letter_name.equal letter_name to_.letter_name	494,814✔
228	&& octave_designation = to_.octave_designation	96,694✔
229	then
230	return	57,696✔
231	( number_of_letter_names
232	, number_of_semitons
233	- Note.Symbol.semitons_shift from.symbol	57,696✔
234	+ Note.Symbol.semitons_shift to_.symbol )	57,696✔
235	else
236	aux	437,118✔
237	(Int.succ number_of_letter_names)	437,118✔
238	(number_of_semitons + Note.Letter_name.semitons_step ~from:letter_name)
239	(Note.Letter_name.succ letter_name)	437,118✔
240	(Note.Letter_name.succ_octave_designation letter_name ~octave_designation)	437,118✔
241	in
242	aux 0 0 from.letter_name from.octave_designation	85,349✔
243	in
244	let number_of_letter_names, number_of_semitons, additional_octaves =	57,696✔
245	if number_of_letter_names >= 7 && number_of_semitons >= 12	24,979✔
246	then (	24,211✔
247	let additional_octaves = number_of_letter_names / 7 in
248	( number_of_letter_names - (7 * additional_octaves)
249	, number_of_semitons - (12 * additional_octaves)
250	, additional_octaves ))
251	else number_of_letter_names, number_of_semitons, 0	33,485✔
252	in
253	let%bind () =
254	if number_of_semitons < 0 \|\| number_of_letter_names > 7 then None else return ()	327✔
255	in
256	let number = Number.of_int (number_of_letter_names + 1) in	55,465✔
257	let basis = Number.basis_for_number_of_semitons number in	55,465✔
258	let accepts_minor_major_quality = Number.accepts_minor_major_quality number in	55,465✔
259	let basis_quality =	55,465✔
260	if accepts_minor_major_quality then Quality.Major else Quality.Perfect	17,856✔
261	in
262	let%map quality =
263	let rec aux missing quality =
264	if Int.equal missing 0	94,644✔
265	then return quality	49,505✔
266	else if missing > 0	45,139✔
267	then (
268	let%bind quality = Quality.succ quality ~accepts_minor_major_quality in	17,919✔
269	aux (Int.pred missing) quality)	14,217✔
270	else (
271	let%bind quality = Quality.pred quality ~accepts_minor_major_quality in	27,220✔
272	aux (Int.succ missing) quality)	24,962✔
273	in
274	aux (number_of_semitons - basis) basis_quality	55,465✔
275	in
276	{ number; quality; additional_octaves }	49,505✔
277	;;
278
279	let shift_up
280	({ number; quality = _; additional_octaves } as interval)
281	({ Note.letter_name; symbol = _; octave_designation } as from)
282	=
283	let open Option.Let_syntax in	20,094✔
284	let step = Number.to_int number - 1 + (7 * additional_octaves) in	20,094✔
285	let target =
286	let rec aux step letter_name octave_designation =
287	if step = 0	136,576✔
288	then { Note.letter_name; symbol = from.symbol; octave_designation }	20,094✔
289	else
290	aux	116,482✔
291	(Int.pred step)	116,482✔
292	(Note.Letter_name.succ letter_name)	116,482✔
293	(Note.Letter_name.succ_octave_designation letter_name ~octave_designation)	116,482✔
294	in
295	aux step letter_name octave_designation	20,094✔
296	in
297	let%bind candidate = compute ~from ~to_:target () in	20,094✔
298	let semiton_shift = number_of_semitons interval - number_of_semitons candidate in	20,094✔
299	let%map symbol =
300	let rec aux shift symbol =
301	if shift = 0	37,615✔
302	then Some symbol	20,094✔
303	else if shift > 0	17,521✔
304	then (
305	let%bind symbol = Note.Symbol.succ symbol in	9,351✔
306	aux (Int.pred shift) symbol)	9,351✔
307	else (
308	let%bind symbol = Note.Symbol.pred symbol in	8,170✔
309	aux (Int.succ shift) symbol)	8,170✔
310	in
311	aux semiton_shift target.symbol	20,094✔
312	in
313	{ target with symbol }	20,094✔
314	;;
315
316	let shift_down
317	({ number; quality = _; additional_octaves } as interval)
318	({ Note.letter_name; symbol = _; octave_designation } as to_)
319	=
320	let step = Number.to_int number - 1 + (7 * additional_octaves) in	12,481✔
321	let target =
322	let rec aux step letter_name octave_designation =
323	if step = 0	122,406✔
324	then { Note.letter_name; symbol = to_.symbol; octave_designation }	12,481✔
325	else
326	aux	109,925✔
327	(Int.pred step)	109,925✔
328	(Note.Letter_name.pred letter_name)	109,925✔
329	(Note.Letter_name.pred_octave_designation letter_name ~octave_designation)	109,925✔
330	in
331	aux step letter_name octave_designation	12,481✔
332	in
333	let open Option.Let_syntax in
334	let%bind candidate = compute ~from:target ~to_ () in	12,481✔
335	let semiton_shift = number_of_semitons interval - number_of_semitons candidate in	12,481✔
336	let%map symbol =
337	let rec aux shift symbol =
338	if shift = 0	26,771✔
339	then Some symbol	12,481✔
340	else if shift > 0	14,290✔
341	then (
342	let%bind symbol = Note.Symbol.pred symbol in	7,681✔
343	aux (Int.pred shift) symbol)	7,681✔
344	else (
345	let%bind symbol = Note.Symbol.succ symbol in	6,609✔
346	aux (Int.succ shift) symbol)	6,609✔
347	in
348	aux semiton_shift target.symbol	12,481✔
349	in
350	{ target with symbol }	12,481✔
351	;;
352
353	let unison = { number = Unison; quality = Perfect; additional_octaves = 0 }

mbarbin / fingerboard / 116

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