about summary refs log blame commit diff
path: root/website/sandbox/chord-drill-sergeant/src/Main.elm
blob: f13412a0a9f4327f343caadc88862672f4ed2f41 (plain) (tree)
1
2
3
4
5
6
7
8
9





                                    
            

                  

             
                         
         
 
 
                  
                                           

                                                        
                                                      
                                       
                                        



                             
                                 
                 


     




                 






                                            







                           
                                           
                                      
                                        
                          
               


                                  
 
 

                                                      
               


           





                                                                         





                                                
 

                                          

            

                                 
                                    






                                

                                  

              
              


                      
      













                                                          

                                        
                                            
                            
                             
                     
                

                           
                        

     
 
                                










                                                                            
                  
               


                               
























                                                                        
                         
                                                    

                      









                                            
                                     























                                                            
















                                                                                
                                                                      




                         










                                                                                





                                                                  
                                                                      




                         
                                      
               


                                                                                   

                        
                                                                   

                     
                                                        





                                                                  
                                                     
                         



                      
















                                                                    












                                              

                             







                                                 


















                                                                            








                                                                            
                                              








                                                                        






































                                                                                                                   
          
                                                                          
               
                                   
                           






                                                                                             




                     
              
                          



                             
                                             
          
                                                












                                                

































                                                                

                                 

                                    
                                   

                                    
                                   


                           
                                                                     

                                                                     
         
 




                            


                                     
                                   

                                                 
                     



                                                   

 









                             

                                                                   
      





                                          
module Main exposing (main)

import Browser
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 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


{-| 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.A1, Theory.C8 )

        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 = 30
    , 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
            )

        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
    ->
        { pitchClass : Theory.PitchClass
        , majorKey : Theory.Key
        , minorKey : Theory.Key
        , bluesKey : Theory.Key
        }
    -> Html Msg
selectKey model { pitchClass, majorKey, minorKey, bluesKey } =
    let
        active key =
            List.member key model.whitelistedKeys
    in
    div [ class "flex pt-0" ]
        [ p [ class "text-gray-500 text-center text-5xl flex-1 py-10" ] [ text (Theory.viewPitchClass pitchClass) ]
        , UI.textToggleButton
            { label = "major"
            , handleClick = ToggleKey majorKey
            , classes = [ "flex-1" ]
            , toggled = active majorKey
            }
        , UI.textToggleButton
            { label = "minor"
            , handleClick = ToggleKey minorKey
            , classes = [ "flex-1" ]
            , toggled = active minorKey
            }
        , UI.textToggleButton
            { label = "blues"
            , handleClick = ToggleKey bluesKey
            , classes = [ "flex-1" ]
            , toggled = active bluesKey
            }
        ]


keyCheckboxes : Model -> Html Msg
keyCheckboxes model =
    div []
        [ h2 [ class "text-center py-10 text-5xl" ] [ text "Select Keys" ]
        , ul []
            (Theory.allPitchClasses
                |> List.map
                    (\pitchClass ->
                        selectKey model
                            { pitchClass = pitchClass
                            , majorKey = { pitchClass = pitchClass, mode = Theory.MajorMode }
                            , minorKey = { pitchClass = pitchClass, mode = Theory.MinorMode }
                            , bluesKey = { pitchClass = pitchClass, mode = Theory.BluesMode }
                            }
                    )
            )
        ]


displayChord :
    { chord : Theory.Chord
    , firstNote : Theory.Note
    , lastNote : Theory.Note
    }
    -> Html Msg
displayChord { chord, firstNote, lastNote } =
    div []
        [ p [] [ text (Theory.viewChord chord) ]
        , case Theory.notesForChord chord of
            Just x ->
                Piano.render
                    { highlight = x
                    , start = firstNote
                    , end = lastNote
                    }

            Nothing ->
                p [] [ text "No chord to show" ]
        ]


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
                }
            ]
        ]


preferences : Model -> Html Msg
preferences model =
    div [ class "pt-10 pb-20 px-10" ]
        [ Tempo.render
            { tempo = model.tempo
            , handleInput = SetTempo
            }
        , practiceModeButtons model
        , case model.practiceMode of
            KeyMode ->
                keyCheckboxes model

            FineTuneMode ->
                div []
                    [ inversionCheckboxes model.whitelistedInversions
                    , chordTypeCheckboxes model.whitelistedChordTypes
                    ]
        ]


practice : Model -> Html Msg
practice model =
    div []
        [ playPause model
        , case model.selectedChord of
            Just chord ->
                displayChord
                    { chord = chord
                    , firstNote = model.firstNote
                    , lastNote = model.lastNote
                    }

            Nothing ->
                p [] [ text "No chord to display" ]
        ]


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
        }