diff options
Diffstat (limited to 'website/sandbox/chord-drill-sergeant')
| -rw-r--r-- | website/sandbox/chord-drill-sergeant/elm.json | 8 | ||||
| -rw-r--r-- | website/sandbox/chord-drill-sergeant/src/Main.elm | 275 | ||||
| -rw-r--r-- | website/sandbox/chord-drill-sergeant/src/Piano.elm | 69 | ||||
| -rw-r--r-- | website/sandbox/chord-drill-sergeant/src/Theory.elm | 209 |
4 files changed, 345 insertions, 216 deletions
diff --git a/website/sandbox/chord-drill-sergeant/elm.json b/website/sandbox/chord-drill-sergeant/elm.json index dea3450db112..b116a66a0f6d 100644 --- a/website/sandbox/chord-drill-sergeant/elm.json +++ b/website/sandbox/chord-drill-sergeant/elm.json @@ -8,13 +8,17 @@ "direct": { "elm/browser": "1.0.2", "elm/core": "1.0.5", - "elm/html": "1.0.0" + "elm/html": "1.0.0", + "elm/random": "1.0.0", + "elm-community/list-extra": "8.2.3", + "elm-community/random-extra": "3.1.0" }, "indirect": { "elm/json": "1.1.3", "elm/time": "1.0.0", "elm/url": "1.0.0", - "elm/virtual-dom": "1.0.2" + "elm/virtual-dom": "1.0.2", + "owanturist/elm-union-find": "1.0.0" } }, "test-dependencies": { diff --git a/website/sandbox/chord-drill-sergeant/src/Main.elm b/website/sandbox/chord-drill-sergeant/src/Main.elm index 4fdb30226baf..8878a7ceecf1 100644 --- a/website/sandbox/chord-drill-sergeant/src/Main.elm +++ b/website/sandbox/chord-drill-sergeant/src/Main.elm @@ -4,203 +4,96 @@ import Browser import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (..) +import Random +import Random.List import Piano - -{-| Notes are the individuals sounds that we use to create music. Think: "do re -mi fa so la ti do". - -Note: Technically a "C-sharp" is also a "D-flat", but I will model accidentals -(i.e. sharps and flats) as sharps and represent the ambiguity when I render the -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 = C - | C_sharp - | D - | D_sharp - | E - | F - | F_sharp - | G - | G_sharp - | A - | A_sharp - | B - -{-| 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, -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 - -{-| One can measure the difference between between notes using intervals. -} -type Interval = Half - | Whole - | MajorThird - | MinorThird - -{-| Songs are written in one or more keys, which define the notes and therefore -chords that harmonize with one another. -} -type Key = Key (Note, Mode) - -{-| A bundle of notes which are usually, but not necessarily harmonious. -} -type Chord = Chord (Note, ChordType, ChordPosition) - -{-| 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 - -{-| 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 - -{-| Encode whether you are traversing "up" or "down" intervals -} -type StepDirection = Up | Down - -{-| 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 = - 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 -> Note -step dir s note = - let - doHalfStep = halfStep dir - in - case s of - Half -> doHalfStep note - Whole -> doHalfStep note |> doHalfStep - MinorThird -> doHalfStep note |> doHalfStep |> doHalfStep - MajorThird -> doHalfStep note |> doHalfStep |> doHalfStep |> doHalfStep - -{-| Return the note that is one half step away from `note` in the direction, -`dir`. --} -halfStep : StepDirection -> Note -> Note -halfStep dir note = - case (dir, note) of - -- C - (Up, C) -> C_sharp - (Down, C) -> B - -- C# - (Up, C_sharp) -> D - (Down, C_sharp) -> C - -- D - (Up, D) -> D_sharp - (Down, D) -> C_sharp - -- D_sharp - (Up, D_sharp) -> E - (Down, D_sharp) -> D - -- E - (Up, E) -> F - (Down, E) -> D_sharp - -- F - (Up, F) -> F_sharp - (Down, F) -> E - -- F# - (Up, F_sharp) -> G - (Down, F_sharp) -> F - -- G - (Up, G) -> G_sharp - (Down, G) -> F_sharp - -- G# - (Up, G_sharp) -> A - (Down, G_sharp) -> A - -- A - (Up, A) -> A_sharp - (Down, A) -> G_sharp - -- A# - (Up, A_sharp) -> B - (Down, A_sharp) -> A - -- B - (Up, B) -> C - (Down, B) -> A_sharp - -{-| Returns a list of all of the notes up from a give `note` -} -applySteps : List Interval -> Note -> List Note -applySteps steps note = - case List.foldl (\s (prev, result) -> ((step Up s prev), (step Up s prev :: result))) (note, []) steps of - (_, result) -> List.reverse result - -{-| Return the scale for a given `key` -} -notesForKey : Key -> List Note -notesForKey key = - case key of - Key (note, mode) -> applySteps (intervalsForKeyMode mode) note - -{-| Return a list of the notes that comprise a `chord` -} -notesForChord : Chord -> List Note -notesForChord chord = - case chord of - -- TODO(wpcarro): Use the Position to rotate the chord n times - Chord (note, chordType, _) -> applySteps (intervalsForChordType chordType) note +import Theory + +type State = State { whitelistedChords : List Theory.Chord + , selectedChord : Theory.Chord + } + +type Msg = NextChord + | NewChord Theory.Chord + +viewChord : Theory.Chord -> String +viewChord (Theory.Chord (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") {-| Serialize a human-readable format of `note` -} -viewNote : Note -> String +viewNote : Theory.Note -> String viewNote note = case note 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" + 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" + +cmajor : Theory.Chord +cmajor = Theory.Chord (Theory.C, Theory.Major, Theory.First) + +{-| The initial state for the application. -} +initialState : State +initialState = + State { whitelistedChords = Theory.allChords + , selectedChord = cmajor + } + +{-| Now that we have state, we need a function to change the state. -} +update : Msg -> State -> (State, Cmd Msg) +update msg (State {whitelistedChords, selectedChord}) = + case msg of + NewChord chord -> ( State { whitelistedChords = whitelistedChords + , selectedChord = chord + } + , Cmd.none + ) + NextChord -> ( State { whitelistedChords = whitelistedChords + , selectedChord = selectedChord + } + , Random.generate (\x -> + case x of + (Just chord, _) -> NewChord chord + (Nothing, _) -> NewChord cmajor) + (Random.List.choose whitelistedChords) + ) + +view : State -> Html Msg +view (State {selectedChord}) = + div [] [ p [] [ text (viewChord selectedChord) ] + , button [ onClick NextChord ] [ text "Next Chord" ] + , Piano.render { highlight = [] } + ] {-| For now, I'm just dumping things onto the page to sketch ideas. -} main = - let - key = Key (D, MinorMode) - chord = Chord (D, Major, First) - in - div [] [ ul [] (notesForKey key |> List.map (\n -> li [] [ text (viewNote n) ])) - , ul [] (notesForChord chord |> List.map (\n -> li [] [ text (viewNote n) ])) - , Piano.render - ] + Browser.element { init = \() -> (initialState, Cmd.none) + , subscriptions = \_ -> Sub.none + , update = update + , view = view + } diff --git a/website/sandbox/chord-drill-sergeant/src/Piano.elm b/website/sandbox/chord-drill-sergeant/src/Piano.elm index 7c44f4bf4f6f..ba034d47cccf 100644 --- a/website/sandbox/chord-drill-sergeant/src/Piano.elm +++ b/website/sandbox/chord-drill-sergeant/src/Piano.elm @@ -5,42 +5,65 @@ import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (..) +import Theory + {-| These are the white keys on most modern pianos. -} -natural : Html a -natural = - li [ style "background-color" "white" +natural : Bool -> Html a +natural isHighlit = + li [ style "background-color" (if isHighlit then "red" else "white") , style "height" "20px" , style "border-top" "1px solid black" + , style "border-bottom" "1px solid black" ] [] {-| These are the black keys on most modern pianos. -} -accidental : Html a -accidental = - li [ style "background-color" "black" +accidental : Bool -> Html a +accidental isHighlit = + li [ style "background-color" (if isHighlit then "red" else "black") , style "height" "10px" , style "width" "66%" ] [] {-| 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 (Html a) -octave = [ natural - , accidental - , natural - , accidental - , natural - , natural - , accidental - , natural - , accidental - , natural - , accidental - , natural - ] +octave : List Theory.Note -> List (Html a) +octave highlight = + let + isHighlit note = List.member note highlight + in + [ natural (isHighlit Theory.C) + , accidental (isHighlit Theory.C_sharp) + , natural (isHighlit Theory.D) + , accidental (isHighlit Theory.D_sharp) + , natural (isHighlit Theory.E) + , natural (isHighlit Theory.F) + , accidental (isHighlit Theory.F_sharp) + , natural (isHighlit Theory.G) + , accidental (isHighlit Theory.G_sharp) + , natural (isHighlit Theory.A) + , accidental (isHighlit Theory.A_sharp) + , natural (isHighlit Theory.B) + ] + +indexForNote : Theory.Note -> Int +indexForNote note = + case note of + Theory.C -> 0 + Theory.C_sharp -> 1 + Theory.D -> 2 + Theory.D_sharp -> 3 + Theory.E -> 4 + Theory.F -> 5 + Theory.F_sharp -> 6 + Theory.G -> 7 + Theory.G_sharp -> 8 + Theory.A -> 9 + Theory.A_sharp -> 10 + Theory.B -> 11 {-| Return the HTML that renders a piano representation. -} -render : Html a -render = +render : { highlight : List Theory.Note } -> Html a +render {highlight} = ul [ style "width" "100px" , style "list-style" "none" - ] (octave |> List.repeat 3 |> List.concat) + ] (octave highlight |> List.reverse |> List.repeat 1 |> List.concat) diff --git a/website/sandbox/chord-drill-sergeant/src/Theory.elm b/website/sandbox/chord-drill-sergeant/src/Theory.elm new file mode 100644 index 000000000000..c80fffc39f3c --- /dev/null +++ b/website/sandbox/chord-drill-sergeant/src/Theory.elm @@ -0,0 +1,209 @@ +module Theory exposing (..) + +import List.Extra + +{-| Notes are the individuals sounds that we use to create music. Think: "do re +mi fa so la ti do". + +Note: Technically a "C-sharp" is also a "D-flat", but I will model accidentals +(i.e. sharps and flats) as sharps and represent the ambiguity when I render the +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 = 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. -} +type Chord = Chord (Note, ChordType, ChordPosition) + +{-| 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 + +{-| 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 + +{-| Songs are written in one or more keys, which define the notes and therefore +chords that harmonize with one another. -} +type Key = Key (Note, 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, +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 + +{-| Return the note that is one half step away from `note` in the direction, +`dir`. +-} +halfStep : StepDirection -> Note -> Note +halfStep dir note = + case (dir, note) of + -- C + (Up, C) -> C_sharp + (Down, C) -> B + -- C# + (Up, C_sharp) -> D + (Down, C_sharp) -> C + -- D + (Up, D) -> D_sharp + (Down, D) -> C_sharp + -- D_sharp + (Up, D_sharp) -> E + (Down, D_sharp) -> D + -- E + (Up, E) -> F + (Down, E) -> D_sharp + -- F + (Up, F) -> F_sharp + (Down, F) -> E + -- F# + (Up, F_sharp) -> G + (Down, F_sharp) -> F + -- G + (Up, G) -> G_sharp + (Down, G) -> F_sharp + -- G# + (Up, G_sharp) -> A + (Down, G_sharp) -> A + -- A + (Up, A) -> A_sharp + (Down, A) -> G_sharp + -- A# + (Up, A_sharp) -> B + (Down, A_sharp) -> A + -- B + (Up, B) -> C + (Down, B) -> A_sharp +{-| 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 = + 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 -> Note +step dir s note = + let + doHalfStep = halfStep dir + in + case s of + Half -> doHalfStep note + Whole -> doHalfStep note |> doHalfStep + MinorThird -> doHalfStep note |> doHalfStep |> doHalfStep + MajorThird -> doHalfStep note |> doHalfStep |> doHalfStep |> doHalfStep + +{-| Returns a list of all of the notes up from a give `note` -} +applySteps : List Interval -> Note -> List Note +applySteps steps note = + case List.foldl (\s (prev, result) -> ((step Up s prev), (step Up s prev :: result))) (note, []) steps of + (_, result) -> List.reverse result + +{-| Return a list of the notes that comprise a `chord` -} +notesForChord : Chord -> List Note +notesForChord chord = + case chord of + -- TODO(wpcarro): Use the Position to rotate the chord n times + Chord (note, chordType, _) -> note :: applySteps (intervalsForChordType chordType) note + +{-| Return the scale for a given `key` -} +notesForKey : Key -> List Note +notesForKey key = + case key of + Key (note, mode) -> applySteps (intervalsForMode mode) note + +{-| Return a list of all of the chords that we know about. -} +allChords : List Chord +allChords = + let notes = [ C + , C_sharp + , D + , D_sharp + , E + , F + , F_sharp + , G + , G_sharp + , A + , A_sharp + , B + ] + chordTypes = [ Major + , Major7 + , MajorDominant7 + , Minor + , Minor7 + , MinorDominant7 + , Augmented + , Augmented7 + , Diminished + , Diminished7 + ] + chordPositions = [ First + , Second + , Third + , Fourth + ] in + notes + |> List.Extra.andThen (\note -> chordTypes + |> List.Extra.andThen (\chordType -> chordPositions + |> List.Extra.andThen (\chordPosition -> [Chord (note, chordType, chordPosition)]))) |