Commit ce9e14d5 authored by Mael NICOLAS's avatar Mael NICOLAS

OK, Title done, didn't did rich to long and complicated

parent 3f10486e
......@@ -3,9 +3,10 @@ module Charts.ECharts where
import Charts.Types
import Data.Either
import CSS (Color, borderColor, toHexString, turquoise, violet, yellowgreen)
import CSS (Color, black, blue, blueviolet, bolder, borderColor, fontWeight, green, italic, toHexString, turquoise, violet, white, yellow, yellowgreen)
import CSS.Common (class Bottom, normal)
import Data.Maybe (Maybe(..))
import Prelude (show)
import Prelude (show, ($))
import React as R
import React.DOM (p)
import React.DOM.Props (Props)
......@@ -115,33 +116,70 @@ title =
,text: "MudaTitre rpz les pyramides"
,link: "https://google.com"
,target: "blank"
,textStyle: Nothing
,textStyle: textStyle
,subtext: "Muda Subtitle"
,sublink: "https://google.fr"
,subtarget: "blank"
,subtextStyle: Nothing
,subtextStyle: textStyle2
,padding: 10.0
,itemGap: 0.0
,zlevel: 2.0
,z: 2.0
,left: renderLeftRelativePosition RightPos
,top: renderTopRelativePosition Middle
,left: renderRelativePosition (Relative Center)
,top: renderRelativePosition (Relative Middle)
,right: renderNumber 60.0
,bottom: renderPercentage 40.0
,backgroundColor: renderChartColor turquoise
,borderColor: renderChartColor violet
,borderWidth: 20.0
,backgroundColor: renderChartColor black
,borderColor: renderChartColor black
,borderWidth: 0.0
,borderRadius: Left 20.0
,shadowBlur: 40.0
,shadowColor: renderChartColor turquoise
,shadowOffsetX: 20.0
,shadowOffsetY: 40.0
,shadowBlur: 0.0
,shadowColor: renderChartColor black
,shadowOffsetX: 0.0
,shadowOffsetY: 0.0
}
textStyle :: ChartFontStyle
textStyle2 :: TextStyle
textStyle2 =
{
color: renderChartColor yellow
,fontStyle: renderChartFontStyle normal
,fontWeight: renderChartFontWeight normal
,fontFamily: "sans-serif"
,fontSize: 12
,align: renderRelativePosition $ Relative RightPos
,verticalAlign: renderRelativePosition $ Relative Bottom
,lineHeight: renderPercentage 0.0
,width: renderPercentage 100.0
,height: renderPercentage 100.0
,textBorderColor: renderChartColor blue
,textBorderWidth: 5.0
,textShadowColor: renderChartColor black
,textShadowBlur: renderChartColor black
,textShadowOffsetX: 0.0
,textShadowOffsetY: 0.0
}
textStyle :: TextStyle
textStyle =
{
color: renderChartColor white
,fontStyle: renderChartFontStyle normal
,fontWeight: renderChartFontWeight normal
,fontFamily: "sans-serif"
,fontSize: 12
,align: renderRelativePosition $ Relative LeftPos
,verticalAlign: renderRelativePosition $ Relative Top
,lineHeight: renderPercentage 0.0
,width: renderPercentage 100.0
,height: renderPercentage 100.0
,textBorderColor: renderChartColor blue
,textBorderWidth: 5.0
,textShadowColor: renderChartColor black
,textShadowBlur: renderChartColor black
,textShadowOffsetX: 0.0
,textShadowOffsetY: 0.0
}
charts :: Echarts
......@@ -185,7 +223,7 @@ histogram = echarts
, yAxis [ya1, ya2]
, series [sd1, sd2, sd3]
]
]
j ]
type DataZoom =
{"type" :: String
......
......@@ -2,7 +2,7 @@ module Charts.Types where
import Unsafe.Coerce
import CSS (Color, FontStyle(..), Value(..), toHexString, Prefixed(..))
import CSS (Color, FontStyle(..), FontWeight(..), Prefixed(..), Value(..), toHexString)
import Data.Either (Either)
import Data.Maybe (Maybe)
import Prelude ((<>), class Show, show, ($), Unit, (<<<))
......@@ -21,6 +21,10 @@ instance showLeftRelativePosition :: Show LeftRelativePosition
show (Center) = "center"
show (RightPos) = "right"
data Align p = Auto | Relative p
newtype ChartAlign = ChartAlign String
newtype ChartColor = ChartColor String
renderChartColor :: Color -> ChartColor
......@@ -36,10 +40,10 @@ renderChartFontStyle _ = ChartFontStyle "normal"
newtype ChartFontWeight = ChartFontWeight String
renderChartFontWeight :: FontWeight -> ChartFontWeight
renderChartFontWeight (FontStyle (Value (Plain "bold")))) = ChartFontWeight "bold"
renderChartFontWeight (FontStyle (Value (Plain "bolder")))) = ChartFontWeight "bolder"
renderChartFontWeight (FontStyle (Value (Plain "lighter")))) = ChartFontWeight "lighter"
renderChartFontWeight _ = ChartFontWeight "normal"
renderChartFontWeight (FontWeight (Value (Plain "bold"))) = ChartFontWeight "bold"
renderChartFontWeight (FontWeight (Value (Plain "bolder"))) = ChartFontWeight "bolder"
renderChartFontWeight (FontWeight (Value (Plain "lighter"))) = ChartFontWeight "lighter"
renderChartFontWeight _ = ChartFontWeight "normal"
foreign import data Position :: Type -> Type
......@@ -49,11 +53,9 @@ renderNumber = unsafeCoerce
renderPercentage :: forall r. Number -> Position r
renderPercentage n = unsafeCoerce $ (show n) <> "%"
renderTopRelativePosition :: TopRelativePosition -> Position TopRelativePosition
renderTopRelativePosition = unsafeCoerce <<< show
renderLeftRelativePosition :: LeftRelativePosition -> Position LeftRelativePosition
renderLeftRelativePosition = unsafeCoerce <<< show
renderRelativePosition :: forall a. Show a => Align a -> Position a
renderRelativePosition (Auto) = unsafeCoerce "auto"
renderRelativePosition (Relative r) = unsafeCoerce $ show r
type Echarts =
{ className :: Maybe String,
......@@ -89,11 +91,11 @@ type Title =
, text :: String -- default ''
, link :: String -- default ''
, target :: String -- default 'blank'
, textStyle :: Maybe TextStyle
, textStyle :: TextStyle
, subtext :: String -- default ''
, sublink :: String -- default ''
, subtarget :: String -- default 'blank'
, subtextStyle :: Maybe SubtextStyle
, subtextStyle :: TextStyle
, padding :: Number -- default '5'
, itemGap :: Number -- default '10'
, zlevel :: Number -- default '0'
......@@ -162,24 +164,23 @@ type Data =
, textStyle :: Maybe {}
}
type SubtextStyle =
type TextStyle =
{ color :: ChartColor
, fontStyle :: ChartFontStyle
, fontWeight :: ChartFontWeight
, fontFamily :: String
, fontSize :: Int
, align :: LeftRelativePosition
, verticalAlign :: String
, lineHeight :: Number
, width :: Number
, height :: Number
, textBorderColor :: String
, align :: Position LeftRelativePosition
, verticalAlign :: Position TopRelativePosition
, lineHeight :: Position Unit
, width :: Position Unit
, height :: Position Unit
, textBorderColor :: ChartColor
, textBorderWidth :: Number
, textShadowColor :: String
, textShadowBlur :: Number
, textShadowColor :: ChartColor
, textShadowBlur :: ChartColor
, textShadowOffsetX :: Number
, textShadowOffsetY :: Number
, rich :: Rich
}
type Tooltip =
......@@ -216,26 +217,4 @@ type Series =
, "data" :: Array Int
}
-- Props
type TextStyle =
{ color :: Color
, fontStyle :: String
, fontWeight :: String
, fontFamily :: String
, fontSize :: Int
, align :: String
, verticalAlign :: String
, lineHeight :: Int
, width :: Int
, height :: Int
, textBorderColor :: String
, textBorderWidth :: Int
, textShadowColor :: String
, textShadowBlur :: Int
, textShadowOffsetX :: Int
, textShadowOffsetY :: Int
, rich :: Rich
}
type Rich = {}
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment