1 files changed, 182 insertions, 0 deletions
diff --git a/src/client/Chart/View.elm b/src/client/Chart/View.elm
new file mode 100644
index 0000000..af8b4b7
--- /dev/null
+++ b/src/client/Chart/View.elm
@@ -0,0 +1,182 @@
+module Chart.View exposing
+  ( view
+  )
+
+import Html exposing (Html)
+import List.Extra as List
+import Svg exposing (..)
+import Svg.Attributes exposing (..)
+
+import Chart.Model as Chart exposing (Chart, Serie, Vec2, View)
+import Utils.List as List
+
+view : Chart -> Html msg
+view chart =
+  let { size, title, series } = chart
+      titleHeight = 100
+      captionHeight = 50
+  in  svg
+        [ width << toString <| size.x
+        , height << toString <| size.y
+        , viewBox ("0 0 " ++ (toString size.x) ++ " " ++ (toString size.y))
+        ]
+        (  [ renderTitle (Chart.mkView { x = 0, y = 0 } { x = size.x, y = titleHeight }) title ]
+        ++ renderSeriesAndScales (Chart.mkView { x = 50, y = titleHeight } { x = size.x, y = size.y - captionHeight }) chart
+        ++ renderCaptions (Chart.mkView { x = 0, y = size.y - captionHeight } { x = size.x, y = size.y }) series
+        )
+
+renderTitle : View -> String -> Svg msg
+renderTitle view title =
+  text_
+    [ x << toString <| view.fx 0.5
+    , y << toString <| view.fy 0.5
+    , textAnchor "middle"
+    , dominantBaseline "middle"
+    , fontSize "20"
+    ]
+    [ text title ]
+
+renderSeriesAndScales : View -> Chart -> List (Svg msg)
+renderSeriesAndScales view chart =
+  let { keys, series, scaleColor, formatOrdinate } = chart
+      (p1, p2) = Chart.bounds view
+      ordinateWidth = 100
+      abscissaHeight = 60
+      maxScale = Chart.maxScale chart
+  in  (  renderOrdinates (Chart.mkView { x = p1.x, y = p1.y } { x = p1.x + ordinateWidth, y = p2.y - abscissaHeight }) formatOrdinate maxScale
+      ++ renderAbscissas (Chart.mkView { x = p1.x + ordinateWidth, y = p2.y - abscissaHeight } { x = p2.x, y = p2.y }) keys scaleColor
+      ++ renderSeries (Chart.mkView { x = p1.x + ordinateWidth, y = p1.y } { x = p2.x, y = p2.y - abscissaHeight }) series maxScale scaleColor
+      )
+
+renderOrdinates : View -> (Float -> String) -> Float -> List (Svg msg)
+renderOrdinates view formatOrdinate maxScale =
+  ordinates
+    |> List.map (\l ->
+         text_
+           [ x << toString <| view.fx 0.5
+           , y << toString <| view.fy l
+           , textAnchor "middle"
+           , dominantBaseline "middle"
+           ]
+           [ text << formatOrdinate <| (1 - l) * maxScale ]
+       )
+
+
+renderAbscissas : View -> List String -> String -> List (Svg msg)
+renderAbscissas view keys scaleColor =
+  let count = List.length keys
+  in  ( abscissasXPositions keys
+          |> List.map (\(xPos, key) ->
+               [ text_
+                   [ x << toString <| view.fx xPos
+                   , y << toString <| view.fy 0.5
+                   , textAnchor "middle"
+                   , dominantBaseline "middle"
+                   ]
+                   [ text key ]
+               , line
+                   [ x1 << toString <| view.fx xPos
+                   , y1 << toString <| view.fy 0
+                   , x2 << toString <| view.fx xPos
+                   , y2 << toString <| view.fy 0.2
+                   , stroke scaleColor
+                   ]
+                   []
+               ]
+             )
+          |> List.concat
+      )
+
+renderSeries : View -> List Serie -> Float -> String -> List (Svg msg)
+renderSeries view series maxScale scaleColor =
+  (  renderHorizontalLines view series scaleColor
+  ++ renderPoints view series maxScale
+  )
+
+renderHorizontalLines : View -> List Serie -> String -> List (Svg msg)
+renderHorizontalLines view series scaleColor =
+  ordinates
+    |> List.map (\l ->
+         line
+           [ x1 << toString <| view.fx 0
+           , y1 << toString <| view.fy l
+           , x2 << toString <| view.fx 1
+           , y2 << toString <| view.fy l
+           , stroke scaleColor
+           ]
+           []
+       )
+
+renderPoints : View -> List Serie -> Float -> List (Svg msg)
+renderPoints view series maxScale =
+  series
+    |> List.map (\serie ->
+         let points =
+               abscissasXPositions serie.values
+                 |> List.map (\(xPos, value) -> { x = xPos, y = 1 - value / maxScale })
+         in  [ renderLines view serie.color points
+             , List.map (renderPoint view serie.color) points
+             ]
+               |> List.concat
+       )
+    |> List.concat
+
+renderLines : View -> String -> List Vec2 -> List (Svg msg)
+renderLines view color points =
+  List.links points
+    |> List.map (\(p1, p2) ->
+         line
+           [ x1 << toString <| view.fx p1.x
+           , y1 << toString <| view.fy p1.y
+           , x2 << toString <| view.fx p2.x
+           , y2 << toString <| view.fy p2.y
+           , stroke color
+           ]
+           []
+       )
+
+renderPoint : View -> String -> Vec2 -> Svg msg
+renderPoint view color pos =
+  circle
+    [ cx << toString <| view.fx pos.x
+    , cy << toString <| view.fy pos.y
+    , r "4"
+    , fill color
+    ]
+    []
+
+abscissasXPositions : List a -> List (Float, a)
+abscissasXPositions xs =
+  let count = List.length xs
+  in  xs
+        |> List.zip (List.range 1 (count + 1))
+        |> List.map (\(i, x) -> (toFloat i / (toFloat count + 1), x))
+
+ordinates : List Float
+ordinates =
+  let count = 10
+  in  List.range 0 (count - 1)
+        |> List.map (\l -> toFloat l / (toFloat count - 1))
+
+renderCaptions : View -> List Serie -> List (Svg msg)
+renderCaptions view series =
+  let count = List.length series
+  in  series
+        |> List.zip (List.range 1 (List.length series))
+        |> List.map (\(i, serie) ->
+             renderCaption { x = view.fx (toFloat i / (toFloat count + 1)), y = view.fy 0.5 } serie
+           )
+        |> List.concat
+
+renderCaption : Vec2 -> Serie -> List (Svg msg)
+renderCaption point { label, color } =
+  [ text_
+      [ x << toString <| point.x
+      , y << toString <| point.y
+      , textAnchor "middle"
+      , dominantBaseline "middle"
+      , fill color
+      , fontSize "18"
+      ]
+      [ text label ]
+  ]