circle/VisualizationTest.elm at master · stefkin/circle · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
module VisualizationTest exposing (circleVisualization)

import ColorScheme exposing (CellColor, majorCellColor, minorCellColor,
                             diminishedCellColor, blankChordColor, regularNoteColor,
                             selectedChordColor)

import ListUtils exposing (zip, find, indexOf)
import Array exposing (Array)
import Path
import Shape exposing (defaultPieConfig, Arc)
import TypedSvg exposing (g, svg, text_)
import TypedSvg.Attributes exposing (fontWeight, fontSize, dy, fill, stroke, textAnchor, transform, viewBox)
import TypedSvg.Attributes.InPx exposing (height, width)
import TypedSvg.Core exposing (Svg, text)
import TypedSvg.Types exposing (FontWeight(..), Length(..), AnchorAlignment(..), Fill(..), Transform(..), em)

w = 500
h = 500

defaultArcConfig : Arc
defaultArcConfig =
    { innerRadius = radius - 100
    , outerRadius = radius
    , cornerRadius = 0
    , startAngle = 0
    , endAngle = 360 / 12
    , padAngle = 0
    , padRadius = 0
    }

toRad : Float -> Float
toRad deg = deg * pi / 180

buildArcConfig : {outerRadius: Float, innerRadius: Float} -> Int -> Arc
buildArcConfig baseConfig index =
  { defaultArcConfig |
    outerRadius = baseConfig.outerRadius,
    innerRadius = baseConfig.innerRadius,
    startAngle = toRad (toFloat index) * 30,
    endAngle = toRad ((toFloat index) + 1) * 30
  }

radius : Float
radius =
    min w h / 2

makeLabel : (Int -> Arc) -> Int -> (String, CellColor) -> Svg msg
makeLabel arcBuilder index (label, color) =
    let
        arc = arcBuilder index
        ( x, y ) =
            Shape.centroid { arc |
              innerRadius = (arc.outerRadius + arc.innerRadius) / 2,
              outerRadius = (arc.outerRadius + arc.innerRadius) / 2
            }
    in
        text_
            [ transform [ Translate x y ]
            , dy (em 0.35)
            , fontSize <| Px 25
            , fontWeight FontWeightBold
            , textAnchor AnchorMiddle
            , fill <| Fill color.text
            ]
            [ text label ]

makeDonutSector : (Int -> Arc) -> Int -> (a, CellColor) -> Svg msg
makeDonutSector arcBuilder index (label, color) =
    Path.element (Shape.arc <| arcBuilder index)
        [ fill <| Fill color.background, stroke blankChordColor.background ]

circleVisualization : List String -> List String -> List String -> Svg msg
circleVisualization circleWrap selectedScale chords =
    let
      circleWrap_ =
          List.map (\n ->
            case indexOf n selectedScale of
              Just 0 -> (n, majorCellColor)
              Just 1 -> (n, majorCellColor)
              Just 2 -> (n, majorCellColor)
              Just 3 -> (n, minorCellColor)
              Just 4 -> (n, minorCellColor)
              Just 5 -> (n, minorCellColor)
              Just 6 -> (n, diminishedCellColor)
              _      -> (n, regularNoteColor)
              ) circleWrap

      chords_ =
          let
              zz = zip selectedScale chords
              noteToChord n =
                  Tuple.second (Maybe.withDefault ("", "") <| find (\(n_,c) -> n == n_) zz)
          in
            List.map (\n -> if List.member n selectedScale then (noteToChord n, selectedChordColor) else ("", blankChordColor)) circleWrap

      outerDonutSettings = buildArcConfig { outerRadius = radius, innerRadius = radius - 60 }
      innerDonutSettings = buildArcConfig { outerRadius = radius - 60, innerRadius = radius - 100 }
    in
        svg [ viewBox 0 0 w h ]
        [ g [ transform [ Translate (w / 2) (h / 2) ] ]
            [ g [] <| List.indexedMap (makeDonutSector outerDonutSettings) circleWrap_
            , g [] <| List.indexedMap (makeLabel outerDonutSettings) circleWrap_
            , g [] <| List.indexedMap (makeDonutSector innerDonutSettings) chords_
            , g [] <| List.indexedMap (makeLabel innerDonutSettings) chords_
            ]
        ]