diff options
Diffstat (limited to 'website/sandbox/learnpianochords/src')
| -rw-r--r-- | website/sandbox/learnpianochords/src/ChordInspector.elm | 15 | ||||
| -rw-r--r-- | website/sandbox/learnpianochords/src/Icon.elm | 44 | ||||
| -rw-r--r-- | website/sandbox/learnpianochords/src/Main.elm | 555 | ||||
| -rw-r--r-- | website/sandbox/learnpianochords/src/Misc.elm | 47 | ||||
| -rw-r--r-- | website/sandbox/learnpianochords/src/Piano.elm | 238 | ||||
| -rw-r--r-- | website/sandbox/learnpianochords/src/Tempo.elm | 24 | ||||
| -rw-r--r-- | website/sandbox/learnpianochords/src/Theory.elm | 1100 | ||||
| -rw-r--r-- | website/sandbox/learnpianochords/src/UI.elm | 116 |
8 files changed, 2139 insertions, 0 deletions
diff --git a/website/sandbox/learnpianochords/src/ChordInspector.elm b/website/sandbox/learnpianochords/src/ChordInspector.elm new file mode 100644 index 000000000000..f43b534eb013 --- /dev/null +++ b/website/sandbox/learnpianochords/src/ChordInspector.elm @@ -0,0 +1,15 @@ +module ChordInspector exposing (render) + +import Html exposing (..) +import NoteInspector +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 -> + NoteInspector.render notes diff --git a/website/sandbox/learnpianochords/src/Icon.elm b/website/sandbox/learnpianochords/src/Icon.elm new file mode 100644 index 000000000000..2c8626b09293 --- /dev/null +++ b/website/sandbox/learnpianochords/src/Icon.elm @@ -0,0 +1,44 @@ +module Icon exposing (..) + +import Svg exposing (node, svg) +import Svg.Attributes exposing (..) +import UI + + +svgColor color = + let + classes = + case color of + UI.Primary -> + [ "text-gray-500", "fill-current" ] + + UI.Secondary -> + [ "text-gray-300", "fill-current" ] + in + class <| String.join " " classes + + +cog = + svg [ class "icon-cog", viewBox "0 0 24 24", xmlLang "http://www.w3.org/2000/svg" ] + [ Svg.path + [ svgColor UI.Primary + , d "M6.8 3.45c.87-.52 1.82-.92 2.83-1.17a2.5 2.5 0 0 0 4.74 0c1.01.25 1.96.65 2.82 1.17a2.5 2.5 0 0 0 3.36 3.36c.52.86.92 1.8 1.17 2.82a2.5 2.5 0 0 0 0 4.74c-.25 1.01-.65 1.96-1.17 2.82a2.5 2.5 0 0 0-3.36 3.36c-.86.52-1.8.92-2.82 1.17a2.5 2.5 0 0 0-4.74 0c-1.01-.25-1.96-.65-2.82-1.17a2.5 2.5 0 0 0-3.36-3.36 9.94 9.94 0 0 1-1.17-2.82 2.5 2.5 0 0 0 0-4.74c.25-1.01.65-1.96 1.17-2.82a2.5 2.5 0 0 0 3.36-3.36zM12 16a4 4 0 1 0 0-8 4 4 0 0 0 0 8z" + , fill "red" + ] + [] + , node "circle" + [ svgColor UI.Secondary, cx "12", cy "12", r "2" ] + [] + ] + + +close = + svg [ class "icon-close", viewBox "0 0 24 24", xmlLang "http://www.w3.org/2000/svg" ] + [ Svg.path + [ svgColor UI.Primary + , d "M15.78 14.36a1 1 0 0 1-1.42 1.42l-2.82-2.83-2.83 2.83a1 1 0 1 1-1.42-1.42l2.83-2.82L7.3 8.7a1 1 0 0 1 1.42-1.42l2.83 2.83 2.82-2.83a1 1 0 0 1 1.42 1.42l-2.83 2.83 2.83 2.82z" + , fill "red" + , fillRule "evenodd" + ] + [] + ] diff --git a/website/sandbox/learnpianochords/src/Main.elm b/website/sandbox/learnpianochords/src/Main.elm new file mode 100644 index 000000000000..054d318a08b1 --- /dev/null +++ b/website/sandbox/learnpianochords/src/Main.elm @@ -0,0 +1,555 @@ +module Main exposing (main) + +import Browser +import Html exposing (..) +import Html.Attributes exposing (..) +import Html.Events exposing (..) +import Icon +import Piano +import Random +import Random.List +import Tempo +import Theory +import Time exposing (..) +import UI + + +type alias Model = + { whitelistedChords : List Theory.Chord + , whitelistedChordTypes : List Theory.ChordType + , whitelistedInversions : List Theory.ChordInversion + , whitelistedPitchClasses : List Theory.PitchClass + , whitelistedKeys : List Theory.Key + , selectedChord : Maybe Theory.Chord + , isPaused : Bool + , tempo : Int + , firstNote : Theory.Note + , lastNote : Theory.Note + , practiceMode : PracticeMode + , view : View + } + + +type View + = Preferences + | Practice + + +{-| Control the type of practice you'd like. +-} +type PracticeMode + = KeyMode + | FineTuneMode + + +type Msg + = NextChord + | NewChord Theory.Chord + | Play + | Pause + | IncreaseTempo + | DecreaseTempo + | SetTempo String + | ToggleInversion Theory.ChordInversion + | ToggleChordType Theory.ChordType + | TogglePitchClass Theory.PitchClass + | ToggleKey Theory.Key + | DoNothing + | SetPracticeMode PracticeMode + | SelectAllKeys + | DeselectAllKeys + | SetView View + + +{-| The amount by which we increase or decrease tempo. +-} +tempoStep : Int +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) + + +{-| The initial state for the application. +-} +init : Model +init = + let + ( firstNote, lastNote ) = + ( Theory.C3, Theory.C6 ) + + inversions = + Theory.allInversions + + chordTypes = + Theory.allChordTypes + + pitchClasses = + Theory.allPitchClasses + + keys = + [] + + practiceMode = + KeyMode + in + { practiceMode = practiceMode + , whitelistedChords = + case practiceMode of + KeyMode -> + keys |> List.concatMap Theory.chordsForKey + + FineTuneMode -> + Theory.allChords + { start = firstNote + , end = lastNote + , inversions = inversions + , chordTypes = chordTypes + , pitchClasses = pitchClasses + } + , whitelistedChordTypes = chordTypes + , whitelistedInversions = inversions + , whitelistedPitchClasses = pitchClasses + , whitelistedKeys = keys + , selectedChord = Nothing + , isPaused = True + , tempo = 20 + , firstNote = firstNote + , lastNote = lastNote + , view = Preferences + } + + +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 ) +update msg model = + case msg of + DoNothing -> + ( model, Cmd.none ) + + SetPracticeMode practiceMode -> + ( { model + | practiceMode = practiceMode + , isPaused = True + } + , Cmd.none + ) + + SetView x -> + ( { model + | view = x + , isPaused = True + } + , Cmd.none + ) + + SelectAllKeys -> + ( { model + | whitelistedKeys = Theory.allKeys + , whitelistedChords = + Theory.allKeys |> List.concatMap Theory.chordsForKey + } + , Cmd.none + ) + + DeselectAllKeys -> + ( { model + | whitelistedKeys = [] + , whitelistedChords = [] + } + , Cmd.none + ) + + NewChord chord -> + ( { model | selectedChord = Just chord } + , Cmd.none + ) + + NextChord -> + ( model + , Random.generate + (\x -> + case x of + ( Just chord, _ ) -> + NewChord chord + + ( Nothing, _ ) -> + DoNothing + ) + (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 + ) + + 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 + , pitchClasses = model.whitelistedPitchClasses + } + } + , Cmd.none + ) + + ToggleInversion inversion -> + let + inversions = + if List.member inversion model.whitelistedInversions then + List.filter ((/=) inversion) model.whitelistedInversions + + else + inversion :: model.whitelistedInversions + in + ( { model + | whitelistedInversions = inversions + , whitelistedChords = + Theory.allChords + { start = model.firstNote + , end = model.lastNote + , inversions = inversions + , chordTypes = model.whitelistedChordTypes + , pitchClasses = model.whitelistedPitchClasses + } + } + , Cmd.none + ) + + TogglePitchClass pitchClass -> + let + pitchClasses = + if List.member pitchClass model.whitelistedPitchClasses then + List.filter ((/=) pitchClass) model.whitelistedPitchClasses + + else + pitchClass :: model.whitelistedPitchClasses + in + ( { model + | whitelistedPitchClasses = pitchClasses + , whitelistedChords = + Theory.allChords + { start = model.firstNote + , end = model.lastNote + , inversions = model.whitelistedInversions + , chordTypes = model.whitelistedChordTypes + , pitchClasses = pitchClasses + } + } + , Cmd.none + ) + + ToggleKey key -> + let + keys = + if List.member key model.whitelistedKeys then + List.filter ((/=) key) model.whitelistedKeys + + else + key :: model.whitelistedKeys + in + ( { model + | whitelistedKeys = keys + , whitelistedChords = + keys |> List.concatMap Theory.chordsForKey + } + , 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" ] + + +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 [] + (Theory.allInversions + |> List.map + (\inversion -> + li [] + [ label [] [ text (Theory.inversionName inversion) ] + , input + [ type_ "checkbox" + , onClick (ToggleInversion inversion) + , checked (List.member inversion inversions) + ] + [] + ] + ) + ) + + +selectKey : + Model + -> + { relativeMajor : Theory.Key + , relativeMinor : Theory.Key + } + -> Html Msg +selectKey model { relativeMajor, relativeMinor } = + let + active key = + List.member key model.whitelistedKeys + + buttonLabel major minor = + Theory.viewKey major ++ ", " ++ Theory.viewKey minor + in + div [ class "flex pt-0" ] + [ UI.textToggleButton + { label = buttonLabel relativeMajor relativeMinor + , handleClick = ToggleKey relativeMinor + , classes = [ "flex-1" ] + , toggled = active relativeMinor + } + ] + + +keyCheckboxes : Model -> Html Msg +keyCheckboxes model = + let + majorKey pitchClass = + { pitchClass = pitchClass, mode = Theory.MajorMode } + + minorKey pitchClass = + { pitchClass = pitchClass, mode = Theory.MinorMode } + + circleOfFifths = + [ ( Theory.C, Theory.A ) + , ( Theory.G, Theory.E ) + , ( Theory.D, Theory.B ) + , ( Theory.A, Theory.F_sharp ) + , ( Theory.E, Theory.C_sharp ) + , ( Theory.B, Theory.G_sharp ) + , ( Theory.F_sharp, Theory.D_sharp ) + , ( Theory.C_sharp, Theory.A_sharp ) + , ( Theory.G_sharp, Theory.F ) + , ( Theory.D_sharp, Theory.C ) + , ( Theory.A_sharp, Theory.G ) + , ( Theory.F, Theory.D ) + ] + in + div [] + [ h2 [ class "text-gray-500 text-center pt-10 text-5xl" ] [ text "Select keys" ] + , ul [] + (circleOfFifths + |> List.map + (\( major, minor ) -> + selectKey model + { relativeMajor = majorKey major + , relativeMinor = minorKey minor + } + ) + ) + ] + + +practiceModeButtons : Model -> Html Msg +practiceModeButtons model = + div [ class "text-center" ] + [ h2 [ class "py-10 text-5xl" ] [ text "Practice Mode" ] + , div [ class "flex pb-6" ] + [ UI.simpleButton + { label = "Key" + , classes = [ "flex-1", "rounded-r-none" ] + , handleClick = SetPracticeMode KeyMode + , color = + if model.practiceMode == KeyMode then + UI.Primary + + else + UI.Secondary + } + , UI.simpleButton + { label = "Fine Tune" + , handleClick = SetPracticeMode FineTuneMode + , classes = [ "flex-1", "rounded-l-none" ] + , color = + if model.practiceMode == FineTuneMode then + UI.Primary + + else + UI.Secondary + } + ] + ] + + +openPreferences : Html Msg +openPreferences = + button + [ class "w-48 h-48 absolute left-0 top-0 z-20" + , onClick (SetView Preferences) + ] + [ Icon.cog ] + + +closePreferences : Html Msg +closePreferences = + button + [ class "w-48 h-48 absolute right-0 top-0 z-10" + , onClick (SetView Practice) + ] + [ Icon.close ] + + +preferences : Model -> Html Msg +preferences model = + div [ class "pt-10 pb-20 px-10" ] + [ closePreferences + , Tempo.render + { tempo = model.tempo + , handleInput = SetTempo + } + , case model.practiceMode of + KeyMode -> + keyCheckboxes model + + FineTuneMode -> + div [] + [ inversionCheckboxes model.whitelistedInversions + , chordTypeCheckboxes model.whitelistedChordTypes + ] + ] + + +practice : Model -> Html Msg +practice model = + let + classes = + [ "bg-gray-600" + , "h-screen" + , "w-full" + , "absolute" + , "z-10" + , "text-6xl" + ] + + ( handleClick, extraClasses, buttonText ) = + if model.isPaused then + ( Play, [ "opacity-50" ], "Press to practice" ) + + else + ( Pause, [ "opacity-0" ], "" ) + in + div [] + [ button + [ [ classes, extraClasses ] |> List.concat |> UI.tw |> class + , onClick handleClick + ] + [ text buttonText + ] + , openPreferences + , Piano.render + { highlight = model.selectedChord |> Maybe.andThen Theory.notesForChord |> Maybe.withDefault [] + , start = model.firstNote + , end = model.lastNote + } + ] + + +view : Model -> Html Msg +view model = + case model.view of + Preferences -> + preferences model + + Practice -> + practice model + + +{-| 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 + } diff --git a/website/sandbox/learnpianochords/src/Misc.elm b/website/sandbox/learnpianochords/src/Misc.elm new file mode 100644 index 000000000000..52f957ad528f --- /dev/null +++ b/website/sandbox/learnpianochords/src/Misc.elm @@ -0,0 +1,47 @@ +module Misc exposing (..) + +import Array exposing (Array) + + +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) + + +comesBefore : a -> List a -> Maybe a +comesBefore x xs = + case xs of + [] -> + Nothing + + _ :: [] -> + Nothing + + y :: z :: rest -> + if z == x then + Just y + + else + comesBefore x (z :: rest) + + +find : (a -> Bool) -> List a -> Maybe a +find pred xs = + case xs |> List.filter pred of + [] -> + Nothing + + x :: _ -> + Just x diff --git a/website/sandbox/learnpianochords/src/Piano.elm b/website/sandbox/learnpianochords/src/Piano.elm new file mode 100644 index 000000000000..b100cb9cf573 --- /dev/null +++ b/website/sandbox/learnpianochords/src/Piano.elm @@ -0,0 +1,238 @@ +module Piano exposing (render) + +import Browser +import Html exposing (..) +import Html.Attributes exposing (..) +import Html.Events exposing (..) +import List.Extra +import Theory + + +{-| On mobile phones, the keyboard displays vertically. +-} +type Direction + = Horizontal + | Vertical + + +type alias KeyMarkup a = + { offset : Int + , isHighlit : Bool + , note : Theory.Note + , direction : Direction + } + -> 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" + + +{-| Pixel width of the white keys. +-} +naturalWidth : Direction -> Int +naturalWidth direction = + case direction of + Vertical -> + -- Right now, I'm designing this specifically for my Google Pixel 4 + -- phone, which has a screen width of 1080px. + 1080 + + Horizontal -> + 45 + + +{-| Pixel height of the white keys. +-} +naturalHeight : Direction -> Int +naturalHeight direction = + case direction of + Vertical -> + -- Right now, I'm designing this specifically for my Google Pixel 4 + -- phone, which has a screen height of 2280px. 2280 / 21 + -- (i.e. no. natural keys) ~= 108 + 108 + + Horizontal -> + 250 + + +{-| Pixel width of the black keys. +-} +accidentalWidth : Direction -> Int +accidentalWidth direction = + case direction of + Vertical -> + round (toFloat (naturalWidth direction) * 0.6) + + Horizontal -> + round (toFloat (naturalWidth direction) * 0.4) + + +{-| Pixel height of the black keys. +-} +accidentalHeight : Direction -> Int +accidentalHeight direction = + case direction of + Vertical -> + round (toFloat (naturalHeight direction) * 0.63) + + Horizontal -> + round (toFloat (naturalHeight direction) * 0.63) + + +{-| Return the markup for either a white or a black key. +-} +pianoKey : KeyMarkup a +pianoKey { offset, isHighlit, note, direction } = + let + sharedClasses = + [ "box-border" ] + + { keyWidth, keyHeight, keyColor, offsetEdge, extraClasses } = + case ( Theory.keyClass note, direction ) of + ( Theory.Natural, Vertical ) -> + { keyWidth = naturalWidth Vertical + , keyHeight = naturalHeight Vertical + , keyColor = "white" + , offsetEdge = "top" + , extraClasses = [] + } + + ( Theory.Natural, Horizontal ) -> + { keyWidth = naturalWidth Horizontal + , keyHeight = naturalHeight Horizontal + , keyColor = "white" + , offsetEdge = "left" + , extraClasses = [] + } + + ( Theory.Accidental, Vertical ) -> + { keyWidth = accidentalWidth Vertical + , keyHeight = accidentalHeight Vertical + , keyColor = "black" + , offsetEdge = "top" + , extraClasses = [ "z-10" ] + } + + ( Theory.Accidental, Horizontal ) -> + { keyWidth = accidentalWidth Horizontal + , keyHeight = accidentalHeight Horizontal + , keyColor = "black" + , offsetEdge = "left" + , extraClasses = [ "z-10" ] + } + in + div + [ style "background-color" + (if isHighlit then + "red" + + else + keyColor + ) + , style "border-top" "1px solid black" + , style "border-bottom" "1px solid black" + , style "border-left" "1px solid black" + , style "border-right" "1px solid black" + , style "width" (pixelate keyWidth) + , style "height" (pixelate keyHeight) + , style "position" "absolute" + , style offsetEdge (String.fromInt offset ++ "px") + , class <| String.join " " (List.concat [ sharedClasses, extraClasses ]) + ] + [] + + +{-| A section of the piano consisting of all twelve notes. +-} +keys : Direction -> Theory.Note -> Theory.Note -> List Theory.Note -> List (Html a) +keys direction start end highlight = + let + isHighlit note = + List.member note highlight + + spacing prevOffset prev curr = + case ( Theory.keyClass prev, Theory.keyClass curr, direction ) of + -- Horizontal + ( Theory.Natural, Theory.Accidental, Horizontal ) -> + prevOffset + naturalWidth direction - round (toFloat (accidentalWidth direction) / 2) + + ( Theory.Accidental, Theory.Natural, Horizontal ) -> + prevOffset + round (toFloat (accidentalWidth direction) / 2) + + ( Theory.Natural, Theory.Natural, Horizontal ) -> + prevOffset + naturalWidth direction + + -- Vertical + ( Theory.Natural, Theory.Accidental, Vertical ) -> + prevOffset + naturalHeight direction - round (toFloat (accidentalHeight direction) / 2) + + ( Theory.Accidental, Theory.Natural, Vertical ) -> + prevOffset + round (toFloat (accidentalHeight direction) / 2) + + ( Theory.Natural, Theory.Natural, Vertical ) -> + prevOffset + naturalHeight direction + + -- 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 + , pianoKey + { offset = 0 + , isHighlit = List.member curr highlight + , note = curr + , direction = direction + } + :: result + ) + + ( Just po, Just p ) -> + let + offset = + spacing po p curr + in + ( Just offset + , Just curr + , pianoKey + { offset = offset + , isHighlit = List.member curr highlight + , note = curr + , direction = direction + } + :: 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" ] + (keys Vertical start end highlight |> List.reverse |> List.repeat 1 |> List.concat) diff --git a/website/sandbox/learnpianochords/src/Tempo.elm b/website/sandbox/learnpianochords/src/Tempo.elm new file mode 100644 index 000000000000..50485c4c0aba --- /dev/null +++ b/website/sandbox/learnpianochords/src/Tempo.elm @@ -0,0 +1,24 @@ +module Tempo exposing (render) + +import Html exposing (..) +import Html.Attributes exposing (..) +import Html.Events exposing (..) +import UI + + +type alias Props msg = + { tempo : Int + , handleInput : String -> msg + } + + +render : Props msg -> Html msg +render { tempo, handleInput } = + div [ class "text-center" ] + [ p [ class "text-5xl py-10" ] [ text (String.fromInt tempo ++ " BPM") ] + , UI.textField + { placeholderText = "Set tempo..." + , handleInput = handleInput + , classes = [] + } + ] diff --git a/website/sandbox/learnpianochords/src/Theory.elm b/website/sandbox/learnpianochords/src/Theory.elm new file mode 100644 index 000000000000..4f89b8c38ffc --- /dev/null +++ b/website/sandbox/learnpianochords/src/Theory.elm @@ -0,0 +1,1100 @@ +module Theory exposing (..) + +import Array exposing (Array) +import Dict exposing (Dict) +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". + +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 + = 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 PitchClass + = 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 + , 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 + | Sus2 + | Sus4 + | 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 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. +-} +type alias Key = + { pitchClass : PitchClass + , 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, +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 + + +type alias NoteMetadata = + { note : Note + , label : String + , pitchClass : PitchClass + , natural : Bool + } + + +{-| An integer representing which note in a given scale to play. +-} +type alias ScaleDegree = + Int + + +{-| Returns the Note in the cental octave of the piano for a given +PitchClass. For example, C4 -- or "middle C" -- for C. +-} +noteInCentralOctave : PitchClass -> Note +noteInCentralOctave pitchClass = + case pitchClass 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 + + +{-| Return the human-readable version of a chord inversion. +-} +inversionName : ChordInversion -> String +inversionName inversion = + case inversion of + Root -> + "Root" + + First -> + "First" + + Second -> + "Second" + + +{-| Return the human-readable version of a chord type. +-} +chordTypeName : ChordType -> String +chordTypeName chordType = + case chordType of + Major -> + "major" + + Sus2 -> + "suspended 2" + + Sus4 -> + "suspended 4" + + 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 +Maybe. +-} +halfStep : StepDirection -> Note -> Maybe Note +halfStep dir note = + 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 IntervalVector +intervalsForMode mode = + 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 ] + + MinorMode -> + List.map up [ Whole, Half, Whole, Whole, Half, Whole ] + + BluesMode -> + List.map up [ MinorThird, Whole, Half, Half, MinorThird ] + + +{-| Return a list of the intervals that 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 ] + + -- Sus2 + ( Sus2, Root ) -> + [ up Whole, up PerfectFifth ] + + ( Sus2, First ) -> + [ down (NHalves 10), down (NHalves 5) ] + + ( Sus2, Second ) -> + [ down (NHalves 5), up Whole ] + + -- Sus4 + ( Sus4, Root ) -> + [ up (NHalves 5), up PerfectFifth ] + + ( Sus4, First ) -> + [ down (NHalves 7), down (NHalves 5) ] + + ( Sus4, Second ) -> + [ down (NHalves 5), up (NHalves 5) ] + + -- 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 -> walkNotes 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. + +-} +walkNotes : List IntervalVector -> Note -> Maybe (List Note) +walkNotes steps note = + doWalkNotes steps note [] |> Maybe.map List.reverse + + +{-| Recursive helper for `walkNotes`. +-} +doWalkNotes : List IntervalVector -> Note -> List Note -> Maybe (List Note) +doWalkNotes steps note result = + case steps of + [] -> + Just (note :: result) + + s :: rest -> + case step s note of + Just x -> + doWalkNotes rest x (note :: result) + + Nothing -> + Nothing + + +{-| Return the KeyClass for a given `note`. +-} +keyClass : Note -> KeyClass +keyClass note = + if isNatural note then + Natural + + else + Accidental + + +{-| Return the PitchClass for a given note. +-} +classifyNote : Note -> PitchClass +classifyNote note = + note |> getNoteMetadata |> .pitchClass + + +{-| Return a list of the notes that comprise a `chord` +-} +notesForChord : Chord -> Maybe (List Note) +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`. +-} +notesForKey : Key -> List Note +notesForKey { pitchClass, mode } = + let + origin = + noteInCentralOctave pitchClass + in + case walkNotes (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 = + note |> isNatural |> not + + +{-| Return true if `note` is a white key. +-} +isNatural : Note -> Bool +isNatural note = + note |> getNoteMetadata |> .natural + + +{-| 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 = + noteMetadata + |> Array.toList + |> List.map .note + |> List.Extra.dropWhile ((/=) start) + |> List.Extra.takeWhile ((/=) end) + + +{-| Return a list of all of the chord inversions about which we know. +-} +allInversions : List ChordInversion +allInversions = + [ Root, First, Second ] + + +{-| Return a list of all of the chord types about which we know. +-} +allChordTypes : List ChordType +allChordTypes = + [ Major + , Sus2 + , Sus4 + , Major7 + , MajorDominant7 + , Minor + , MinorMajor7 + , MinorDominant7 + , Augmented + , AugmentedDominant7 + , Diminished + , DiminishedDominant7 + , DiminishedMajor7 + ] + + +{-| Return a list of all of the key modes about which we know. +-} +allModes : List Mode +allModes = + [ MajorMode, MinorMode, BluesMode ] + + +{-| Return a list of all of the keys about which we know. +-} +allKeys : List Key +allKeys = + allPitchClasses + |> List.Extra.andThen + (\pitchClass -> + allModes + |> List.Extra.andThen + (\mode -> + [ { pitchClass = pitchClass + , mode = mode + } + ] + ) + ) + + +{-| Return an array of every note on a piano. +Note: Currently this piano has 85 keys, but modern pianos have 88 keys. I would +prefer to have 88 keys, but it's not urgent. +-} +noteMetadata : Array NoteMetadata +noteMetadata = + Array.fromList + [ { note = A1, label = "A1", pitchClass = A, natural = True } + , { note = A_sharp1, label = "A♯/B♭1", pitchClass = A_sharp, natural = False } + , { note = B1, label = "B1", pitchClass = B, natural = True } + , { note = C1, label = "C1", pitchClass = C, natural = True } + , { note = C_sharp1, label = "C♯/D♭1", pitchClass = C_sharp, natural = False } + , { note = D1, label = "D1", pitchClass = D, natural = True } + , { note = D_sharp1, label = "D♯/E♭1", pitchClass = D_sharp, natural = False } + , { note = E1, label = "E1", pitchClass = E, natural = True } + , { note = F1, label = "F1", pitchClass = F, natural = True } + , { note = F_sharp1, label = "F♯/G♭1", pitchClass = F_sharp, natural = False } + , { note = G1, label = "G1", pitchClass = G, natural = True } + , { note = G_sharp1, label = "G♯/A♭1", pitchClass = G, natural = False } + , { note = A2, label = "A2", pitchClass = A, natural = True } + , { note = A_sharp2, label = "A♯/B♭2", pitchClass = A_sharp, natural = False } + , { note = B2, label = "B2", pitchClass = B, natural = True } + , { note = C2, label = "C2", pitchClass = C, natural = True } + , { note = C_sharp2, label = "C♯/D♭2", pitchClass = C_sharp, natural = False } + , { note = D2, label = "D2", pitchClass = D, natural = True } + , { note = D_sharp2, label = "D♯/E♭2", pitchClass = D_sharp, natural = False } + , { note = E2, label = "E2", pitchClass = E, natural = True } + , { note = F2, label = "F2", pitchClass = F, natural = True } + , { note = F_sharp2, label = "F♯/G♭2", pitchClass = F_sharp, natural = False } + , { note = G2, label = "G2", pitchClass = G, natural = True } + , { note = G_sharp2, label = "G♯/A♭2", pitchClass = G, natural = False } + , { note = A3, label = "A3", pitchClass = A, natural = True } + , { note = A_sharp3, label = "A♯/B♭3", pitchClass = A_sharp, natural = False } + , { note = B3, label = "B3", pitchClass = B, natural = True } + , { note = C3, label = "C3", pitchClass = C, natural = True } + , { note = C_sharp3, label = "C♯/D♭3", pitchClass = C_sharp, natural = False } + , { note = D3, label = "D3", pitchClass = D, natural = True } + , { note = D_sharp3, label = "D♯/E♭3", pitchClass = D_sharp, natural = False } + , { note = E3, label = "E3", pitchClass = E, natural = True } + , { note = F3, label = "F3", pitchClass = F, natural = True } + , { note = F_sharp3, label = "F♯/G♭3", pitchClass = F_sharp, natural = False } + , { note = G3, label = "G3", pitchClass = G, natural = True } + , { note = G_sharp3, label = "G♯/A♭3", pitchClass = G, natural = False } + , { note = A4, label = "A4", pitchClass = A, natural = True } + , { note = A_sharp4, label = "A♯/B♭4", pitchClass = A_sharp, natural = False } + , { note = B4, label = "B4", pitchClass = B, natural = True } + , { note = C4, label = "C4", pitchClass = C, natural = True } + , { note = C_sharp4, label = "C♯/D♭4", pitchClass = C_sharp, natural = False } + , { note = D4, label = "D4", pitchClass = D, natural = True } + , { note = D_sharp4, label = "D♯/E♭4", pitchClass = D_sharp, natural = False } + , { note = E4, label = "E4", pitchClass = E, natural = True } + , { note = F4, label = "F4", pitchClass = F, natural = True } + , { note = F_sharp4, label = "F♯/G♭4", pitchClass = F_sharp, natural = False } + , { note = G4, label = "G4", pitchClass = G, natural = True } + , { note = G_sharp4, label = "G♯/A♭4", pitchClass = G, natural = False } + , { note = A5, label = "A5", pitchClass = A, natural = True } + , { note = A_sharp5, label = "A♯/B♭5", pitchClass = A_sharp, natural = False } + , { note = B5, label = "B5", pitchClass = B, natural = True } + , { note = C5, label = "C5", pitchClass = C, natural = True } + , { note = C_sharp5, label = "C♯/D♭5", pitchClass = C_sharp, natural = False } + , { note = D5, label = "D5", pitchClass = D, natural = True } + , { note = D_sharp5, label = "D♯/E♭5", pitchClass = D_sharp, natural = False } + , { note = E5, label = "E5", pitchClass = E, natural = True } + , { note = F5, label = "F5", pitchClass = F, natural = True } + , { note = F_sharp5, label = "F♯/G♭5", pitchClass = F_sharp, natural = False } + , { note = G5, label = "G5", pitchClass = G, natural = True } + , { note = G_sharp5, label = "G♯/A♭5", pitchClass = G, natural = False } + , { note = A6, label = "A6", pitchClass = A, natural = True } + , { note = A_sharp6, label = "A♯/B♭6", pitchClass = A_sharp, natural = False } + , { note = B6, label = "B6", pitchClass = B, natural = True } + , { note = C6, label = "C6", pitchClass = C, natural = True } + , { note = C_sharp6, label = "C♯/D♭6", pitchClass = C_sharp, natural = False } + , { note = D6, label = "D6", pitchClass = D, natural = True } + , { note = D_sharp6, label = "D♯/E♭6", pitchClass = D_sharp, natural = False } + , { note = E6, label = "E6", pitchClass = E, natural = True } + , { note = F6, label = "F6", pitchClass = F, natural = True } + , { note = F_sharp6, label = "F♯/G♭6", pitchClass = F_sharp, natural = False } + , { note = G6, label = "G6", pitchClass = G, natural = True } + , { note = G_sharp6, label = "G♯/A♭6", pitchClass = G, natural = False } + , { note = A7, label = "A7", pitchClass = A, natural = True } + , { note = A_sharp7, label = "A♯/B♭7", pitchClass = A_sharp, natural = False } + , { note = B7, label = "B7", pitchClass = B, natural = True } + , { note = C7, label = "C7", pitchClass = C, natural = True } + , { note = C_sharp7, label = "C♯/D♭7", pitchClass = C_sharp, natural = False } + , { note = D7, label = "D7", pitchClass = D, natural = True } + , { note = D_sharp7, label = "D♯/E♭7", pitchClass = D_sharp, natural = False } + , { note = E7, label = "E7", pitchClass = E, natural = True } + , { note = F7, label = "F7", pitchClass = F, natural = True } + , { note = F_sharp7, label = "F♯/G♭7", pitchClass = F_sharp, natural = False } + , { note = G7, label = "G7", pitchClass = G, natural = True } + , { note = G_sharp7, label = "G♯/A♭7", pitchClass = G, natural = False } + , { note = C8, label = "C8", pitchClass = C, natural = True } + ] + + +{-| Mapping of note data to commonly needed metadata for that note. +-} +getNoteMetadata : Note -> NoteMetadata +getNoteMetadata note = + case Array.get (noteAsNumber note) noteMetadata of + Just metadata -> + metadata + + -- This case should never hit, so we just return C1 to appease the + -- compiler. + Nothing -> + getNoteMetadata C1 + + +{-| Return the numeric representation of `note` to ues when comparing two +notes. +-} +noteAsNumber : Note -> Int +noteAsNumber note = + let + result = + noteMetadata + |> Array.toList + |> List.indexedMap Tuple.pair + |> Misc.find (\( _, x ) -> x.note == note) + in + case result of + Nothing -> + 0 + + Just ( i, _ ) -> + i + + +{-| Return true if all of the notes that comprise `chord` can be played on a +piano whose keys begin at `start` and end at `end`. +-} +chordWithinRange : Note -> Note -> Chord -> Bool +chordWithinRange start end chord = + case notesForChord chord of + Just notes -> + let + nums = + List.map noteAsNumber notes + + lo = + List.minimum nums |> Maybe.withDefault (noteAsNumber start) + + hi = + List.maximum nums |> Maybe.withDefault (noteAsNumber end) + in + lo >= noteAsNumber start && hi < noteAsNumber end + + Nothing -> + False + + +{-| Return a list of all of the pitch classes that we know about. +-} +allPitchClasses : List PitchClass +allPitchClasses = + [ C + , C_sharp + , D + , D_sharp + , E + , F + , F_sharp + , G + , G_sharp + , A + , A_sharp + , B + ] + + +{-| 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 : + { start : Note + , end : Note + , inversions : List ChordInversion + , chordTypes : List ChordType + , pitchClasses : List PitchClass + } + -> List Chord +allChords { start, end, inversions, chordTypes, pitchClasses } = + let + notes = + notesFromRange start end + |> List.filter (\note -> List.member (classifyNote note) pitchClasses) + in + notes + |> List.Extra.andThen + (\note -> + chordTypes + |> List.Extra.andThen + (\chordType -> + inversions + |> List.Extra.andThen + (\inversion -> + [ { note = note + , chordType = chordType + , chordInversion = inversion + } + ] + ) + ) + ) + |> List.filter (chordWithinRange start end) + + +{-| Return a human-readable format of `note`. +-} +viewNote : Note -> String +viewNote note = + note |> getNoteMetadata |> .label + + +{-| Return a human-readable format of `chord`. +-} +viewChord : Chord -> String +viewChord { note, chordType, chordInversion } = + viewPitchClass (classifyNote note) ++ " " ++ chordTypeName chordType ++ " " ++ inversionName chordInversion ++ " position" + + +{-| Return a human-readable format of `pitchClass`. +-} +viewPitchClass : PitchClass -> String +viewPitchClass pitchClass = + case pitchClass 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" + + +viewMode : Mode -> String +viewMode mode = + case mode of + MajorMode -> + "major" + + MinorMode -> + "minor" + + BluesMode -> + "blues" + + +{-| Return the human-readable format of `key`. +-} +viewKey : Key -> String +viewKey { pitchClass, mode } = + viewPitchClass pitchClass ++ " " ++ viewMode mode + + +{-| Returns a pairing of a scale-degree to the type of chord at that scale +degree. +-} +practiceChordsForMode : Mode -> Dict ScaleDegree ChordType +practiceChordsForMode mode = + case mode of + MajorMode -> + Dict.fromList + [ ( 1, Major ) + , ( 2, Minor ) + , ( 3, Minor ) + , ( 4, Major ) + , ( 5, Major ) + , ( 6, Minor ) + , ( 7, Diminished ) + ] + + MinorMode -> + Dict.fromList + [ ( 1, Minor ) + , ( 2, Diminished ) + , ( 3, Major ) + , ( 4, Minor ) + , ( 5, Minor ) + , ( 6, Major ) + , ( 7, Major ) + ] + + BluesMode -> + Dict.fromList + [ ( 1, MajorDominant7 ) + + -- While many refer to the blues progression as a I-IV-V, the IV + -- chord is really a MajorDominant7 made from the third scale + -- degree. + , ( 3, MajorDominant7 ) + , ( 5, MajorDominant7 ) + ] + + +{-| Returns a list of chords for a particular `key`. +-} +chordsForKey : Key -> List Chord +chordsForKey key = + let + chords = + practiceChordsForMode key.mode + in + notesForKey key + |> List.indexedMap + (\i note -> + case Dict.get (i + 1) chords of + Nothing -> + Nothing + + Just chordType -> + Just + (allInversions + |> List.Extra.andThen + (\inversion -> + [ { note = note + , chordType = chordType + , chordInversion = inversion + } + ] + ) + ) + ) + |> Maybe.Extra.values + |> List.concat diff --git a/website/sandbox/learnpianochords/src/UI.elm b/website/sandbox/learnpianochords/src/UI.elm new file mode 100644 index 000000000000..00114332db89 --- /dev/null +++ b/website/sandbox/learnpianochords/src/UI.elm @@ -0,0 +1,116 @@ +module UI exposing (..) + +import Html exposing (..) +import Html.Attributes exposing (..) +import Html.Events exposing (..) + + +type Color + = Primary + | Secondary + + +bgForColor : Color -> String +bgForColor color = + case color of + Primary -> + "bg-gray-600" + + Secondary -> + "bg-gray-300" + + +textForColor : Color -> String +textForColor color = + case color of + Primary -> + "text-white" + + Secondary -> + "text-black" + + +tw : List String -> String +tw styles = + String.join " " styles + + +simpleButton : + { label : String + , handleClick : msg + , color : Color + , classes : List String + } + -> Html msg +simpleButton { label, handleClick, color, classes } = + let + buttonClasses = + [ bgForColor color + , textForColor color + , "py-10" + , "px-20" + , "text-5xl" + , "rounded-lg" + ] + in + button + [ class (tw <| List.concat [ buttonClasses, classes ]) + , onClick handleClick + ] + [ text label ] + + +textToggleButton : + { label : String + , handleClick : msg + , classes : List String + , toggled : Bool + } + -> Html msg +textToggleButton { label, toggled, handleClick, classes } = + let + ( textColor, textTreatment ) = + if toggled then + ( "text-red-600", "underline" ) + + else + ( "text-black", "no-underline" ) + + buttonClasses = + [ textColor + , textTreatment + , "py-8" + , "px-10" + , "text-5xl" + ] + in + button + [ class (tw <| List.concat [ buttonClasses, classes ]) + , onClick handleClick + ] + [ text label ] + + +textField : + { placeholderText : String + , handleInput : String -> msg + , classes : List String + } + -> Html msg +textField { placeholderText, handleInput, classes } = + let + inputClasses = + [ "text-5xl" + , "w-full" + , "py-10" + , "px-16" + , "border" + , "rounded-lg" + ] + in + input + [ class (tw <| List.concat [ inputClasses, classes ]) + , onInput handleInput + , placeholder placeholderText + ] + [] |