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,254 +1,183 @@
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
type Msg
= NextChord
| NewChord Theory.Chord | NewChord Theory.Chord
| Play | Play
| Pause | Pause
| IncreaseTempo | IncreaseTempo
| DecreaseTempo | DecreaseTempo
| SetTempo String | SetTempo String
| ToggleInspectChord
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
( firstNote, lastNote ) =
( Theory.C3, Theory.C5 )
in
{ whitelistedChords = Theory.allChords firstNote lastNote
, selectedChord = cmajor , selectedChord = cmajor
, isPaused = True , isPaused = True
, tempo = 60 , 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 else
Time.every (tempo |> bpmToMilliseconds |> toFloat) (\_ -> NextChord) 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) {-| 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 ->
( { model | selectedChord = chord }
, Cmd.none , Cmd.none
) )
NextChord -> ( model
, Random.generate (\x -> NextChord ->
( model
, Random.generate
(\x ->
case x of case x of
(Just chord, _) -> NewChord chord ( Just chord, _ ) ->
(Nothing, _) -> NewChord cmajor) NewChord chord
( Nothing, _ ) ->
NewChord cmajor
)
(Random.List.choose model.whitelistedChords) (Random.List.choose model.whitelistedChords)
) )
Play -> ( { model | isPaused = False }
Play ->
( { model | isPaused = False }
, Cmd.none , Cmd.none
) )
Pause -> ( { model | isPaused = True }
Pause ->
( { model | isPaused = True }
, Cmd.none , Cmd.none
) )
IncreaseTempo -> ( { model | tempo = model.tempo + tempoStep }
IncreaseTempo ->
( { model | tempo = model.tempo + tempoStep }
, Cmd.none , Cmd.none
) )
DecreaseTempo -> ( { model | tempo = model.tempo - tempoStep }
DecreaseTempo ->
( { model | tempo = model.tempo - tempoStep }
, Cmd.none , Cmd.none
) )
SetTempo tempo -> ( { model |
tempo = case String.toInt tempo of ToggleInspectChord ->
Just x -> x ( { model
Nothing -> model.tempo | debug =
{ inspectChord = not model.debug.inspectChord
, enable = model.debug.enable
}
} }
, Cmd.none , 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 else
button [ onClick Pause ] [ text "Pause" ] 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
@ -259,21 +188,41 @@ view model =
or lower end of the piano. or lower end of the piano.
Chord: Chord:
""" ++ (inspectChord model.selectedChord)) ] """ ++ Theory.inspectChord model.selectedChord) ]
Just x -> Just x ->
div [] [ Tempo.render { tempo = model.tempo div []
[ Tempo.render
{ tempo = model.tempo
, handleIncrease = IncreaseTempo , handleIncrease = IncreaseTempo
, handleDecrease = DecreaseTempo , handleDecrease = DecreaseTempo
, handleInput = SetTempo , handleInput = SetTempo
} }
, playPause model , playPause model
, p [] [ text (viewChord model.selectedChord) ] , if model.debug.enable then
, Piano.render { highlight = x } 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. -}
{-| For now, I'm just dumping things onto the page to sketch ideas.
-}
main = main =
Browser.element { init = \() -> (init, Cmd.none) Browser.element
{ init = \() -> ( init, Cmd.none )
, subscriptions = subscriptions , subscriptions = subscriptions
, update = update , update = update
, view = view , 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,46 +4,95 @@ 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 {-| These are the white keys on most modern pianos.
natural offset isHighlit = -}
div [ style "background-color" (if isHighlit then "red" else "white") 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-right" "1px solid black"
, style "border-top" "1px solid black" , style "border-top" "1px solid black"
, style "border-bottom" "1px solid black" , style "border-bottom" "1px solid black"
, style "width" (pixelate naturalWidth) , style "width" (pixelate naturalWidth)
, style "height" (pixelate naturalHeight) , style "height" (pixelate naturalHeight)
, style "position" "absolute" , style "position" "absolute"
, style "left" ((String.fromInt offset) ++ "px") , style "left" (String.fromInt offset ++ "px")
] [] ]
[ p [] [ text (Theory.viewNote note) ] ]
{-| These are the black keys on most modern pianos. -}
accidental : Int -> Bool -> Html a {-| These are the black keys on most modern pianos.
accidental offset isHighlit = -}
div [ style "background-color" (if isHighlit then "red" else "black") 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-top" "1px solid black"
, style "border-left" "1px solid black" , style "border-left" "1px solid black"
, style "border-right" "1px solid black" , style "border-right" "1px solid black"
@ -51,32 +100,88 @@ accidental offset isHighlit =
, style "width" (pixelate accidentalWidth) , style "width" (pixelate accidentalWidth)
, style "height" (pixelate accidentalHeight) , style "height" (pixelate accidentalHeight)
, style "position" "absolute" , style "position" "absolute"
, style "left" ((String.fromInt offset) ++ "px") , style "left" (String.fromInt offset ++ "px")
, style "z-index" "1" , 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)
octave start end highlight =
let let
isHighlit note = List.member note highlight isHighlit note =
in List.member note highlight
[ 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)
]
{-| 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,6 +4,7 @@ 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
@ -11,12 +12,16 @@ type alias Props 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 []
[ p [] [ text (String.fromInt tempo ++ " BPM") ]
, button [ onClick handleDecrease ] [ text "Slower" ] , button [ onClick handleDecrease ] [ text "Slower" ]
, input [ onInput handleInput , input
[ onInput handleInput
, placeholder "Set tempo..." , placeholder "Set tempo..."
] [] ]
[]
, button [ onClick handleIncrease ] [ text "Faster" ] , button [ onClick handleIncrease ] [ text "Faster" ]
] ]

File diff suppressed because it is too large Load diff