Set note keys when letter is pressed on keyboard

Author: walfie

src/App.ml

@@ -103,10 +103,11 @@ let update model = function
       | None -> Cmd.msg (SelectNote (Some default))
     in
     (match key with
-    | Keyboard.Up -> model, maybe_update_note Direction.Next
-    | Keyboard.Down -> model, maybe_update_note Direction.Prev
-    | Keyboard.Left -> model, maybe_update_index Tune.Index.max Tune.Index.prev
-    | Keyboard.Right -> model, maybe_update_index Tune.Index.min Tune.Index.next)
+     | Keyboard.Up -> model, maybe_update_note Direction.Next
+     | Keyboard.Down -> model, maybe_update_note Direction.Prev
+     | Keyboard.Left -> model, maybe_update_index Tune.Index.max Tune.Index.prev
+     | Keyboard.Right -> model, maybe_update_index Tune.Index.min Tune.Index.next
+     | Keyboard.ChangeNote note -> model, maybe_update_note (Direction.Set note))
   | PlayingNote maybe_index -> { model with playing_index = maybe_index }, Cmd.none
   | ExportImage -> { model with awaiting_frame = true; selected_index = None }, Cmd.none
   | UrlChange location ->
@@ -131,10 +132,10 @@ let update model = function
     in
     let maybe_new_note = model.tune |> Tune.get index |> f in
     (match maybe_new_note with
-    | None -> model, Cmd.none
-    | Some new_note ->
-      let new_tune = model.tune |> Tune.update index new_note in
-      { model with tune = new_tune }, Cmd.msg (PlayNote new_note))
+     | None -> model, Cmd.none
+     | Some new_note ->
+       let new_tune = model.tune |> Tune.update index new_note in
+       { model with tune = new_tune }, Cmd.msg (PlayNote new_note))
   | PlayNote note ->
     let play_note _ =
       match note with
@@ -270,8 +271,8 @@ let view model =
 let subscriptions model =
   Sub.batch
     [ (if model.awaiting_frame
-      then AnimationFrame.every (fun _ -> FrameRendered)
-      else Sub.none)
+       then AnimationFrame.every (fun _ -> FrameRendered)
+       else Sub.none)
     ; Sub.map keyPressed Keyboard.pressed
     ]
 ;;

src/Keyboard.ml

@@ -5,18 +5,23 @@ type key =
   | Down
   | Left
   | Right
+  | ChangeNote of Note.note
 
-let key_of_int = function
-  | 37 -> Some Left
-  | 38 -> Some Up
-  | 39 -> Some Right
-  | 40 -> Some Down
+let of_note note = ChangeNote note
+
+let key_of_string = function
+  | "ArrowLeft" -> Some Left
+  | "ArrowUp" -> Some Up
+  | "ArrowRight" -> Some Right
+  | "ArrowDown" -> Some Down
+  | other when String.length other == 1 -> Note.of_char other |. Belt.Option.map of_note
   | _ -> None
 ;;
 
+(* TODO: Ignore key when ctrl or cmd are pressed *)
 let decode_event =
   let open Tea.Json in
-  Decoder.field "keyCode" Decoder.int |> Decoder.map key_of_int
+  Decoder.field "key" Decoder.string |> Decoder.map key_of_string
 ;;
 
 let pressed =

src/Note.ml

@@ -56,7 +56,7 @@ let prev note = (meta note).prev
 let color note = (meta note).color
 let string_of_note note = (meta note).as_str
 
-let from_char = function
+let of_char = function
   | "z" -> Some Rest
   | "-" -> Some Hold
   | "g" -> Some G
@@ -72,12 +72,12 @@ let from_char = function
   | "C" -> Some C'
   | "D" -> Some D'
   | "E" -> Some E'
-  | "q" -> Some Random
+  | "q" | "?" -> Some Random
   | _ -> None
 ;;
 
 let notes_of_string str =
-  let get_or_rest c = from_char c |. Belt.Option.getWithDefault Rest in
+  let get_or_rest c = of_char c |. Belt.Option.getWithDefault Rest in
   Js.String.split "" str |> Array.map get_or_rest |> Array.to_list
 ;;
 

src/Tune.ml

@@ -21,7 +21,7 @@ let random () : t = List.init length (fun _ -> Note.random ())
 
 let from_string (str : string) : t =
   let right_pad = length - String.length str |> max 0 in
-  let get_or_rest c = Note.from_char c |. Belt.Option.getWithDefault Note.Rest in
+  let get_or_rest c = Note.of_char c |. Belt.Option.getWithDefault Note.Rest in
   str
   |> Js.String.slice ~from:0 ~to_:length
   |> Js.String.split ""