diff options
| -rw-r--r-- | website/sandbox/chord-drill-sergeant/elm.json | 1 | ||||
| -rw-r--r-- | website/sandbox/chord-drill-sergeant/src/Icon.elm | 44 | ||||
| -rw-r--r-- | website/sandbox/chord-drill-sergeant/src/Main.elm | 96 | ||||
| -rw-r--r-- | website/sandbox/chord-drill-sergeant/src/Piano.elm | 209 | ||||
| -rw-r--r-- | website/sandbox/chord-drill-sergeant/src/UI.elm | 2 |
5 files changed, 236 insertions, 116 deletions
diff --git a/website/sandbox/chord-drill-sergeant/elm.json b/website/sandbox/chord-drill-sergeant/elm.json index f42a3cd27436..a95f80408ec4 100644 --- a/website/sandbox/chord-drill-sergeant/elm.json +++ b/website/sandbox/chord-drill-sergeant/elm.json @@ -10,6 +10,7 @@ "elm/core": "1.0.5", "elm/html": "1.0.0", "elm/random": "1.0.0", + "elm/svg": "1.0.1", "elm/time": "1.0.0", "elm-community/list-extra": "8.2.3", "elm-community/maybe-extra": "5.2.0", diff --git a/website/sandbox/chord-drill-sergeant/src/Icon.elm b/website/sandbox/chord-drill-sergeant/src/Icon.elm new file mode 100644 index 000000000000..2c8626b09293 --- /dev/null +++ b/website/sandbox/chord-drill-sergeant/src/Icon.elm @@ -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" + ] + [] + ] diff --git a/website/sandbox/chord-drill-sergeant/src/Main.elm b/website/sandbox/chord-drill-sergeant/src/Main.elm index f13412a0a9f4..2f3eef317df4 100644 --- a/website/sandbox/chord-drill-sergeant/src/Main.elm +++ b/website/sandbox/chord-drill-sergeant/src/Main.elm @@ -4,6 +4,7 @@ import Browser import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (..) +import Icon import Piano import Random import Random.List @@ -57,6 +58,7 @@ type Msg | SetPracticeMode PracticeMode | SelectAllKeys | DeselectAllKeys + | SetView View {-| The amount by which we increase or decrease tempo. @@ -84,7 +86,7 @@ init : Model init = let ( firstNote, lastNote ) = - ( Theory.A1, Theory.C8 ) + ( Theory.C3, Theory.C6 ) inversions = Theory.allInversions @@ -124,7 +126,7 @@ init = , tempo = 30 , firstNote = firstNote , lastNote = lastNote - , view = Preferences + , view = Practice } @@ -153,6 +155,13 @@ update msg model = , Cmd.none ) + SetView x -> + ( { model + | view = x + } + , Cmd.none + ) + SelectAllKeys -> ( { model | whitelistedKeys = Theory.allKeys @@ -412,28 +421,6 @@ keyCheckboxes model = ] -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" ] @@ -465,10 +452,29 @@ practiceModeButtons model = ] +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" ] - [ Tempo.render + [ closePreferences + , Tempo.render { tempo = model.tempo , handleInput = SetTempo } @@ -487,18 +493,36 @@ preferences model = practice : Model -> Html Msg practice model = - div [] - [ playPause model - , case model.selectedChord of - Just chord -> - displayChord - { chord = chord - , firstNote = model.firstNote - , lastNote = model.lastNote - } + let + classes = + [ "bg-gray-600" + , "h-screen" + , "w-full" + , "absolute" + , "z-10" + , "text-6xl" + ] - Nothing -> - p [] [ text "No chord to display" ] + ( handleClick, extraClasses, buttonText ) = + if model.isPaused then + ( Play, [ "opacity-50" ], "Press to resume" ) + + 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 + } ] diff --git a/website/sandbox/chord-drill-sergeant/src/Piano.elm b/website/sandbox/chord-drill-sergeant/src/Piano.elm index f539f95fc9f6..b100cb9cf573 100644 --- a/website/sandbox/chord-drill-sergeant/src/Piano.elm +++ b/website/sandbox/chord-drill-sergeant/src/Piano.elm @@ -8,10 +8,18 @@ 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 @@ -32,121 +40,149 @@ pixelate x = {-| Pixel width of the white keys. -} -naturalWidth : Int -naturalWidth = - 45 +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 : Int -naturalHeight = - 250 +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 : Int -accidentalWidth = - round (toFloat naturalWidth * 0.4) +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 : Int -accidentalHeight = - round (toFloat naturalHeight * 0.63) +accidentalHeight : Direction -> Int +accidentalHeight direction = + case direction of + Vertical -> + round (toFloat (naturalHeight direction) * 0.63) + Horizontal -> + round (toFloat (naturalHeight direction) * 0.63) -{-| 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") - ] - [] - - -{-| These are the black keys on most modern pianos. +{-| Return the markup for either a white or a black key. -} -accidental : KeyMarkup a -accidental { offset, isHighlit, note } = +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 - "black" + 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 "border-bottom" "1px solid black" - , style "width" (pixelate accidentalWidth) - , style "height" (pixelate accidentalHeight) + , style "width" (pixelate keyWidth) + , style "height" (pixelate keyHeight) , style "position" "absolute" - , style "left" (String.fromInt offset ++ "px") - , style "z-index" "1" + , style offsetEdge (String.fromInt offset ++ "px") + , class <| String.join " " (List.concat [ sharedClasses, extraClasses ]) ] [] -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. +{-| A section of the piano consisting of all twelve notes. -} -octave : Theory.Note -> Theory.Note -> List Theory.Note -> List (Html a) -octave start end highlight = +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 ) of - ( Theory.Natural, Theory.Accidental ) -> - -- idk this calculation yet - prevOffset + naturalWidth - round (toFloat accidentalWidth / 2) + 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.Accidental, Theory.Natural ) -> - -- accidentalWidth / 2 - prevOffset + round (toFloat accidentalWidth / 2) + ( Theory.Natural, Theory.Natural, Horizontal ) -> + prevOffset + naturalWidth direction - ( Theory.Natural, Theory.Natural ) -> - -- naturalWidth - prevOffset + naturalWidth + -- 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. _ -> @@ -158,7 +194,16 @@ octave start end highlight = (\curr ( prevOffset, prev, result ) -> case ( prevOffset, prev ) of ( Nothing, Nothing ) -> - ( Just 0, Just curr, makeKey highlight curr 0 :: result ) + ( Just 0 + , Just curr + , pianoKey + { offset = 0 + , isHighlit = List.member curr highlight + , note = curr + , direction = direction + } + :: result + ) ( Just po, Just p ) -> let @@ -167,7 +212,13 @@ octave start end highlight = in ( Just offset , Just curr - , makeKey highlight curr offset :: result + , pianoKey + { offset = offset + , isHighlit = List.member curr highlight + , note = curr + , direction = direction + } + :: result ) -- This pattern should never hit. @@ -184,4 +235,4 @@ octave start end highlight = render : Props -> Html a render { highlight, start, end } = div [ style "display" "flex" ] - (octave start end highlight |> List.reverse |> List.repeat 1 |> List.concat) + (keys Vertical start end highlight |> List.reverse |> List.repeat 1 |> List.concat) diff --git a/website/sandbox/chord-drill-sergeant/src/UI.elm b/website/sandbox/chord-drill-sergeant/src/UI.elm index dff645f4796a..00114332db89 100644 --- a/website/sandbox/chord-drill-sergeant/src/UI.elm +++ b/website/sandbox/chord-drill-sergeant/src/UI.elm @@ -79,7 +79,7 @@ textToggleButton { label, toggled, handleClick, classes } = buttonClasses = [ textColor , textTreatment - , "py-10" + , "py-8" , "px-10" , "text-5xl" ] |