mbarbin / fingerboard / 113

Committed 23 Dec 2025 04:24PM UTC coverage: 95.592% (-0.7%) from 96.328%

Build # 113

Build Type

Pull #9

github

Committed by

web-flow

Commit Message

Merge f4a989aa2 into 8bac1be2d

Pull Request Pull Request #9: Prepare printer refactor

Run Details

677 of 709 new or added lines in 47 files covered. (95.49%)

18 existing lines in 3 files now uncovered.

3708 of 3879 relevant lines covered (95.59%)

18858.71 hits per line

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

94.82

/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 sexp_of_t t = Dyn.to_sexp (to_dyn 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_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 sexp_of_t t = Dyn.to_sexp (to_dyn t)
  let name t = make_name (constructor_name t)

  let to_int t =
    match List.find_mapi all ~f:(fun i t' -> Option.some_if (equal t t') i) with
    | Some i -> i + 1
    | None -> raise_s [%sexp "Index not found", (t : t), [%here]]
  ;;

  let of_int i =
    List.nth all (i - 1)
    |> function
    | Some t -> t
    | None -> raise_s [%sexp "Index out of bounds", (i : int), [%here]]
  ;;

  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 sexp_of_t t = Dyn.to_sexp (to_dyn t)

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

mbarbin / fingerboard / 113

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