aboutsummaryrefslogtreecommitdiff
path: root/src/client/Chart
diff options
context:
space:
mode:
Diffstat (limited to 'src/client/Chart')
-rw-r--r--src/client/Chart/Api.elm41
-rw-r--r--src/client/Chart/Model.elm73
-rw-r--r--src/client/Chart/View.elm182
3 files changed, 0 insertions, 296 deletions
diff --git a/src/client/Chart/Api.elm b/src/client/Chart/Api.elm
deleted file mode 100644
index 693f362..0000000
--- a/src/client/Chart/Api.elm
+++ /dev/null
@@ -1,41 +0,0 @@
-module Chart.Api exposing
- ( from
- , withSize
- , withTitle
- , withOrdinate
- , toHtml
- )
-
-import Html exposing (Html)
-import Svg exposing (..)
-import Svg.Attributes exposing (..)
-
-import Chart.Model as Chart exposing (Chart, Serie, Vec2, View)
-import Chart.View as Chart
-
-from : List String -> List Serie -> Chart
-from keys series =
- { keys = keys
- , series = series
- , size = { x = 600, y = 400 }
- , title = ""
- , scaleColor = "#DDDDDD"
- , formatOrdinate = toString
- , ordinateLines = 5
- }
-
-withSize : Vec2 -> Chart -> Chart
-withSize size chart = { chart | size = size }
-
-withTitle : String -> Chart -> Chart
-withTitle title chart = { chart | title = title }
-
-withOrdinate : Int -> (Float -> String) -> Chart -> Chart
-withOrdinate lines format chart =
- { chart
- | formatOrdinate = format
- , ordinateLines = lines
- }
-
-toHtml : Chart -> Html msg
-toHtml chart = Chart.view chart
diff --git a/src/client/Chart/Model.elm b/src/client/Chart/Model.elm
deleted file mode 100644
index b5c176f..0000000
--- a/src/client/Chart/Model.elm
+++ /dev/null
@@ -1,73 +0,0 @@
-module Chart.Model exposing
- ( Chart
- , Serie
- , maxScale
- , Vec2
- , View
- , mkView
- , bounds
- )
-
-import List.Extra as List
-
-type alias Chart =
- { keys : List String
- , series : List Serie
- , size : Vec2
- , title : String
- , scaleColor : String
- , formatOrdinate : Float -> String
- , ordinateLines : Int
- }
-
-type alias Serie =
- { values : List Float
- , color : String
- , label : String
- }
-
-maxScale : Chart -> Float
-maxScale { keys, series } =
- List.range 0 (List.length keys - 1)
- |> List.map (\i ->
- series
- |> List.map (truncate << Maybe.withDefault 0 << List.getAt i << .values)
- |> List.maximum
- |> Maybe.withDefault 0
- )
- |> List.maximum
- |> Maybe.withDefault 0
- |> upperBound
-
-upperBound : Int -> Float
-upperBound n = toFloat (upperBoundInt 0 n)
-
-upperBoundInt : Int -> Int -> Int
-upperBoundInt count n =
- if n < 10
- then
- (n + 1) * (10 ^ count)
- else
- upperBoundInt (count + 1) (n // 10)
-
-type alias Vec2 =
- { x : Float
- , y : Float
- }
-
-type alias View =
- { fx : Float -> Float
- , fy : Float -> Float
- }
-
-mkView : Vec2 -> Vec2 -> View
-mkView p1 p2 =
- { fx = \x -> p1.x + x * (p2.x - p1.x)
- , fy = \y -> p1.y + y * (p2.y - p1.y)
- }
-
-bounds : View -> (Vec2, Vec2)
-bounds { fx, fy } =
- ( { x = fx 0, y = fy 0 }
- , { x = fx 1, y = fy 1 }
- )
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 ]
- ]