diff options
Diffstat (limited to 'src/client/Chart')
-rw-r--r-- | src/client/Chart/Api.elm | 41 | ||||
-rw-r--r-- | src/client/Chart/Model.elm | 73 | ||||
-rw-r--r-- | src/client/Chart/View.elm | 182 |
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 ] - ] |