diff options
| -rw-r--r-- | website/sandbox/chord-drill-sergeant/dir-locals.nix | 3 | ||||
| -rw-r--r-- | website/sandbox/chord-drill-sergeant/elm.json | 1 | ||||
| -rw-r--r-- | website/sandbox/chord-drill-sergeant/shell.nix | 1 | ||||
| -rw-r--r-- | website/sandbox/chord-drill-sergeant/src/ChordInspector.elm | 25 | ||||
| -rw-r--r-- | website/sandbox/chord-drill-sergeant/src/Main.elm | 425 | ||||
| -rw-r--r-- | website/sandbox/chord-drill-sergeant/src/Misc.elm | 32 | ||||
| -rw-r--r-- | website/sandbox/chord-drill-sergeant/src/Piano.elm | 231 | ||||
| -rw-r--r-- | website/sandbox/chord-drill-sergeant/src/Tempo.elm | 31 | ||||
| -rw-r--r-- | website/sandbox/chord-drill-sergeant/src/Theory.elm | 1314 |
9 files changed, 1547 insertions, 516 deletions
diff --git a/website/sandbox/chord-drill-sergeant/dir-locals.nix b/website/sandbox/chord-drill-sergeant/dir-locals.nix new file mode 100644 index 000000000000..498f4b5055f8 --- /dev/null +++ b/website/sandbox/chord-drill-sergeant/dir-locals.nix @@ -0,0 +1,3 @@ +let + briefcase = import <briefcase> {}; +in briefcase.utils.nixBufferFromShell ./shell.nix diff --git a/website/sandbox/chord-drill-sergeant/elm.json b/website/sandbox/chord-drill-sergeant/elm.json index adef18b4daa3..f42a3cd27436 100644 --- a/website/sandbox/chord-drill-sergeant/elm.json +++ b/website/sandbox/chord-drill-sergeant/elm.json @@ -12,6 +12,7 @@ "elm/random": "1.0.0", "elm/time": "1.0.0", "elm-community/list-extra": "8.2.3", + "elm-community/maybe-extra": "5.2.0", "elm-community/random-extra": "3.1.0" }, "indirect": { diff --git a/website/sandbox/chord-drill-sergeant/shell.nix b/website/sandbox/chord-drill-sergeant/shell.nix index 30061e65f9d5..584b6c4a9e84 100644 --- a/website/sandbox/chord-drill-sergeant/shell.nix +++ b/website/sandbox/chord-drill-sergeant/shell.nix @@ -3,5 +3,6 @@ let in pkgs.mkShell { buildInputs = with pkgs; [ elmPackages.elm + elmPackages.elm-format ]; } diff --git a/website/sandbox/chord-drill-sergeant/src/ChordInspector.elm b/website/sandbox/chord-drill-sergeant/src/ChordInspector.elm new file mode 100644 index 000000000000..809894f2c2b0 --- /dev/null +++ b/website/sandbox/chord-drill-sergeant/src/ChordInspector.elm @@ -0,0 +1,25 @@ +module ChordInspector exposing (render) + +import Html exposing (..) +import Theory + + +render : Theory.Chord -> Html a +render chord = + case Theory.notesForChord chord of + Nothing -> + p [] [ text "Cannot retrieve the notes for the chord." ] + + Just notes -> + ul [] + (notes + |> List.map + (\note -> + li [] + [ text + (Theory.viewNote + note + ) + ] + ) + ) diff --git a/website/sandbox/chord-drill-sergeant/src/Main.elm b/website/sandbox/chord-drill-sergeant/src/Main.elm index ded6b81e4e80..5ccc4d303eeb 100644 --- a/website/sandbox/chord-drill-sergeant/src/Main.elm +++ b/website/sandbox/chord-drill-sergeant/src/Main.elm @@ -1,280 +1,229 @@ module Main exposing (main) import Browser +import ChordInspector import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (..) +import Piano import Random import Random.List +import Tempo +import Theory import Time exposing (..) -import Piano -import Theory -import Tempo type alias Model = - { whitelistedChords : List Theory.Chord - , selectedChord : Theory.Chord - , isPaused : Bool - , tempo : Int - } - -type Msg = NextChord - | NewChord Theory.Chord - | Play - | Pause - | IncreaseTempo - | DecreaseTempo - | SetTempo String + { whitelistedChords : List Theory.Chord + , selectedChord : Theory.Chord + , isPaused : Bool + , tempo : Int + , firstNote : Theory.Note + , lastNote : Theory.Note + , debug : + { enable : Bool + , inspectChord : Bool + } + } + + +type Msg + = NextChord + | NewChord Theory.Chord + | Play + | Pause + | IncreaseTempo + | DecreaseTempo + | SetTempo String + | ToggleInspectChord + tempoStep : Int -tempoStep = 5 +tempoStep = + 5 + {-| Return the number of milliseconds that elapse during an interval in a `target` bpm. -} bpmToMilliseconds : Int -> Int bpmToMilliseconds target = - let msPerMinute = 1000 * 60 - in round (toFloat msPerMinute / toFloat target) - -inspectChord : Theory.Chord -> String -inspectChord {note, chordType, chordPosition} = - viewNote note ++ " " ++ - (case chordType of - Theory.Major -> "major" - Theory.Major7 -> "major 7th" - Theory.MajorDominant7 -> "major dominant 7th" - Theory.Minor -> "minor" - Theory.Minor7 -> "minor 7th" - Theory.MinorDominant7 -> "minor dominant 7th" - Theory.Augmented -> "augmented" - Theory.Augmented7 -> "augmented 7th" - Theory.Diminished -> "diminished" - Theory.Diminished7 -> "diminished 7th") ++ " " ++ - (case chordPosition of - Theory.First -> "root position" - Theory.Second -> "2nd position" - Theory.Third -> "3rd position" - Theory.Fourth -> "4th position") - -viewChord : Theory.Chord -> String -viewChord {note, chordType, chordPosition} = - viewNoteClass (Theory.classifyNote note) ++ " " ++ - (case chordType of - Theory.Major -> "major" - Theory.Major7 -> "major 7th" - Theory.MajorDominant7 -> "major dominant 7th" - Theory.Minor -> "minor" - Theory.Minor7 -> "minor 7th" - Theory.MinorDominant7 -> "minor dominant 7th" - Theory.Augmented -> "augmented" - Theory.Augmented7 -> "augmented 7th" - Theory.Diminished -> "diminished" - Theory.Diminished7 -> "diminished 7th") ++ " " ++ - (case chordPosition of - Theory.First -> "root position" - Theory.Second -> "2nd position" - Theory.Third -> "3rd position" - Theory.Fourth -> "4th position") - -{-| Serialize a human-readable format of `note`. -} -viewNote : Theory.Note -> String -viewNote note = - case note of - Theory.C1 -> "C1" - Theory.C_sharp1 -> "C♯/D♭1" - Theory.D1 -> "D1" - Theory.D_sharp1 -> "D♯/E♭1" - Theory.E1 -> "E1" - Theory.F1 -> "F1" - Theory.F_sharp1 -> "F♯/G♭1" - Theory.G1 -> "G1" - Theory.G_sharp1 -> "G♯/A♭1" - Theory.A1 -> "A1" - Theory.A_sharp1 -> "A♯/B♭1" - Theory.B1 -> "B1" - Theory.C2 -> "C2" - Theory.C_sharp2 -> "C♯/D♭2" - Theory.D2 -> "D2" - Theory.D_sharp2 -> "D♯/E♭2" - Theory.E2 -> "E2" - Theory.F2 -> "F2" - Theory.F_sharp2 -> "F♯/G♭2" - Theory.G2 -> "G2" - Theory.G_sharp2 -> "G♯/A♭2" - Theory.A2 -> "A2" - Theory.A_sharp2 -> "A♯/B♭2" - Theory.B2 -> "B2" - Theory.C3 -> "C3" - Theory.C_sharp3 -> "C♯/D♭3" - Theory.D3 -> "D3" - Theory.D_sharp3 -> "D♯/E♭3" - Theory.E3 -> "E3" - Theory.F3 -> "F3" - Theory.F_sharp3 -> "F♯/G♭3" - Theory.G3 -> "G3" - Theory.G_sharp3 -> "G♯/A♭3" - Theory.A3 -> "A3" - Theory.A_sharp3 -> "A♯/B♭3" - Theory.B3 -> "B3" - Theory.C4 -> "C4" - Theory.C_sharp4 -> "C♯/D♭4" - Theory.D4 -> "D4" - Theory.D_sharp4 -> "D♯/E♭4" - Theory.E4 -> "E4" - Theory.F4 -> "F4" - Theory.F_sharp4 -> "F♯/G♭4" - Theory.G4 -> "G4" - Theory.G_sharp4 -> "G♯/A♭4" - Theory.A4 -> "A4" - Theory.A_sharp4 -> "A♯/B♭4" - Theory.B4 -> "B4" - Theory.C5 -> "C5" - Theory.C_sharp5 -> "C♯/D♭5" - Theory.D5 -> "D5" - Theory.D_sharp5 -> "D♯/E♭5" - Theory.E5 -> "E5" - Theory.F5 -> "F5" - Theory.F_sharp5 -> "F♯/G♭5" - Theory.G5 -> "G5" - Theory.G_sharp5 -> "G♯/A♭5" - Theory.A5 -> "A5" - Theory.A_sharp5 -> "A♯/B♭5" - Theory.B5 -> "B5" - Theory.C6 -> "C6" - Theory.C_sharp6 -> "C♯/D♭6" - Theory.D6 -> "D6" - Theory.D_sharp6 -> "D♯/E♭6" - Theory.E6 -> "E6" - Theory.F6 -> "F6" - Theory.F_sharp6 -> "F♯/G♭6" - Theory.G6 -> "G6" - Theory.G_sharp6 -> "G♯/A♭6" - Theory.A6 -> "A6" - Theory.A_sharp6 -> "A♯/B♭6" - Theory.B6 -> "B6" - Theory.C7 -> "C7" - Theory.C_sharp7 -> "C♯/D♭7" - Theory.D7 -> "D7" - Theory.D_sharp7 -> "D♯/E♭7" - Theory.E7 -> "E7" - Theory.F7 -> "F7" - Theory.F_sharp7 -> "F♯/G♭7" - Theory.G7 -> "G7" - Theory.G_sharp7 -> "G♯/A♭7" - Theory.A7 -> "A7" - Theory.A_sharp7 -> "A♯/B♭7" - Theory.B7 -> "B7" - Theory.C8 -> "C8" - -{-| Serialize a human-readable format of `noteClass`. -} -viewNoteClass : Theory.NoteClass -> String -viewNoteClass noteClass = - case noteClass of - Theory.C -> "C" - Theory.C_sharp -> "C♯/D♭" - Theory.D -> "D" - Theory.D_sharp -> "D♯/E♭" - Theory.E -> "E" - Theory.F -> "F" - Theory.F_sharp -> "F♯/G♭" - Theory.G -> "G" - Theory.G_sharp -> "G♯/A♭" - Theory.A -> "A" - Theory.A_sharp -> "A♯/B♭" - Theory.B -> "B" + let + msPerMinute = + 1000 * 60 + in + round (toFloat msPerMinute / toFloat target) + cmajor : Theory.Chord cmajor = - { note = Theory.C4 - , chordType = Theory.Major - , chordPosition = Theory.First - } + { note = Theory.C4 + , chordType = Theory.MajorDominant7 + , chordInversion = Theory.Root + } -{-| The initial state for the application. -} + +{-| The initial state for the application. +-} init : Model init = - { whitelistedChords = Theory.allChords - , selectedChord = cmajor - , isPaused = True - , tempo = 60 - } + let + ( firstNote, lastNote ) = + ( Theory.C3, Theory.C5 ) + in + { whitelistedChords = Theory.allChords firstNote lastNote + , selectedChord = cmajor + , isPaused = True + , tempo = 60 + , firstNote = firstNote + , lastNote = lastNote + , debug = + { enable = True + , inspectChord = True + } + } + subscriptions : Model -> Sub Msg -subscriptions {isPaused, tempo} = - if isPaused then - Sub.none - else - Time.every (tempo |> bpmToMilliseconds |> toFloat) (\_ -> NextChord) - -{-| Now that we have state, we need a function to change the state. -} -update : Msg -> Model -> (Model, Cmd Msg) +subscriptions { isPaused, tempo } = + if isPaused then + Sub.none + + else + Time.every (tempo |> bpmToMilliseconds |> toFloat) (\_ -> NextChord) + + +{-| Now that we have state, we need a function to change the state. +-} +update : Msg -> Model -> ( Model, Cmd Msg ) update msg model = - case msg of - NewChord chord -> ( { model | selectedChord = chord } - , Cmd.none - ) - NextChord -> ( model - , Random.generate (\x -> - case x of - (Just chord, _) -> NewChord chord - (Nothing, _) -> NewChord cmajor) - (Random.List.choose model.whitelistedChords) - ) - Play -> ( { model | isPaused = False } + case msg of + NewChord chord -> + ( { model | selectedChord = chord } , Cmd.none ) - Pause -> ( { model | isPaused = True } - , Cmd.none - ) - IncreaseTempo -> ( { model | tempo = model.tempo + tempoStep } - , Cmd.none - ) - DecreaseTempo -> ( { model | tempo = model.tempo - tempoStep } - , Cmd.none - ) - SetTempo tempo -> ( { model | - tempo = case String.toInt tempo of - Just x -> x - Nothing -> model.tempo - } - , Cmd.none - ) + + NextChord -> + ( model + , Random.generate + (\x -> + case x of + ( Just chord, _ ) -> + NewChord chord + + ( Nothing, _ ) -> + NewChord cmajor + ) + (Random.List.choose model.whitelistedChords) + ) + + Play -> + ( { model | isPaused = False } + , Cmd.none + ) + + Pause -> + ( { model | isPaused = True } + , Cmd.none + ) + + IncreaseTempo -> + ( { model | tempo = model.tempo + tempoStep } + , Cmd.none + ) + + DecreaseTempo -> + ( { model | tempo = model.tempo - tempoStep } + , Cmd.none + ) + + ToggleInspectChord -> + ( { model + | debug = + { inspectChord = not model.debug.inspectChord + , enable = model.debug.enable + } + } + , Cmd.none + ) + + SetTempo tempo -> + ( { model + | tempo = + case String.toInt tempo of + Just x -> + x + + Nothing -> + model.tempo + } + , Cmd.none + ) + playPause : Model -> Html Msg -playPause {isPaused} = - if isPaused then - button [ onClick Play ] [ text "Play" ] - else - button [ onClick Pause ] [ text "Pause" ] +playPause { isPaused } = + if isPaused then + button [ onClick Play ] [ text "Play" ] + + else + button [ onClick Pause ] [ text "Pause" ] + + +debugger : Html Msg +debugger = + fieldset [] + [ label [] [ text "Inspect Chord" ] + , input [ type_ "checkbox", onClick ToggleInspectChord, checked init.debug.inspectChord ] [] + ] + view : Model -> Html Msg view model = - case Theory.notesForChord model.selectedChord of - Nothing -> - p [] [ text (""" + case Theory.notesForChord model.selectedChord of + Nothing -> + p [] [ text (""" We cannot render the chord that you provided because the notes that comprise the chord fall off either the upper or lower end of the piano. Chord: - """ ++ (inspectChord model.selectedChord)) ] - Just x -> - div [] [ Tempo.render { tempo = model.tempo - , handleIncrease = IncreaseTempo - , handleDecrease = DecreaseTempo - , handleInput = SetTempo - } - , playPause model - , p [] [ text (viewChord model.selectedChord) ] - , Piano.render { highlight = x } - ] - -{-| For now, I'm just dumping things onto the page to sketch ideas. -} + """ ++ Theory.inspectChord model.selectedChord) ] + + Just x -> + div [] + [ Tempo.render + { tempo = model.tempo + , handleIncrease = IncreaseTempo + , handleDecrease = DecreaseTempo + , handleInput = SetTempo + } + , playPause model + , if model.debug.enable then + debugger + + else + span [] [] + , if model.debug.inspectChord then + ChordInspector.render model.selectedChord + + else + span [] [] + , p [] [ text (Theory.viewChord model.selectedChord) ] + , Piano.render + { highlight = x + , start = model.firstNote + , end = model.lastNote + } + ] + + +{-| For now, I'm just dumping things onto the page to sketch ideas. +-} main = - Browser.element { init = \() -> (init, Cmd.none) - , subscriptions = subscriptions - , update = update - , view = view - } + Browser.element + { init = \() -> ( init, Cmd.none ) + , subscriptions = subscriptions + , update = update + , view = view + } diff --git a/website/sandbox/chord-drill-sergeant/src/Misc.elm b/website/sandbox/chord-drill-sergeant/src/Misc.elm index 479234ff1546..451c5c315c50 100644 --- a/website/sandbox/chord-drill-sergeant/src/Misc.elm +++ b/website/sandbox/chord-drill-sergeant/src/Misc.elm @@ -1,15 +1,35 @@ module Misc exposing (..) + comesAfter : a -> List a -> Maybe a comesAfter x xs = case xs of - [] -> Nothing - _::[] -> Nothing - y::z::rest -> if y == x then Just z else comesAfter x (z::rest) + [] -> + Nothing + + _ :: [] -> + Nothing + + y :: z :: rest -> + if y == x then + Just z + + else + comesAfter x (z :: rest) + comesBefore : a -> List a -> Maybe a comesBefore x xs = case xs of - [] -> Nothing - _::[] -> Nothing - y::z::rest -> if z == x then Just y else comesAfter x (z::rest) + [] -> + Nothing + + _ :: [] -> + Nothing + + y :: z :: rest -> + if z == x then + Just y + + else + comesBefore x (z :: rest) diff --git a/website/sandbox/chord-drill-sergeant/src/Piano.elm b/website/sandbox/chord-drill-sergeant/src/Piano.elm index 048208c1f556..80c24834c1c8 100644 --- a/website/sandbox/chord-drill-sergeant/src/Piano.elm +++ b/website/sandbox/chord-drill-sergeant/src/Piano.elm @@ -4,79 +4,184 @@ import Browser import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (..) - +import List.Extra import Theory -{-| Convert an integer into its pixel representation for CSS. -} + +type alias KeyMarkup a = + { offset : Int + , isHighlit : Bool + , note : Theory.Note + } + -> Html a + + +type alias Props = + { highlight : List Theory.Note + , start : Theory.Note + , end : Theory.Note + } + + +{-| Convert an integer into its pixel representation for CSS. +-} pixelate : Int -> String -pixelate x = String.fromInt x ++ "px" +pixelate x = + String.fromInt x ++ "px" -{-| Pixel width of the white keys. -} + +{-| Pixel width of the white keys. +-} naturalWidth : Int -naturalWidth = 40 +naturalWidth = + 45 + -{-| Pixel height of the white keys. -} +{-| Pixel height of the white keys. +-} naturalHeight : Int -naturalHeight = 200 +naturalHeight = + 250 -{-| Pixel width of the black keys. -} + +{-| Pixel width of the black keys. +-} accidentalWidth : Int -accidentalWidth = round (toFloat naturalWidth * 0.7) +accidentalWidth = + round (toFloat naturalWidth * 0.4) + -{-| Pixel height of the black keys. -} +{-| Pixel height of the black keys. +-} accidentalHeight : Int -accidentalHeight = round (toFloat naturalHeight * 0.6) - -{-| These are the white keys on most modern pianos. -} -natural : Int -> Bool -> Html a -natural offset isHighlit = - div [ style "background-color" (if isHighlit then "red" else "white") - , style "border-right" "1px solid black" - , style "border-top" "1px solid black" - , style "border-bottom" "1px solid black" - , style "width" (pixelate naturalWidth) - , style "height" (pixelate naturalHeight) - , style "position" "absolute" - , style "left" ((String.fromInt offset) ++ "px") - ] [] - -{-| These are the black keys on most modern pianos. -} -accidental : Int -> Bool -> Html a -accidental offset isHighlit = - div [ style "background-color" (if isHighlit then "red" else "black") - , style "border-top" "1px solid black" - , style "border-left" "1px solid black" - , style "border-right" "1px solid black" - , style "border-bottom" "1px solid black" - , style "width" (pixelate accidentalWidth) - , style "height" (pixelate accidentalHeight) - , style "position" "absolute" - , style "left" ((String.fromInt offset) ++ "px") - , style "z-index" "1" - ] [] +accidentalHeight = + round (toFloat naturalHeight * 0.63) + + +{-| These are the white keys on most modern pianos. +-} +natural : KeyMarkup a +natural { offset, isHighlit, note } = + div + [ style "background-color" + (if isHighlit then + "red" + + else + "white" + ) + , style "border-right" "1px solid black" + , style "border-top" "1px solid black" + , style "border-bottom" "1px solid black" + , style "width" (pixelate naturalWidth) + , style "height" (pixelate naturalHeight) + , style "position" "absolute" + , style "left" (String.fromInt offset ++ "px") + ] + [ p [] [ text (Theory.viewNote note) ] ] + + +{-| These are the black keys on most modern pianos. +-} +accidental : KeyMarkup a +accidental { offset, isHighlit, note } = + div + [ style "background-color" + (if isHighlit then + "red" + + else + "black" + ) + , style "border-top" "1px solid black" + , style "border-left" "1px solid black" + , style "border-right" "1px solid black" + , style "border-bottom" "1px solid black" + , style "width" (pixelate accidentalWidth) + , style "height" (pixelate accidentalHeight) + , style "position" "absolute" + , style "left" (String.fromInt offset ++ "px") + , style "z-index" "1" + ] + [] + + +makeKey : List Theory.Note -> Theory.Note -> (Int -> Html a) +makeKey highlight note = + if Theory.isNatural note then + \x -> + natural + { offset = x + , isHighlit = List.member note highlight + , note = note + } + + else + \x -> + accidental + { offset = x + , isHighlit = List.member note highlight + , note = note + } + {-| A section of the piano consisting of all twelve notes. The name octave -implies eight notes, which most scales (not the blues scale) honor. -} -octave : List Theory.Note -> List (Html a) -octave highlight = - let - isHighlit note = List.member note highlight - in - [ natural 0 (isHighlit Theory.C4) - , accidental 25 (isHighlit Theory.C_sharp4) - , natural 40 (isHighlit Theory.D4) - , accidental 65 (isHighlit Theory.D_sharp4) - , natural 80 (isHighlit Theory.E4) - , natural 120 (isHighlit Theory.F4) - , accidental 145 (isHighlit Theory.F_sharp4) - , natural 160 (isHighlit Theory.G4) - , accidental 185 (isHighlit Theory.G_sharp4) - , natural 200 (isHighlit Theory.A4) - , accidental 225 (isHighlit Theory.A_sharp4) - , natural 240 (isHighlit Theory.B4) - ] - -{-| Return the HTML that renders a piano representation. -} -render : { highlight : List Theory.Note } -> Html a -render {highlight} = - div [ style "display" "flex" ] (octave highlight |> List.reverse |> List.repeat 1 |> List.concat) +implies eight notes, which most scales (not the blues scale) honor. +-} +octave : Theory.Note -> Theory.Note -> List Theory.Note -> List (Html a) +octave start end highlight = + let + isHighlit note = + List.member note highlight + + spacing prevOffset prev curr = + case ( Theory.keyClass prev, Theory.keyClass curr ) of + ( Theory.Natural, Theory.Accidental ) -> + -- idk this calculation yet + prevOffset + naturalWidth - round (toFloat accidentalWidth / 2) + + ( Theory.Accidental, Theory.Natural ) -> + -- accidentalWidth / 2 + prevOffset + round (toFloat accidentalWidth / 2) + + ( Theory.Natural, Theory.Natural ) -> + -- naturalWidth + prevOffset + naturalWidth + + -- This pattern should never hit. + _ -> + prevOffset + + ( _, _, notes ) = + Theory.notesFromRange start end + |> List.foldl + (\curr ( prevOffset, prev, result ) -> + case ( prevOffset, prev ) of + ( Nothing, Nothing ) -> + ( Just 0, Just curr, makeKey highlight curr 0 :: result ) + + ( Just po, Just p ) -> + let + offset = + spacing po p curr + in + ( Just offset + , Just curr + , makeKey highlight curr offset :: result + ) + + -- This pattern should never hit. + _ -> + ( Nothing, Nothing, [] ) + ) + ( Nothing, Nothing, [] ) + in + List.reverse notes + + +{-| Return the HTML that renders a piano representation. +-} +render : Props -> Html a +render { highlight, start, end } = + div [ style "display" "flex" ] + (octave start end highlight |> List.reverse |> List.repeat 1 |> List.concat) diff --git a/website/sandbox/chord-drill-sergeant/src/Tempo.elm b/website/sandbox/chord-drill-sergeant/src/Tempo.elm index de4fa32795f9..270cc5bd6dc6 100644 --- a/website/sandbox/chord-drill-sergeant/src/Tempo.elm +++ b/website/sandbox/chord-drill-sergeant/src/Tempo.elm @@ -4,19 +4,24 @@ import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (..) + type alias Props msg = - { tempo : Int - , handleIncrease : msg - , handleDecrease : msg - , handleInput : String -> msg - } + { tempo : Int + , handleIncrease : msg + , handleDecrease : msg + , handleInput : String -> msg + } + render : Props msg -> Html msg -render {tempo, handleIncrease, handleDecrease, handleInput} = - div [] [ p [] [ text ((String.fromInt tempo) ++ " BPM") ] - , button [ onClick handleDecrease ] [ text "Slower" ] - , input [ onInput handleInput - , placeholder "Set tempo..." - ] [] - , button [ onClick handleIncrease ] [ text "Faster" ] - ] +render { tempo, handleIncrease, handleDecrease, handleInput } = + div [] + [ p [] [ text (String.fromInt tempo ++ " BPM") ] + , button [ onClick handleDecrease ] [ text "Slower" ] + , input + [ onInput handleInput + , placeholder "Set tempo..." + ] + [] + , button [ onClick handleIncrease ] [ text "Faster" ] + ] diff --git a/website/sandbox/chord-drill-sergeant/src/Theory.elm b/website/sandbox/chord-drill-sergeant/src/Theory.elm index 9e84aeac4c4e..4dc4c3e511e8 100644 --- a/website/sandbox/chord-drill-sergeant/src/Theory.elm +++ b/website/sandbox/chord-drill-sergeant/src/Theory.elm @@ -1,8 +1,10 @@ module Theory exposing (..) import List.Extra +import Maybe.Extra import Misc + {-| Notes are the individuals sounds that we use to create music. Think: "do re mi fa so la ti do". @@ -13,102 +15,259 @@ underlying state of the application. Note: There are "notes" like A, B, D-flat, and then there are notes like "middle C", also denoted in scientific pitch notation as C4. I'm unsure of what to call each of these, and my application does not model scientific pitch notation yet, -so these non-scientific pitch denote values are "notes" for now. -} -type Note = C1 | C_sharp1 | D1 | D_sharp1 | E1 | F1 | F_sharp1 | G1 | G_sharp1 | A1 | A_sharp1 | B1 - | C2 | C_sharp2 | D2 | D_sharp2 | E2 | F2 | F_sharp2 | G2 | G_sharp2 | A2 | A_sharp2 | B2 - | C3 | C_sharp3 | D3 | D_sharp3 | E3 | F3 | F_sharp3 | G3 | G_sharp3 | A3 | A_sharp3 | B3 - | C4 | C_sharp4 | D4 | D_sharp4 | E4 | F4 | F_sharp4 | G4 | G_sharp4 | A4 | A_sharp4 | B4 - | C5 | C_sharp5 | D5 | D_sharp5 | E5 | F5 | F_sharp5 | G5 | G_sharp5 | A5 | A_sharp5 | B5 - | C6 | C_sharp6 | D6 | D_sharp6 | E6 | F6 | F_sharp6 | G6 | G_sharp6 | A6 | A_sharp6 | B6 - | C7 | C_sharp7 | D7 | D_sharp7 | E7 | F7 | F_sharp7 | G7 | G_sharp7 | A7 | A_sharp7 | B7 - | C8 +so these non-scientific pitch denote values are "notes" for now. + +-} +type Note + = C1 + | C_sharp1 + | D1 + | D_sharp1 + | E1 + | F1 + | F_sharp1 + | G1 + | G_sharp1 + | A1 + | A_sharp1 + | B1 + | C2 + | C_sharp2 + | D2 + | D_sharp2 + | E2 + | F2 + | F_sharp2 + | G2 + | G_sharp2 + | A2 + | A_sharp2 + | B2 + | C3 + | C_sharp3 + | D3 + | D_sharp3 + | E3 + | F3 + | F_sharp3 + | G3 + | G_sharp3 + | A3 + | A_sharp3 + | B3 + | C4 + | C_sharp4 + | D4 + | D_sharp4 + | E4 + | F4 + | F_sharp4 + | G4 + | G_sharp4 + | A4 + | A_sharp4 + | B4 + | C5 + | C_sharp5 + | D5 + | D_sharp5 + | E5 + | F5 + | F_sharp5 + | G5 + | G_sharp5 + | A5 + | A_sharp5 + | B5 + | C6 + | C_sharp6 + | D6 + | D_sharp6 + | E6 + | F6 + | F_sharp6 + | G6 + | G_sharp6 + | A6 + | A_sharp6 + | B6 + | C7 + | C_sharp7 + | D7 + | D_sharp7 + | E7 + | F7 + | F_sharp7 + | G7 + | G_sharp7 + | A7 + | A_sharp7 + | B7 + | C8 + {-| I alluded to this concept in the Note type's documentation. These are the -letters of notes. For instance C2, C3, C4 are all instances of C. -} -type NoteClass = C - | C_sharp - | D - | D_sharp - | E - | F - | F_sharp - | G - | G_sharp - | A - | A_sharp - | B - -{-| Encode whether you are traversing "up" or "down" intervals -} -type StepDirection = Up | Down - -{-| One can measure the difference between between notes using intervals. -} -type Interval = Half - | Whole - | MajorThird - | MinorThird - -{-| A bundle of notes which are usually, but not necessarily harmonious. -} +letters of notes. For instance C2, C3, C4 are all instances of C. +-} +type NoteClass + = C + | C_sharp + | D + | D_sharp + | E + | F + | F_sharp + | G + | G_sharp + | A + | A_sharp + | B + + +{-| Encode whether you are traversing "up" or "down" intervals +-} +type StepDirection + = Up + | Down + + +{-| One can measure the difference between between notes using intervals. +-} +type Interval + = Half + | NHalves Int + | Whole + | MajorThird + | MinorThird + | PerfectFifth + | AugmentedFifth + | DiminishedFifth + | MajorSeventh + | DominantSeventh + + +{-| Add direction to a distance on the piano. +-} +type alias IntervalVector = + { interval : Interval + , direction : StepDirection + } + + +{-| A bundle of notes which are usually, but not necessarily harmonious. +-} type alias Chord = - { note : Note - , chordType : ChordType - , chordPosition : ChordPosition - } + { note : Note + , chordType : ChordType + , chordInversion : ChordInversion + } + {-| Many possible chords exist. This type encodes the possibilities. I am tempted to model these in a more "DRY" way, but I worry that this abstraction -may cause more problems than it solves. -} -type ChordType = Major - | Major7 - | MajorDominant7 - | Minor - | Minor7 - | MinorDominant7 - | Augmented - | Augmented7 - | Diminished - | Diminished7 +may cause more problems than it solves. +-} +type ChordType + = Major + | Major7 + | MajorDominant7 + | Minor + | MinorMajor7 + | MinorDominant7 + | Augmented + | AugmentedDominant7 + | Diminished + | DiminishedDominant7 + | DiminishedMajor7 + {-| On a piano, a triad can be played three ways. As a rule-of-thumb, The number of ways a pianist can play a chord is equal to the number of notes in the chord -itself. -} -type ChordPosition = First - | Second - | Third - | Fourth +itself. +-} +type ChordInversion + = Root + | First + | Second + + +{-| Whether a given note is a white key or a black key. +-} +type KeyClass + = Natural + | Accidental + {-| Songs are written in one or more keys, which define the notes and therefore -chords that harmonize with one another. -} +chords that harmonize with one another. +-} type alias Key = - { noteClass : NoteClass - , mode : Mode - } + { noteClass : NoteClass + , mode : Mode + } + {-| We create "scales" by enumerating the notes of a given key. These keys are -defined by the "tonic" note and the "mode". I thought about including Ionian, +defined by the "tonic" note and the "mode". I thought about including Ionian, Dorian, Phrygian, etc., but in the I would like to avoid over-abstracting this early on, so I'm going to err on the side of overly concrete until I have a -better idea of the extent of this project. -} -type Mode = BluesMode - | MajorMode - | MinorMode +better idea of the extent of this project. +-} +type Mode + = BluesMode + | MajorMode + | MinorMode + + +scaleDegree : Int -> Key -> NoteClass +scaleDegree which { noteClass } = + case noteClass of + _ -> + C + {-| Returns the Note in the cental octave of the piano for a given -NoteClass. For example, C4 -- or "middle C" -- for C. -} +NoteClass. For example, C4 -- or "middle C" -- for C. +-} noteInCentralOctave : NoteClass -> Note noteInCentralOctave noteClass = case noteClass of - C -> C4 - C_sharp -> C_sharp4 - D -> D4 - D_sharp -> D_sharp4 - E -> E4 - F -> F4 - F_sharp -> F_sharp4 - G -> G4 - G_sharp -> G_sharp4 - A -> A4 - A_sharp -> A_sharp4 - B -> B4 + C -> + C4 + + C_sharp -> + C_sharp4 + + D -> + D4 + + D_sharp -> + D_sharp4 + + E -> + E4 + + F -> + F4 + + F_sharp -> + F_sharp4 + + G -> + G4 + + G_sharp -> + G_sharp4 + + A -> + A4 + + A_sharp -> + A_sharp4 + + B -> + B4 + {-| Return the note that is one half step away from `note` in the direction, `dir`. @@ -117,155 +276,918 @@ Maybe. -} halfStep : StepDirection -> Note -> Maybe Note halfStep dir note = - case dir of - Up -> Misc.comesAfter note allNotes - Down -> Misc.comesBefore note allNotes + let + everyNote = + notesFromRange C2 C8 + in + case dir of + Up -> + Misc.comesAfter note everyNote + + Down -> + Misc.comesBefore note everyNote + {-| Return a list of steps to take away from the root note to return back to the root note for a given mode. -} -intervalsForMode : Mode -> List Interval +intervalsForMode : Mode -> List IntervalVector intervalsForMode mode = - case mode of - MajorMode -> [Whole, Whole, Half, Whole, Whole, Whole, Half] - MinorMode -> [Whole, Half, Whole, Whole, Half, Whole, Whole] - BluesMode -> [MinorThird, Whole, Half, Half, MinorThird] - -{-| Return a list of the intervals the comprise a chord -} -intervalsForChordType : ChordType -> List Interval -intervalsForChordType chordType = - case chordType of - Major -> [MajorThird, MinorThird] - Major7 -> [MajorThird, MinorThird, MajorThird] - MajorDominant7 -> [MajorThird, MinorThird, MajorThird, MinorThird] - Minor -> [MinorThird, MajorThird] - Minor7 -> [MinorThird, MajorThird, MajorThird] - MinorDominant7 -> [MinorThird, MajorThird, MajorThird, MinorThird] - Augmented -> [MajorThird, MajorThird] - Augmented7 -> [MajorThird, MajorThird, Whole] - Diminished -> [MinorThird, MinorThird] - Diminished7 -> [MinorThird, MinorThird, MinorThird] - -{-| Return the note in the direction, `dir`, away from `note` `s` intervals -} -step : StepDirection -> Interval -> Note -> Maybe Note -step dir s note = - let - doHalfStep = halfStep dir - in - case s of - Half -> - doHalfStep note - Whole -> - doHalfStep note - |> Maybe.andThen doHalfStep - MinorThird -> - doHalfStep note - |> Maybe.andThen doHalfStep - |> Maybe.andThen doHalfStep - MajorThird -> - doHalfStep note - |> Maybe.andThen doHalfStep - |> Maybe.andThen doHalfStep - |> Maybe.andThen doHalfStep - -{-| Returns a list of all of the notes up from a give `note`. - -In the case where applying all of the steps would result in running off of the -edge of the piano, this function returns a Maybe. -} -applySteps : List Interval -> Note -> Maybe (List Note) + let + up x = + { direction = Up, interval = x } + + down x = + { direction = Down, interval = x } + in + case mode of + MajorMode -> + List.map up [ Whole, Whole, Half, Whole, Whole, Whole, Half ] + + MinorMode -> + List.map up [ Whole, Half, Whole, Whole, Half, Whole, Whole ] + + BluesMode -> + List.map up [ MinorThird, Whole, Half, Half, MinorThird ] + + +{-| Return a list of the intervals the comprise a chord. Each interval measures +the distance away from the root-note of the chord. +-} +intervalsForChordType : ChordType -> ChordInversion -> List IntervalVector +intervalsForChordType chordType chordInversion = + let + up x = + { direction = Up, interval = x } + + down x = + { direction = Down, interval = x } + in + case ( chordType, chordInversion ) of + -- Major + ( Major, Root ) -> + [ up MajorThird, up PerfectFifth ] + + ( Major, First ) -> + [ down (NHalves 5), down (NHalves 8) ] + + ( Major, Second ) -> + [ down (NHalves 5), up MajorThird ] + + -- Major7 + ( Major7, Root ) -> + [ up MajorThird, up PerfectFifth, up MajorSeventh ] + + ( Major7, First ) -> + down Half :: intervalsForChordType Major chordInversion + + ( Major7, Second ) -> + down Half :: intervalsForChordType Major chordInversion + + -- MajorDominant7 + ( MajorDominant7, Root ) -> + up DominantSeventh :: intervalsForChordType Major chordInversion + + ( MajorDominant7, First ) -> + down Whole :: intervalsForChordType Major chordInversion + + ( MajorDominant7, Second ) -> + down Whole :: intervalsForChordType Major chordInversion + + -- Minor + ( Minor, Root ) -> + [ up MinorThird, up PerfectFifth ] + + ( Minor, First ) -> + [ down (NHalves 5), down (NHalves 9) ] + + ( Minor, Second ) -> + [ down (NHalves 5), up MinorThird ] + + -- MinorMajor7 + ( MinorMajor7, Root ) -> + up MajorSeventh :: intervalsForChordType Minor chordInversion + + ( MinorMajor7, First ) -> + down Half :: intervalsForChordType Minor chordInversion + + ( MinorMajor7, Second ) -> + down Half :: intervalsForChordType Minor chordInversion + + -- MinorDominant7 + ( MinorDominant7, Root ) -> + up DominantSeventh :: intervalsForChordType Minor chordInversion + + ( MinorDominant7, First ) -> + down Whole :: intervalsForChordType Minor chordInversion + + ( MinorDominant7, Second ) -> + down Whole :: intervalsForChordType Minor chordInversion + + -- Augmented + ( Augmented, Root ) -> + [ up MajorThird, up AugmentedFifth ] + + ( Augmented, First ) -> + [ down (NHalves 8), down (NHalves 4) ] + + ( Augmented, Second ) -> + [ down (NHalves 4), up MajorThird ] + + -- AugmentedDominant7 + ( AugmentedDominant7, Root ) -> + up DominantSeventh :: intervalsForChordType Augmented chordInversion + + ( AugmentedDominant7, First ) -> + down Whole :: intervalsForChordType Augmented chordInversion + + ( AugmentedDominant7, Second ) -> + down Whole :: intervalsForChordType Augmented chordInversion + + -- Diminished + ( Diminished, Root ) -> + [ up MinorThird, up DiminishedFifth ] + + ( Diminished, First ) -> + [ down (NHalves 6), down (NHalves 9) ] + + ( Diminished, Second ) -> + [ down (NHalves 6), up MinorThird ] + + -- DiminishedDominant7 + ( DiminishedDominant7, Root ) -> + up DominantSeventh :: intervalsForChordType Diminished chordInversion + + ( DiminishedDominant7, First ) -> + down Whole :: intervalsForChordType Diminished chordInversion + + ( DiminishedDominant7, Second ) -> + down Whole :: intervalsForChordType Diminished chordInversion + + -- DiminishedMajor7 + ( DiminishedMajor7, Root ) -> + up MajorSeventh :: intervalsForChordType Diminished chordInversion + + ( DiminishedMajor7, First ) -> + down Half :: intervalsForChordType Diminished chordInversion + + ( DiminishedMajor7, Second ) -> + down Half :: intervalsForChordType Diminished chordInversion + + +{-| Return the note in the direction, `dir`, away from `note` `s` intervals +-} +step : IntervalVector -> Note -> Maybe Note +step { direction, interval } note = + let + doStep int = + step { direction = direction, interval = int } + in + case interval of + Half -> + halfStep direction note + + NHalves n -> + List.repeat n + { direction = direction + , interval = Half + } + |> (\x -> applySteps x note) + |> Maybe.andThen (List.reverse >> List.head) + + Whole -> + note + |> doStep Half + |> Maybe.andThen (doStep Half) + + MinorThird -> + note + |> doStep Whole + |> Maybe.andThen (doStep Half) + + MajorThird -> + note + |> doStep Whole + |> Maybe.andThen (doStep Whole) + + PerfectFifth -> + note + |> doStep MajorThird + |> Maybe.andThen (doStep MinorThird) + + AugmentedFifth -> + note + |> doStep PerfectFifth + |> Maybe.andThen (doStep Half) + + DiminishedFifth -> + note + |> doStep MajorThird + |> Maybe.andThen (doStep Whole) + + MajorSeventh -> + note + |> doStep PerfectFifth + |> Maybe.andThen (doStep MajorThird) + + DominantSeventh -> + note + |> doStep PerfectFifth + |> Maybe.andThen (doStep MinorThird) + + +{-| Returns a list of all of the notes away from a give `note`. + + - The 0th element is applied to `note`. + - The 1st element is applied to the result of the previous operation. + - The 2nd element is applied to the result of the previous operation. + - and so on...until all of the `steps` are exhausted. + +In the case where applying any of the steps would result in running off of +either edge of the piano, this function returns a Nothing. + +-} +applySteps : List IntervalVector -> Note -> Maybe (List Note) applySteps steps note = doApplySteps steps note [] |> Maybe.map List.reverse -doApplySteps : List Interval -> Note -> List Note -> Maybe (List Note) + +doApplySteps : List IntervalVector -> Note -> List Note -> Maybe (List Note) doApplySteps steps note result = case steps of - [] -> Just (note::result) - s::rest -> - case step Up s note of - Just x -> doApplySteps rest x (note::result) - Nothing -> Nothing + [] -> + Just (note :: result) + + s :: rest -> + case step s note of + Just x -> + doApplySteps rest x (note :: result) + + Nothing -> + Nothing + -{-| Return the NoteClass for a given note. -} +{-| Return the KeyClass for a given `note`. +-} +keyClass : Note -> KeyClass +keyClass note = + if isNatural note then + Natural + + else + Accidental + + +{-| Return the NoteClass for a given note. +-} classifyNote : Note -> NoteClass classifyNote note = - if List.member note [C1, C2, C3, C4, C5, C6, C7, C8] then + if List.member note [ C1, C2, C3, C4, C5, C6, C7, C8 ] then C - else if List.member note [C_sharp1, C_sharp2, C_sharp3, C_sharp4, C_sharp5, C_sharp6, C_sharp7] then + + else if List.member note [ C_sharp1, C_sharp2, C_sharp3, C_sharp4, C_sharp5, C_sharp6, C_sharp7 ] then C_sharp - else if List.member note [D1, D2, D3, D4, D5, D6, D7] then + + else if List.member note [ D1, D2, D3, D4, D5, D6, D7 ] then D - else if List.member note [D_sharp1, D_sharp2, D_sharp3, D_sharp4, D_sharp5, D_sharp6, D_sharp7] then + + else if List.member note [ D_sharp1, D_sharp2, D_sharp3, D_sharp4, D_sharp5, D_sharp6, D_sharp7 ] then D_sharp - else if List.member note [E1, E2, E3, E4, E5, E6, E7] then + + else if List.member note [ E1, E2, E3, E4, E5, E6, E7 ] then E - else if List.member note [F1, F2, F3, F4, F5, F6, F7] then + + else if List.member note [ F1, F2, F3, F4, F5, F6, F7 ] then F - else if List.member note [F_sharp1, F_sharp2, F_sharp3, F_sharp4, F_sharp5, F_sharp6, F_sharp7] then + + else if List.member note [ F_sharp1, F_sharp2, F_sharp3, F_sharp4, F_sharp5, F_sharp6, F_sharp7 ] then F_sharp - else if List.member note [G1, G2, G3, G4, G5, G6, G7] then + + else if List.member note [ G1, G2, G3, G4, G5, G6, G7 ] then G - else if List.member note [G_sharp1, G_sharp2, G_sharp3, G_sharp4, G_sharp5, G_sharp6, G_sharp7] then + + else if List.member note [ G_sharp1, G_sharp2, G_sharp3, G_sharp4, G_sharp5, G_sharp6, G_sharp7 ] then G_sharp - else if List.member note [A1, A2, A3, A4, A5, A6, A7] then + + else if List.member note [ A1, A2, A3, A4, A5, A6, A7 ] then A - else if List.member note [A_sharp1, A_sharp2, A_sharp3, A_sharp4, A_sharp5, A_sharp6, A_sharp7] then + + else if List.member note [ A_sharp1, A_sharp2, A_sharp3, A_sharp4, A_sharp5, A_sharp6, A_sharp7 ] then A_sharp + else B -{-| Return a list of the notes that comprise a `chord` -} + +{-| Return a list of the notes that comprise a `chord` +-} notesForChord : Chord -> Maybe (List Note) -notesForChord {note, chordType} = - case applySteps (intervalsForChordType chordType) note of - Nothing -> Nothing - Just notes -> Just <| note::notes +notesForChord { note, chordType, chordInversion } = + intervalsForChordType chordType chordInversion + |> List.map (\interval -> step interval note) + |> Maybe.Extra.combine + |> Maybe.map (\notes -> note :: notes) + -{-| Return the scale for a given `key` -} +{-| Return the scale for a given `key` +-} notesForKey : Key -> List Note -notesForKey {noteClass, mode} = - let origin = noteInCentralOctave noteClass - in case applySteps (intervalsForMode mode) origin of - -- We should never hit the Nothing case here. - Nothing -> [] - Just scale -> scale - -{-| Return a list of all of the notes that we know about. -} -allNotes : List Note -allNotes = - [ C1 , C_sharp1 , D1 , D_sharp1 , E1 , F1 , F_sharp1 , G1 , G_sharp1 , A1 , A_sharp1 , B1 - , C2 , C_sharp2 , D2 , D_sharp2 , E2 , F2 , F_sharp2 , G2 , G_sharp2 , A2 , A_sharp2 , B2 - , C3 , C_sharp3 , D3 , D_sharp3 , E3 , F3 , F_sharp3 , G3 , G_sharp3 , A3 , A_sharp3 , B3 - , C4 , C_sharp4 , D4 , D_sharp4 , E4 , F4 , F_sharp4 , G4 , G_sharp4 , A4 , A_sharp4 , B4 - , C5 , C_sharp5 , D5 , D_sharp5 , E5 , F5 , F_sharp5 , G5 , G_sharp5 , A5 , A_sharp5 , B5 - , C6 , C_sharp6 , D6 , D_sharp6 , E6 , F6 , F_sharp6 , G6 , G_sharp6 , A6 , A_sharp6 , B6 - , C7 , C_sharp7 , D7 , D_sharp7 , E7 , F7 , F_sharp7 , G7 , G_sharp7 , A7 , A_sharp7 , B7 - , C8 - ] - -{-| Return a list of all of the chords that we know about. -} -allChords : List Chord -allChords = - let notes = allNotes - chordTypes = [ Major - , Major7 - , MajorDominant7 - , Minor - , Minor7 - , MinorDominant7 - , Augmented - , Augmented7 - , Diminished - , Diminished7 - ] - chordPositions = [ First - , Second - , Third - , Fourth - ] in +notesForKey { noteClass, mode } = + let + origin = + noteInCentralOctave noteClass + in + case applySteps (intervalsForMode mode) origin of + -- We should never hit the Nothing case here. + Nothing -> + [] + + Just scale -> + scale + + +{-| Return true if `note` is a black key. +-} +isAccidental : Note -> Bool +isAccidental note = + case classifyNote note of + C -> + False + + C_sharp -> + True + + D -> + False + + D_sharp -> + True + + E -> + False + + F -> + False + + F_sharp -> + True + + G -> + False + + G_sharp -> + True + + A -> + False + + A_sharp -> + True + + B -> + False + + +{-| Return true if `note` is a white key. +-} +isNatural : Note -> Bool +isNatural note = + note |> isAccidental |> not + + +{-| Return a list of all of the notes that we know about. +Only return the notes within the range `start` and `end`. +-} +notesFromRange : Note -> Note -> List Note +notesFromRange start end = + [ C1 + , C_sharp1 + , D1 + , D_sharp1 + , E1 + , F1 + , F_sharp1 + , G1 + , G_sharp1 + , A1 + , A_sharp1 + , B1 + , C2 + , C_sharp2 + , D2 + , D_sharp2 + , E2 + , F2 + , F_sharp2 + , G2 + , G_sharp2 + , A2 + , A_sharp2 + , B2 + , C3 + , C_sharp3 + , D3 + , D_sharp3 + , E3 + , F3 + , F_sharp3 + , G3 + , G_sharp3 + , A3 + , A_sharp3 + , B3 + , C4 + , C_sharp4 + , D4 + , D_sharp4 + , E4 + , F4 + , F_sharp4 + , G4 + , G_sharp4 + , A4 + , A_sharp4 + , B4 + , C5 + , C_sharp5 + , D5 + , D_sharp5 + , E5 + , F5 + , F_sharp5 + , G5 + , G_sharp5 + , A5 + , A_sharp5 + , B5 + , C6 + , C_sharp6 + , D6 + , D_sharp6 + , E6 + , F6 + , F_sharp6 + , G6 + , G_sharp6 + , A6 + , A_sharp6 + , B6 + , C7 + , C_sharp7 + , D7 + , D_sharp7 + , E7 + , F7 + , F_sharp7 + , G7 + , G_sharp7 + , A7 + , A_sharp7 + , B7 + , C8 + ] + |> List.Extra.dropWhile ((/=) start) + |> List.Extra.takeWhile ((/=) end) + + +{-| Return a list of all of the chords that we know about. +Only create chords from the range of notes delimited by the range `start` and +`end`. +-} +allChords : Note -> Note -> List Chord +allChords start end = + let + notes = + notesFromRange start end + + chordTypes = + [ Major + ] + + chordInversions = + [ Root + , First + ] + in notes - |> List.Extra.andThen (\note -> chordTypes - |> List.Extra.andThen (\chordType -> chordPositions - |> List.Extra.andThen (\chordPosition -> [{ note = note - , chordType = chordType - , chordPosition = chordPosition - }]))) + |> List.Extra.andThen + (\note -> + chordTypes + |> List.Extra.andThen + (\chordType -> + chordInversions + |> List.Extra.andThen + (\chordInversion -> + [ { note = note + , chordType = chordType + , chordInversion = chordInversion + } + ] + ) + ) + ) + + +{-| Serialize a human-readable format of `note`. +-} +viewNote : Note -> String +viewNote note = + case note of + C1 -> + "C1" + + C_sharp1 -> + "C♯/D♭1" + + D1 -> + "D1" + + D_sharp1 -> + "D♯/E♭1" + + E1 -> + "E1" + + F1 -> + "F1" + + F_sharp1 -> + "F♯/G♭1" + + G1 -> + "G1" + + G_sharp1 -> + "G♯/A♭1" + + A1 -> + "A1" + + A_sharp1 -> + "A♯/B♭1" + + B1 -> + "B1" + + C2 -> + "C2" + + C_sharp2 -> + "C♯/D♭2" + + D2 -> + "D2" + + D_sharp2 -> + "D♯/E♭2" + + E2 -> + "E2" + + F2 -> + "F2" + + F_sharp2 -> + "F♯/G♭2" + + G2 -> + "G2" + + G_sharp2 -> + "G♯/A♭2" + + A2 -> + "A2" + + A_sharp2 -> + "A♯/B♭2" + + B2 -> + "B2" + + C3 -> + "C3" + + C_sharp3 -> + "C♯/D♭3" + + D3 -> + "D3" + + D_sharp3 -> + "D♯/E♭3" + + E3 -> + "E3" + + F3 -> + "F3" + + F_sharp3 -> + "F♯/G♭3" + + G3 -> + "G3" + + G_sharp3 -> + "G♯/A♭3" + + A3 -> + "A3" + + A_sharp3 -> + "A♯/B♭3" + + B3 -> + "B3" + + C4 -> + "C4" + + C_sharp4 -> + "C♯/D♭4" + + D4 -> + "D4" + + D_sharp4 -> + "D♯/E♭4" + + E4 -> + "E4" + + F4 -> + "F4" + + F_sharp4 -> + "F♯/G♭4" + + G4 -> + "G4" + + G_sharp4 -> + "G♯/A♭4" + + A4 -> + "A4" + + A_sharp4 -> + "A♯/B♭4" + + B4 -> + "B4" + + C5 -> + "C5" + + C_sharp5 -> + "C♯/D♭5" + + D5 -> + "D5" + + D_sharp5 -> + "D♯/E♭5" + + E5 -> + "E5" + + F5 -> + "F5" + + F_sharp5 -> + "F♯/G♭5" + + G5 -> + "G5" + + G_sharp5 -> + "G♯/A♭5" + + A5 -> + "A5" + + A_sharp5 -> + "A♯/B♭5" + + B5 -> + "B5" + + C6 -> + "C6" + + C_sharp6 -> + "C♯/D♭6" + + D6 -> + "D6" + + D_sharp6 -> + "D♯/E♭6" + + E6 -> + "E6" + + F6 -> + "F6" + + F_sharp6 -> + "F♯/G♭6" + + G6 -> + "G6" + + G_sharp6 -> + "G♯/A♭6" + + A6 -> + "A6" + + A_sharp6 -> + "A♯/B♭6" + + B6 -> + "B6" + + C7 -> + "C7" + + C_sharp7 -> + "C♯/D♭7" + + D7 -> + "D7" + + D_sharp7 -> + "D♯/E♭7" + + E7 -> + "E7" + + F7 -> + "F7" + + F_sharp7 -> + "F♯/G♭7" + + G7 -> + "G7" + + G_sharp7 -> + "G♯/A♭7" + + A7 -> + "A7" + + A_sharp7 -> + "A♯/B♭7" + + B7 -> + "B7" + + C8 -> + "C8" + + +inspectChord : Chord -> String +inspectChord { note, chordType, chordInversion } = + viewNote note + ++ " " + ++ (case chordType of + Major -> + "major" + + Major7 -> + "major 7th" + + MajorDominant7 -> + "major dominant 7th" + + Minor -> + "minor" + + MinorMajor7 -> + "minor major 7th" + + MinorDominant7 -> + "minor dominant 7th" + + Augmented -> + "augmented" + + AugmentedDominant7 -> + "augmented dominant 7th" + + Diminished -> + "diminished" + + DiminishedDominant7 -> + "diminished dominant 7th" + + DiminishedMajor7 -> + "diminished major 7th" + ) + ++ " " + ++ (case chordInversion of + Root -> + "root position" + + First -> + "1st inversion" + + Second -> + "2nd inversion" + ) + + +viewChord : Chord -> String +viewChord { note, chordType, chordInversion } = + viewNoteClass (classifyNote note) + ++ " " + ++ (case chordType of + Major -> + "major" + + Major7 -> + "major 7th" + + MajorDominant7 -> + "major dominant 7th" + + Minor -> + "minor" + + MinorMajor7 -> + "minor 7th" + + MinorDominant7 -> + "minor dominant 7th" + + Augmented -> + "augmented" + + AugmentedDominant7 -> + "augmented 7th" + + Diminished -> + "diminished" + + DiminishedDominant7 -> + "diminished 7th" + + DiminishedMajor7 -> + "diminished major 7th" + ) + ++ " " + ++ (case chordInversion of + Root -> + "root position" + + First -> + "1st inversion" + + Second -> + "2nd inversion" + ) + + +{-| Serialize a human-readable format of `noteClass`. +-} +viewNoteClass : NoteClass -> String +viewNoteClass noteClass = + case noteClass of + C -> + "C" + + C_sharp -> + "C♯/D♭" + + D -> + "D" + + D_sharp -> + "D♯/E♭" + + E -> + "E" + + F -> + "F" + + F_sharp -> + "F♯/G♭" + + G -> + "G" + + G_sharp -> + "G♯/A♭" + + A -> + "A" + + A_sharp -> + "A♯/B♭" + + B -> + "B" |