diff options
Diffstat (limited to 'website/sandbox/chord-drill-sergeant/src/Piano.elm')
| -rw-r--r-- | website/sandbox/chord-drill-sergeant/src/Piano.elm | 231 |
1 files changed, 168 insertions, 63 deletions
diff --git a/website/sandbox/chord-drill-sergeant/src/Piano.elm b/website/sandbox/chord-drill-sergeant/src/Piano.elm index 048208c1f556..80c24834c1c8 100644 --- a/website/sandbox/chord-drill-sergeant/src/Piano.elm +++ b/website/sandbox/chord-drill-sergeant/src/Piano.elm @@ -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) - -{-| 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" - ] [] +accidentalHeight = + round (toFloat naturalHeight * 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") + ] + [ 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) - ] - -{-| 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) +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 + + 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) |