"Chord Drill Sergeant" -> "Learn Piano Chords"
In the spirit of "keep it simple, stupid", I am naming this application as closely to the functionality as I can imagine.
This commit is contained in:
William Carroll
parent
39d084e493
commit
f0803547e4
20 changed files with 16 additions and 15 deletions
15
website/sandbox/learnpianochords/src/ChordInspector.elm
Normal file
15
website/sandbox/learnpianochords/src/ChordInspector.elm
Normal file
|
|
@ -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
|
||||
44
website/sandbox/learnpianochords/src/Icon.elm
Normal file
44
website/sandbox/learnpianochords/src/Icon.elm
Normal file
|
|
@ -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"
|
||||
]
|
||||
[]
|
||||
]
|
||||
555
website/sandbox/learnpianochords/src/Main.elm
Normal file
555
website/sandbox/learnpianochords/src/Main.elm
Normal file
|
|
@ -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
|
||||
}
|
||||
47
website/sandbox/learnpianochords/src/Misc.elm
Normal file
47
website/sandbox/learnpianochords/src/Misc.elm
Normal file
|
|
@ -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
|
||||
238
website/sandbox/learnpianochords/src/Piano.elm
Normal file
238
website/sandbox/learnpianochords/src/Piano.elm
Normal file
|
|
@ -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)
|
||||
24
website/sandbox/learnpianochords/src/Tempo.elm
Normal file
24
website/sandbox/learnpianochords/src/Tempo.elm
Normal file
|
|
@ -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 = []
|
||||
}
|
||||
]
|
||||
1100
website/sandbox/learnpianochords/src/Theory.elm
Normal file
1100
website/sandbox/learnpianochords/src/Theory.elm
Normal file
File diff suppressed because it is too large
Load diff
116
website/sandbox/learnpianochords/src/UI.elm
Normal file
116
website/sandbox/learnpianochords/src/UI.elm
Normal file
|
|
@ -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
|
||||
]
|
||||
[]
|
||||
Loading…
Add table
Add a link
Reference in a new issue