diff options
Diffstat (limited to 'src/client/Chart/View.elm')
| -rw-r--r-- | src/client/Chart/View.elm | 182 |
1 files changed, 0 insertions, 182 deletions
diff --git a/src/client/Chart/View.elm b/src/client/Chart/View.elm deleted file mode 100644 index af8b4b7..0000000 --- a/src/client/Chart/View.elm +++ /dev/null @@ -1,182 +0,0 @@ -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 ] - ] |