Properly support chord inversions

While I did change a lot of functionality, I also ran `elm-format` across the
codebase, which makes these changes a bit noisy.

Here is the TL;DR:
- Properly support chord inversions
- Ensure that the piano styling changes dynamically when I change the variables
  like `naturalWidth`
- Add start and end notes to define the size of the piano and which chords we
  create
- Support elm-format and run it across entire project
- Debug Misc.comesBefore
- Introduce a ChordInspector and debugger

TODO: Ensure that we only generate chords where all of the notes can be rendered
on the displayed keys.

TODO: Add preferences panel, so that I can do things like "Practice blues chords
in C and E with chord substitutions."
This commit is contained in:
William Carroll 2020-04-12 16:43:34 +01:00
parent 730aecc076
commit 24692ab465
9 changed files with 1531 additions and 500 deletions

View file

@ -0,0 +1,3 @@
let
briefcase = import <briefcase> {};
in briefcase.utils.nixBufferFromShell ./shell.nix

View file

@ -12,6 +12,7 @@
"elm/random": "1.0.0", "elm/random": "1.0.0",
"elm/time": "1.0.0", "elm/time": "1.0.0",
"elm-community/list-extra": "8.2.3", "elm-community/list-extra": "8.2.3",
"elm-community/maybe-extra": "5.2.0",
"elm-community/random-extra": "3.1.0" "elm-community/random-extra": "3.1.0"
}, },
"indirect": { "indirect": {

View file

@ -3,5 +3,6 @@ let
in pkgs.mkShell { in pkgs.mkShell {
buildInputs = with pkgs; [ buildInputs = with pkgs; [
elmPackages.elm elmPackages.elm
elmPackages.elm-format
]; ];
} }

View file

@ -0,0 +1,25 @@
module ChordInspector exposing (render)
import Html exposing (..)
import Theory
render : Theory.Chord -> Html a
render chord =
case Theory.notesForChord chord of
Nothing ->
p [] [ text "Cannot retrieve the notes for the chord." ]
Just notes ->
ul []
(notes
|> List.map
(\note ->
li []
[ text
(Theory.viewNote
note
)
]
)
)

View file

@ -1,280 +1,229 @@
module Main exposing (main) module Main exposing (main)
import Browser import Browser
import ChordInspector
import Html exposing (..) import Html exposing (..)
import Html.Attributes exposing (..) import Html.Attributes exposing (..)
import Html.Events exposing (..) import Html.Events exposing (..)
import Piano
import Random import Random
import Random.List import Random.List
import Tempo
import Theory
import Time exposing (..) import Time exposing (..)
import Piano
import Theory
import Tempo
type alias Model = type alias Model =
{ whitelistedChords : List Theory.Chord { whitelistedChords : List Theory.Chord
, selectedChord : Theory.Chord , selectedChord : Theory.Chord
, isPaused : Bool , isPaused : Bool
, tempo : Int , tempo : Int
} , firstNote : Theory.Note
, lastNote : Theory.Note
, debug :
{ enable : Bool
, inspectChord : Bool
}
}
type Msg
= NextChord
| NewChord Theory.Chord
| Play
| Pause
| IncreaseTempo
| DecreaseTempo
| SetTempo String
| ToggleInspectChord
type Msg = NextChord
| NewChord Theory.Chord
| Play
| Pause
| IncreaseTempo
| DecreaseTempo
| SetTempo String
tempoStep : Int tempoStep : Int
tempoStep = 5 tempoStep =
5
{-| Return the number of milliseconds that elapse during an interval in a {-| Return the number of milliseconds that elapse during an interval in a
`target` bpm. `target` bpm.
-} -}
bpmToMilliseconds : Int -> Int bpmToMilliseconds : Int -> Int
bpmToMilliseconds target = bpmToMilliseconds target =
let msPerMinute = 1000 * 60 let
in round (toFloat msPerMinute / toFloat target) msPerMinute =
1000 * 60
in
round (toFloat msPerMinute / toFloat target)
inspectChord : Theory.Chord -> String
inspectChord {note, chordType, chordPosition} =
viewNote note ++ " " ++
(case chordType of
Theory.Major -> "major"
Theory.Major7 -> "major 7th"
Theory.MajorDominant7 -> "major dominant 7th"
Theory.Minor -> "minor"
Theory.Minor7 -> "minor 7th"
Theory.MinorDominant7 -> "minor dominant 7th"
Theory.Augmented -> "augmented"
Theory.Augmented7 -> "augmented 7th"
Theory.Diminished -> "diminished"
Theory.Diminished7 -> "diminished 7th") ++ " " ++
(case chordPosition of
Theory.First -> "root position"
Theory.Second -> "2nd position"
Theory.Third -> "3rd position"
Theory.Fourth -> "4th position")
viewChord : Theory.Chord -> String
viewChord {note, chordType, chordPosition} =
viewNoteClass (Theory.classifyNote note) ++ " " ++
(case chordType of
Theory.Major -> "major"
Theory.Major7 -> "major 7th"
Theory.MajorDominant7 -> "major dominant 7th"
Theory.Minor -> "minor"
Theory.Minor7 -> "minor 7th"
Theory.MinorDominant7 -> "minor dominant 7th"
Theory.Augmented -> "augmented"
Theory.Augmented7 -> "augmented 7th"
Theory.Diminished -> "diminished"
Theory.Diminished7 -> "diminished 7th") ++ " " ++
(case chordPosition of
Theory.First -> "root position"
Theory.Second -> "2nd position"
Theory.Third -> "3rd position"
Theory.Fourth -> "4th position")
{-| Serialize a human-readable format of `note`. -}
viewNote : Theory.Note -> String
viewNote note =
case note of
Theory.C1 -> "C1"
Theory.C_sharp1 -> "C/D1"
Theory.D1 -> "D1"
Theory.D_sharp1 -> "D/E1"
Theory.E1 -> "E1"
Theory.F1 -> "F1"
Theory.F_sharp1 -> "F/G1"
Theory.G1 -> "G1"
Theory.G_sharp1 -> "G/A1"
Theory.A1 -> "A1"
Theory.A_sharp1 -> "A/B1"
Theory.B1 -> "B1"
Theory.C2 -> "C2"
Theory.C_sharp2 -> "C/D2"
Theory.D2 -> "D2"
Theory.D_sharp2 -> "D/E2"
Theory.E2 -> "E2"
Theory.F2 -> "F2"
Theory.F_sharp2 -> "F/G2"
Theory.G2 -> "G2"
Theory.G_sharp2 -> "G/A2"
Theory.A2 -> "A2"
Theory.A_sharp2 -> "A/B2"
Theory.B2 -> "B2"
Theory.C3 -> "C3"
Theory.C_sharp3 -> "C/D3"
Theory.D3 -> "D3"
Theory.D_sharp3 -> "D/E3"
Theory.E3 -> "E3"
Theory.F3 -> "F3"
Theory.F_sharp3 -> "F/G3"
Theory.G3 -> "G3"
Theory.G_sharp3 -> "G/A3"
Theory.A3 -> "A3"
Theory.A_sharp3 -> "A/B3"
Theory.B3 -> "B3"
Theory.C4 -> "C4"
Theory.C_sharp4 -> "C/D4"
Theory.D4 -> "D4"
Theory.D_sharp4 -> "D/E4"
Theory.E4 -> "E4"
Theory.F4 -> "F4"
Theory.F_sharp4 -> "F/G4"
Theory.G4 -> "G4"
Theory.G_sharp4 -> "G/A4"
Theory.A4 -> "A4"
Theory.A_sharp4 -> "A/B4"
Theory.B4 -> "B4"
Theory.C5 -> "C5"
Theory.C_sharp5 -> "C/D5"
Theory.D5 -> "D5"
Theory.D_sharp5 -> "D/E5"
Theory.E5 -> "E5"
Theory.F5 -> "F5"
Theory.F_sharp5 -> "F/G5"
Theory.G5 -> "G5"
Theory.G_sharp5 -> "G/A5"
Theory.A5 -> "A5"
Theory.A_sharp5 -> "A/B5"
Theory.B5 -> "B5"
Theory.C6 -> "C6"
Theory.C_sharp6 -> "C/D6"
Theory.D6 -> "D6"
Theory.D_sharp6 -> "D/E6"
Theory.E6 -> "E6"
Theory.F6 -> "F6"
Theory.F_sharp6 -> "F/G6"
Theory.G6 -> "G6"
Theory.G_sharp6 -> "G/A6"
Theory.A6 -> "A6"
Theory.A_sharp6 -> "A/B6"
Theory.B6 -> "B6"
Theory.C7 -> "C7"
Theory.C_sharp7 -> "C/D7"
Theory.D7 -> "D7"
Theory.D_sharp7 -> "D/E7"
Theory.E7 -> "E7"
Theory.F7 -> "F7"
Theory.F_sharp7 -> "F/G7"
Theory.G7 -> "G7"
Theory.G_sharp7 -> "G/A7"
Theory.A7 -> "A7"
Theory.A_sharp7 -> "A/B7"
Theory.B7 -> "B7"
Theory.C8 -> "C8"
{-| Serialize a human-readable format of `noteClass`. -}
viewNoteClass : Theory.NoteClass -> String
viewNoteClass noteClass =
case noteClass of
Theory.C -> "C"
Theory.C_sharp -> "C/D"
Theory.D -> "D"
Theory.D_sharp -> "D/E"
Theory.E -> "E"
Theory.F -> "F"
Theory.F_sharp -> "F/G"
Theory.G -> "G"
Theory.G_sharp -> "G/A"
Theory.A -> "A"
Theory.A_sharp -> "A/B"
Theory.B -> "B"
cmajor : Theory.Chord cmajor : Theory.Chord
cmajor = cmajor =
{ note = Theory.C4 { note = Theory.C4
, chordType = Theory.Major , chordType = Theory.MajorDominant7
, chordPosition = Theory.First , chordInversion = Theory.Root
} }
{-| The initial state for the application. -}
{-| The initial state for the application.
-}
init : Model init : Model
init = init =
{ whitelistedChords = Theory.allChords let
, selectedChord = cmajor ( firstNote, lastNote ) =
, isPaused = True ( Theory.C3, Theory.C5 )
, tempo = 60 in
} { whitelistedChords = Theory.allChords firstNote lastNote
, selectedChord = cmajor
, isPaused = True
, tempo = 60
, firstNote = firstNote
, lastNote = lastNote
, debug =
{ enable = True
, inspectChord = True
}
}
subscriptions : Model -> Sub Msg subscriptions : Model -> Sub Msg
subscriptions {isPaused, tempo} = subscriptions { isPaused, tempo } =
if isPaused then if isPaused then
Sub.none Sub.none
else
Time.every (tempo |> bpmToMilliseconds |> toFloat) (\_ -> NextChord)
{-| Now that we have state, we need a function to change the state. -} else
update : Msg -> Model -> (Model, Cmd Msg) 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 = update msg model =
case msg of case msg of
NewChord chord -> ( { model | selectedChord = chord } NewChord chord ->
, Cmd.none ( { model | selectedChord = chord }
)
NextChord -> ( model
, Random.generate (\x ->
case x of
(Just chord, _) -> NewChord chord
(Nothing, _) -> NewChord cmajor)
(Random.List.choose model.whitelistedChords)
)
Play -> ( { model | isPaused = False }
, Cmd.none , Cmd.none
) )
Pause -> ( { model | isPaused = True }
, Cmd.none NextChord ->
) ( model
IncreaseTempo -> ( { model | tempo = model.tempo + tempoStep } , Random.generate
, Cmd.none (\x ->
) case x of
DecreaseTempo -> ( { model | tempo = model.tempo - tempoStep } ( Just chord, _ ) ->
, Cmd.none NewChord chord
)
SetTempo tempo -> ( { model | ( Nothing, _ ) ->
tempo = case String.toInt tempo of NewChord cmajor
Just x -> x )
Nothing -> model.tempo (Random.List.choose model.whitelistedChords)
} )
, Cmd.none
) Play ->
( { model | isPaused = False }
, Cmd.none
)
Pause ->
( { model | isPaused = True }
, Cmd.none
)
IncreaseTempo ->
( { model | tempo = model.tempo + tempoStep }
, Cmd.none
)
DecreaseTempo ->
( { model | tempo = model.tempo - tempoStep }
, Cmd.none
)
ToggleInspectChord ->
( { model
| debug =
{ inspectChord = not model.debug.inspectChord
, enable = model.debug.enable
}
}
, Cmd.none
)
SetTempo tempo ->
( { model
| tempo =
case String.toInt tempo of
Just x ->
x
Nothing ->
model.tempo
}
, Cmd.none
)
playPause : Model -> Html Msg playPause : Model -> Html Msg
playPause {isPaused} = playPause { isPaused } =
if isPaused then if isPaused then
button [ onClick Play ] [ text "Play" ] button [ onClick Play ] [ text "Play" ]
else
button [ onClick Pause ] [ text "Pause" ] else
button [ onClick Pause ] [ text "Pause" ]
debugger : Html Msg
debugger =
fieldset []
[ label [] [ text "Inspect Chord" ]
, input [ type_ "checkbox", onClick ToggleInspectChord, checked init.debug.inspectChord ] []
]
view : Model -> Html Msg view : Model -> Html Msg
view model = view model =
case Theory.notesForChord model.selectedChord of case Theory.notesForChord model.selectedChord of
Nothing -> Nothing ->
p [] [ text (""" p [] [ text ("""
We cannot render the chord that you provided because the We cannot render the chord that you provided because the
notes that comprise the chord fall off either the upper notes that comprise the chord fall off either the upper
or lower end of the piano. or lower end of the piano.
Chord: Chord:
""" ++ (inspectChord model.selectedChord)) ] """ ++ Theory.inspectChord model.selectedChord) ]
Just x ->
div [] [ Tempo.render { tempo = model.tempo
, handleIncrease = IncreaseTempo
, handleDecrease = DecreaseTempo
, handleInput = SetTempo
}
, playPause model
, p [] [ text (viewChord model.selectedChord) ]
, Piano.render { highlight = x }
]
{-| For now, I'm just dumping things onto the page to sketch ideas. -} Just x ->
div []
[ Tempo.render
{ tempo = model.tempo
, handleIncrease = IncreaseTempo
, handleDecrease = DecreaseTempo
, handleInput = SetTempo
}
, playPause model
, if model.debug.enable then
debugger
else
span [] []
, if model.debug.inspectChord then
ChordInspector.render model.selectedChord
else
span [] []
, p [] [ text (Theory.viewChord model.selectedChord) ]
, Piano.render
{ highlight = x
, start = model.firstNote
, end = model.lastNote
}
]
{-| For now, I'm just dumping things onto the page to sketch ideas.
-}
main = main =
Browser.element { init = \() -> (init, Cmd.none) Browser.element
, subscriptions = subscriptions { init = \() -> ( init, Cmd.none )
, update = update , subscriptions = subscriptions
, view = view , update = update
} , view = view
}

View file

@ -1,15 +1,35 @@
module Misc exposing (..) module Misc exposing (..)
comesAfter : a -> List a -> Maybe a comesAfter : a -> List a -> Maybe a
comesAfter x xs = comesAfter x xs =
case xs of case xs of
[] -> Nothing [] ->
_::[] -> Nothing Nothing
y::z::rest -> if y == x then Just z else comesAfter x (z::rest)
_ :: [] ->
Nothing
y :: z :: rest ->
if y == x then
Just z
else
comesAfter x (z :: rest)
comesBefore : a -> List a -> Maybe a comesBefore : a -> List a -> Maybe a
comesBefore x xs = comesBefore x xs =
case xs of case xs of
[] -> Nothing [] ->
_::[] -> Nothing Nothing
y::z::rest -> if z == x then Just y else comesAfter x (z::rest)
_ :: [] ->
Nothing
y :: z :: rest ->
if z == x then
Just y
else
comesBefore x (z :: rest)

View file

@ -4,79 +4,184 @@ import Browser
import Html exposing (..) import Html exposing (..)
import Html.Attributes exposing (..) import Html.Attributes exposing (..)
import Html.Events exposing (..) import Html.Events exposing (..)
import List.Extra
import Theory import Theory
{-| Convert an integer into its pixel representation for CSS. -}
type alias KeyMarkup a =
{ offset : Int
, isHighlit : Bool
, note : Theory.Note
}
-> Html a
type alias Props =
{ highlight : List Theory.Note
, start : Theory.Note
, end : Theory.Note
}
{-| Convert an integer into its pixel representation for CSS.
-}
pixelate : Int -> String pixelate : Int -> String
pixelate x = String.fromInt x ++ "px" pixelate x =
String.fromInt x ++ "px"
{-| Pixel width of the white keys. -}
{-| Pixel width of the white keys.
-}
naturalWidth : Int naturalWidth : Int
naturalWidth = 40 naturalWidth =
45
{-| Pixel height of the white keys. -}
{-| Pixel height of the white keys.
-}
naturalHeight : Int naturalHeight : Int
naturalHeight = 200 naturalHeight =
250
{-| Pixel width of the black keys. -}
{-| Pixel width of the black keys.
-}
accidentalWidth : Int accidentalWidth : Int
accidentalWidth = round (toFloat naturalWidth * 0.7) accidentalWidth =
round (toFloat naturalWidth * 0.4)
{-| Pixel height of the black keys. -}
{-| Pixel height of the black keys.
-}
accidentalHeight : Int accidentalHeight : Int
accidentalHeight = round (toFloat naturalHeight * 0.6) accidentalHeight =
round (toFloat naturalHeight * 0.63)
{-| These are the white keys on most modern pianos. -}
natural : Int -> Bool -> Html a
natural offset isHighlit =
div [ style "background-color" (if isHighlit then "red" else "white")
, style "border-right" "1px solid black"
, style "border-top" "1px solid black"
, style "border-bottom" "1px solid black"
, style "width" (pixelate naturalWidth)
, style "height" (pixelate naturalHeight)
, style "position" "absolute"
, style "left" ((String.fromInt offset) ++ "px")
] []
{-| These are the black keys on most modern pianos. -} {-| These are the white keys on most modern pianos.
accidental : Int -> Bool -> Html a -}
accidental offset isHighlit = natural : KeyMarkup a
div [ style "background-color" (if isHighlit then "red" else "black") natural { offset, isHighlit, note } =
, style "border-top" "1px solid black" div
, style "border-left" "1px solid black" [ style "background-color"
, style "border-right" "1px solid black" (if isHighlit then
, style "border-bottom" "1px solid black" "red"
, style "width" (pixelate accidentalWidth)
, style "height" (pixelate accidentalHeight) else
, style "position" "absolute" "white"
, style "left" ((String.fromInt offset) ++ "px") )
, style "z-index" "1" , style "border-right" "1px solid black"
] [] , style "border-top" "1px solid black"
, style "border-bottom" "1px solid black"
, style "width" (pixelate naturalWidth)
, style "height" (pixelate naturalHeight)
, style "position" "absolute"
, style "left" (String.fromInt offset ++ "px")
]
[ p [] [ text (Theory.viewNote note) ] ]
{-| These are the black keys on most modern pianos.
-}
accidental : KeyMarkup a
accidental { offset, isHighlit, note } =
div
[ style "background-color"
(if isHighlit then
"red"
else
"black"
)
, style "border-top" "1px solid black"
, style "border-left" "1px solid black"
, style "border-right" "1px solid black"
, style "border-bottom" "1px solid black"
, style "width" (pixelate accidentalWidth)
, style "height" (pixelate accidentalHeight)
, style "position" "absolute"
, style "left" (String.fromInt offset ++ "px")
, style "z-index" "1"
]
[]
makeKey : List Theory.Note -> Theory.Note -> (Int -> Html a)
makeKey highlight note =
if Theory.isNatural note then
\x ->
natural
{ offset = x
, isHighlit = List.member note highlight
, note = note
}
else
\x ->
accidental
{ offset = x
, isHighlit = List.member note highlight
, note = note
}
{-| A section of the piano consisting of all twelve notes. The name octave {-| A section of the piano consisting of all twelve notes. The name octave
implies eight notes, which most scales (not the blues scale) honor. -} implies eight notes, which most scales (not the blues scale) honor.
octave : List Theory.Note -> List (Html a) -}
octave highlight = octave : Theory.Note -> Theory.Note -> List Theory.Note -> List (Html a)
let octave start end highlight =
isHighlit note = List.member note highlight let
in isHighlit note =
[ natural 0 (isHighlit Theory.C4) List.member note highlight
, accidental 25 (isHighlit Theory.C_sharp4)
, natural 40 (isHighlit Theory.D4)
, accidental 65 (isHighlit Theory.D_sharp4)
, natural 80 (isHighlit Theory.E4)
, natural 120 (isHighlit Theory.F4)
, accidental 145 (isHighlit Theory.F_sharp4)
, natural 160 (isHighlit Theory.G4)
, accidental 185 (isHighlit Theory.G_sharp4)
, natural 200 (isHighlit Theory.A4)
, accidental 225 (isHighlit Theory.A_sharp4)
, natural 240 (isHighlit Theory.B4)
]
{-| Return the HTML that renders a piano representation. -} spacing prevOffset prev curr =
render : { highlight : List Theory.Note } -> Html a case ( Theory.keyClass prev, Theory.keyClass curr ) of
render {highlight} = ( Theory.Natural, Theory.Accidental ) ->
div [ style "display" "flex" ] (octave highlight |> List.reverse |> List.repeat 1 |> List.concat) -- idk this calculation yet
prevOffset + naturalWidth - round (toFloat accidentalWidth / 2)
( Theory.Accidental, Theory.Natural ) ->
-- accidentalWidth / 2
prevOffset + round (toFloat accidentalWidth / 2)
( Theory.Natural, Theory.Natural ) ->
-- naturalWidth
prevOffset + naturalWidth
-- This pattern should never hit.
_ ->
prevOffset
( _, _, notes ) =
Theory.notesFromRange start end
|> List.foldl
(\curr ( prevOffset, prev, result ) ->
case ( prevOffset, prev ) of
( Nothing, Nothing ) ->
( Just 0, Just curr, makeKey highlight curr 0 :: result )
( Just po, Just p ) ->
let
offset =
spacing po p curr
in
( Just offset
, Just curr
, makeKey highlight curr offset :: result
)
-- This pattern should never hit.
_ ->
( Nothing, Nothing, [] )
)
( Nothing, Nothing, [] )
in
List.reverse notes
{-| Return the HTML that renders a piano representation.
-}
render : Props -> Html a
render { highlight, start, end } =
div [ style "display" "flex" ]
(octave start end highlight |> List.reverse |> List.repeat 1 |> List.concat)

View file

@ -4,19 +4,24 @@ import Html exposing (..)
import Html.Attributes exposing (..) import Html.Attributes exposing (..)
import Html.Events exposing (..) import Html.Events exposing (..)
type alias Props msg = type alias Props msg =
{ tempo : Int { tempo : Int
, handleIncrease : msg , handleIncrease : msg
, handleDecrease : msg , handleDecrease : msg
, handleInput : String -> msg , handleInput : String -> msg
} }
render : Props msg -> Html msg render : Props msg -> Html msg
render {tempo, handleIncrease, handleDecrease, handleInput} = render { tempo, handleIncrease, handleDecrease, handleInput } =
div [] [ p [] [ text ((String.fromInt tempo) ++ " BPM") ] div []
, button [ onClick handleDecrease ] [ text "Slower" ] [ p [] [ text (String.fromInt tempo ++ " BPM") ]
, input [ onInput handleInput , button [ onClick handleDecrease ] [ text "Slower" ]
, placeholder "Set tempo..." , input
] [] [ onInput handleInput
, button [ onClick handleIncrease ] [ text "Faster" ] , placeholder "Set tempo..."
] ]
[]
, button [ onClick handleIncrease ] [ text "Faster" ]
]

File diff suppressed because it is too large Load diff