diff options
| -rw-r--r-- | website/sandbox/chord-drill-sergeant/src/Main.elm | 63 | ||||
| -rw-r--r-- | website/sandbox/chord-drill-sergeant/src/Theory.elm | 154 |
2 files changed, 112 insertions, 105 deletions
diff --git a/website/sandbox/chord-drill-sergeant/src/Main.elm b/website/sandbox/chord-drill-sergeant/src/Main.elm index f551d11e0d3d..8d4d51eb3b71 100644 --- a/website/sandbox/chord-drill-sergeant/src/Main.elm +++ b/website/sandbox/chord-drill-sergeant/src/Main.elm @@ -15,6 +15,8 @@ import Time exposing (..) type alias Model = { whitelistedChords : List Theory.Chord + , whitelistedChordTypes : List Theory.ChordType + , whitelistedInversions : List Theory.ChordInversion , selectedChord : Theory.Chord , isPaused : Bool , tempo : Int @@ -24,7 +26,6 @@ type alias Model = { enable : Bool , inspectChord : Bool } - , whitelistedInversions : List Theory.ChordInversion } @@ -38,6 +39,7 @@ type Msg | SetTempo String | ToggleInspectChord | ToggleInversion Theory.ChordInversion + | ToggleChordType Theory.ChordType tempoStep : Int @@ -73,7 +75,14 @@ init = ( firstNote, lastNote ) = ( Theory.C3, Theory.C5 ) in - { whitelistedChords = Theory.allChords firstNote lastNote Theory.allInversions + { whitelistedChords = + Theory.allChords + { start = firstNote + , end = lastNote + , inversions = Theory.allInversions + , chordTypes = Theory.allChordTypes + } + , whitelistedChordTypes = Theory.allChordTypes , whitelistedInversions = Theory.allInversions , selectedChord = cmajor , isPaused = True @@ -150,6 +159,28 @@ update msg model = , Cmd.none ) + ToggleChordType chordType -> + let + chordTypes = + if List.member chordType model.whitelistedChordTypes then + List.filter ((/=) chordType) model.whitelistedChordTypes + + else + chordType :: model.whitelistedChordTypes + in + ( { model + | whitelistedChordTypes = chordTypes + , whitelistedChords = + Theory.allChords + { start = model.firstNote + , end = model.lastNote + , inversions = model.whitelistedInversions + , chordTypes = chordTypes + } + } + , Cmd.none + ) + ToggleInversion inversion -> let inversions = @@ -161,7 +192,13 @@ update msg model = in ( { model | whitelistedInversions = inversions - , whitelistedChords = Theory.allChords model.firstNote model.lastNote inversions + , whitelistedChords = + Theory.allChords + { start = model.firstNote + , end = model.lastNote + , inversions = inversions + , chordTypes = model.whitelistedChordTypes + } } , Cmd.none ) @@ -197,6 +234,25 @@ debugger = ] +chordTypeCheckboxes : List Theory.ChordType -> Html Msg +chordTypeCheckboxes chordTypes = + ul [] + (Theory.allChordTypes + |> List.map + (\chordType -> + li [] + [ label [] [ text (Theory.chordTypeName chordType) ] + , input + [ type_ "checkbox" + , onClick (ToggleChordType chordType) + , checked (List.member chordType chordTypes) + ] + [] + ] + ) + ) + + inversionCheckboxes : List Theory.ChordInversion -> Html Msg inversionCheckboxes inversions = ul [] @@ -238,6 +294,7 @@ view model = , handleInput = SetTempo } , inversionCheckboxes model.whitelistedInversions + , chordTypeCheckboxes model.whitelistedChordTypes , playPause model , if model.debug.enable then debugger diff --git a/website/sandbox/chord-drill-sergeant/src/Theory.elm b/website/sandbox/chord-drill-sergeant/src/Theory.elm index b240822999f7..9d39a4cad5be 100644 --- a/website/sandbox/chord-drill-sergeant/src/Theory.elm +++ b/website/sandbox/chord-drill-sergeant/src/Theory.elm @@ -284,6 +284,45 @@ inversionName inversion = "Second" +{-| Return the human-readable version of a chord type. +-} +chordTypeName : ChordType -> String +chordTypeName chordType = + 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" + + {-| Return the note that is one half step away from `note` in the direction, `dir`. In the case of stepping up or down from the end of the piano, this returns a @@ -794,14 +833,17 @@ allChordTypes = Only create chords from the range of notes delimited by the range `start` and `end`. -} -allChords : Note -> Note -> List ChordInversion -> List Chord -allChords start end chordInversions = +allChords : + { start : Note + , end : Note + , inversions : List ChordInversion + , chordTypes : List ChordType + } + -> List Chord +allChords { start, end, inversions, chordTypes } = let notes = notesFromRange start end - - chordTypes = - allChordTypes in notes |> List.Extra.andThen @@ -809,12 +851,12 @@ allChords start end chordInversions = chordTypes |> List.Extra.andThen (\chordType -> - chordInversions + inversions |> List.Extra.andThen - (\chordInversion -> + (\inversion -> [ { note = note , chordType = chordType - , chordInversion = chordInversion + , chordInversion = inversion } ] ) @@ -1085,104 +1127,12 @@ viewNote note = 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" - ) + viewNote note ++ " " ++ chordTypeName chordType ++ " " ++ inversionName chordInversion ++ " position" 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" - ) + viewNoteClass (classifyNote note) ++ " " ++ chordTypeName chordType ++ " " ++ inversionName chordInversion ++ " position" {-| Serialize a human-readable format of `noteClass`. |