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/time": "1.0.0",
"elm-community/list-extra": "8.2.3",
"elm-community/maybe-extra": "5.2.0",
"elm-community/random-extra": "3.1.0"
},
"indirect": {

View file

@ -3,5 +3,6 @@ let
in pkgs.mkShell {
buildInputs = with pkgs; [
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)
import Browser
import ChordInspector
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 Piano
import Theory
import Tempo
type alias Model =
{ whitelistedChords : List Theory.Chord
, selectedChord : Theory.Chord
, isPaused : Bool
, tempo : Int
}
{ whitelistedChords : List Theory.Chord
, selectedChord : Theory.Chord
, isPaused : Bool
, 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 = 5
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)
let
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 =
{ note = Theory.C4
, chordType = Theory.Major
, chordPosition = Theory.First
}
{ note = Theory.C4
, chordType = Theory.MajorDominant7
, chordInversion = Theory.Root
}
{-| The initial state for the application. -}
{-| The initial state for the application.
-}
init : Model
init =
{ whitelistedChords = Theory.allChords
, selectedChord = cmajor
, isPaused = True
, tempo = 60
}
let
( firstNote, lastNote ) =
( Theory.C3, Theory.C5 )
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 {isPaused, tempo} =
if isPaused then
Sub.none
else
Time.every (tempo |> bpmToMilliseconds |> toFloat) (\_ -> NextChord)
subscriptions { isPaused, tempo } =
if isPaused then
Sub.none
{-| Now that we have state, we need a function to change the state. -}
update : Msg -> Model -> (Model, Cmd Msg)
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
NewChord chord -> ( { model | selectedChord = chord }
, Cmd.none
)
NextChord -> ( model
, Random.generate (\x ->
case x of
(Just chord, _) -> NewChord chord
(Nothing, _) -> NewChord cmajor)
(Random.List.choose model.whitelistedChords)
)
Play -> ( { model | isPaused = False }
case msg of
NewChord chord ->
( { model | selectedChord = chord }
, Cmd.none
)
Pause -> ( { model | isPaused = True }
, Cmd.none
)
IncreaseTempo -> ( { model | tempo = model.tempo + tempoStep }
, Cmd.none
)
DecreaseTempo -> ( { model | tempo = model.tempo - tempoStep }
, Cmd.none
)
SetTempo tempo -> ( { model |
tempo = case String.toInt tempo of
Just x -> x
Nothing -> model.tempo
}
, Cmd.none
)
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
)
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 {isPaused} =
if isPaused then
button [ onClick Play ] [ text "Play" ]
else
button [ onClick Pause ] [ text "Pause" ]
playPause { isPaused } =
if isPaused then
button [ onClick Play ] [ text "Play" ]
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 =
case Theory.notesForChord model.selectedChord of
Nothing ->
p [] [ text ("""
case Theory.notesForChord model.selectedChord of
Nothing ->
p [] [ text ("""
We cannot render the chord that you provided because the
notes that comprise the chord fall off either the upper
or lower end of the piano.
Chord:
""" ++ (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 }
]
""" ++ Theory.inspectChord model.selectedChord) ]
{-| 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 =
Browser.element { init = \() -> (init, Cmd.none)
, subscriptions = subscriptions
, update = update
, view = view
}
Browser.element
{ init = \() -> ( init, Cmd.none )
, subscriptions = subscriptions
, update = update
, view = view
}

View file

@ -1,15 +1,35 @@
module Misc exposing (..)
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)
[] ->
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 comesAfter x (z::rest)
[] ->
Nothing
_ :: [] ->
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.Attributes exposing (..)
import Html.Events exposing (..)
import List.Extra
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 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 = 40
naturalWidth =
45
{-| Pixel height of the white keys. -}
{-| Pixel height of the white keys.
-}
naturalHeight : Int
naturalHeight = 200
naturalHeight =
250
{-| Pixel width of the black keys. -}
{-| Pixel width of the black keys.
-}
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 = 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. -}
accidental : Int -> Bool -> Html a
accidental offset isHighlit =
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"
] []
{-| These are the white keys on most modern pianos.
-}
natural : KeyMarkup a
natural { offset, isHighlit, note } =
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")
]
[ 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
implies eight notes, which most scales (not the blues scale) honor. -}
octave : List Theory.Note -> List (Html a)
octave highlight =
let
isHighlit note = List.member note highlight
in
[ natural 0 (isHighlit Theory.C4)
, 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)
]
implies eight notes, which most scales (not the blues scale) honor.
-}
octave : Theory.Note -> Theory.Note -> List Theory.Note -> List (Html a)
octave start end highlight =
let
isHighlit note =
List.member note highlight
{-| Return the HTML that renders a piano representation. -}
render : { highlight : List Theory.Note } -> Html a
render {highlight} =
div [ style "display" "flex" ] (octave highlight |> List.reverse |> List.repeat 1 |> List.concat)
spacing prevOffset prev curr =
case ( Theory.keyClass prev, Theory.keyClass curr ) of
( Theory.Natural, Theory.Accidental ) ->
-- 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.Events exposing (..)
type alias Props msg =
{ tempo : Int
, handleIncrease : msg
, handleDecrease : msg
, handleInput : String -> msg
}
{ tempo : Int
, handleIncrease : msg
, handleDecrease : msg
, handleInput : String -> msg
}
render : Props msg -> Html msg
render {tempo, handleIncrease, handleDecrease, handleInput} =
div [] [ p [] [ text ((String.fromInt tempo) ++ " BPM") ]
, button [ onClick handleDecrease ] [ text "Slower" ]
, input [ onInput handleInput
, placeholder "Set tempo..."
] []
, button [ onClick handleIncrease ] [ text "Faster" ]
]
render { tempo, handleIncrease, handleDecrease, handleInput } =
div []
[ p [] [ text (String.fromInt tempo ++ " BPM") ]
, button [ onClick handleDecrease ] [ text "Slower" ]
, input
[ onInput handleInput
, placeholder "Set tempo..."
]
[]
, button [ onClick handleIncrease ] [ text "Faster" ]
]

File diff suppressed because it is too large Load diff