Get text centering working
Required significant architectural changes
This commit is contained in:
Nathan McRae
@@ -1,24 +1,50 @@
|
||||
module TernaryGraph where
|
||||
|
||||
import Prelude (discard, class Monoid, class Semigroup, Unit, ($), (<=), (<<<), (<>), (*), (+), (-), (/))
|
||||
import Prelude (discard, class Monoid, class Semigroup, Unit, ($), (<=), (<<<), (<>), (*), (+), (-), (/), (&&))
|
||||
|
||||
import Data.Array ((!!), concat, cons, mapWithIndex, range)
|
||||
--import Data.Array ((!!), concat, cons, mapWithIndex, range)
|
||||
import Data.Array as Array
|
||||
import Data.Either as Either
|
||||
import Data.Functor (map)
|
||||
import Data.Int as Int
|
||||
import Data.List (fold)
|
||||
import Data.Maybe
|
||||
import Data.Map as Map
|
||||
import Data.Maybe as Maybe
|
||||
import Data.Number (cos, pi, sin)
|
||||
import Data.Number.Format (toString)
|
||||
import Data.Ord ((<))
|
||||
import Data.Ring (negate)
|
||||
import Data.Set as Set
|
||||
import Data.Tuple as Tup
|
||||
import Data.Tuple.Nested (Tuple3, tuple3, get1, get2, get3)
|
||||
|
||||
type Dimension =
|
||||
{ widthPx :: Number
|
||||
, heightPx :: Number
|
||||
}
|
||||
|
||||
type TextStyle =
|
||||
{ typeface :: String
|
||||
, sizePx :: Number
|
||||
}
|
||||
|
||||
type Point =
|
||||
{ x :: Number
|
||||
, y :: Number
|
||||
}
|
||||
|
||||
type GraphDefinition =
|
||||
{ axis1Label :: String
|
||||
, axis2Label :: String
|
||||
, axis3Label :: String
|
||||
, axis1Start :: Int
|
||||
, axis2Start :: Int
|
||||
, axis3Start :: Int
|
||||
, numTicks :: Int
|
||||
, tickTextStyle :: TextStyle
|
||||
, axisTitleTextStyle :: TextStyle
|
||||
}
|
||||
|
||||
type Line =
|
||||
{ start :: Point
|
||||
, end :: Point
|
||||
@@ -60,11 +86,14 @@ svgLine { start: {x: x1, y: y1}, end: {x: x2, y: y2} } =
|
||||
XMLFragment $ """<path style="fill:none;stroke:#000000;stroke-width:0.5;stroke-linecap:butt;stroke-linejoin:miter;stroke-dasharray:none;stroke-opacity:1"
|
||||
""" <> "d=\"M " <> (toString x1) <> "," <> (toString y1) <> " " <> (toString x2) <> "," <> (toString y2) <> "\"/>"
|
||||
|
||||
-- TODO: position at center of text
|
||||
svgText :: String -> Number -> Point -> Number -> XMLFragment
|
||||
svgText text fontSize { x: x, y: y } angle =
|
||||
XMLFragment $ "<text xml:space=\"preserve\" style=\"font-size:" <> (toString fontSize) <> "px;line-height:131%;font-family:'Liberation sans';font-variant-position:super;fill:#000000;stroke:#000000;stroke-width:0.0999998;stroke-linecap:round;stop-color:#000000;fill-opacity:1\" "
|
||||
<> "transform=\"translate(" <> (toString x) <> ", " <> (toString y) <> ") rotate(" <> (toString angle) <> ")\">" <> text <> "</text>"
|
||||
svgText :: String -> Point -> Number -> TextStyle -> Dimension -> XMLFragment
|
||||
svgText text { x: x, y: y } angle style dimension =
|
||||
XMLFragment $ "<text xml:space=\"preserve\" style=\"font-size:" <> (toString style.sizePx) <> "px;line-height:131%;font-family:'" <> style.typeface <> "';font-variant-position:super;fill:#000000;stroke:#000000;stroke-width:0.0999998;stroke-linecap:round;stop-color:#000000;fill-opacity:1\" "
|
||||
<> "transform=\"translate(" <> (toString centerX) <> ", " <> (toString centerY) <> ") rotate(" <> (toString angle) <> ")\">" <> text <> "</text>"
|
||||
where
|
||||
-- TODO: why /4? this also was needed in python implementation
|
||||
centerX = x - dimension.widthPx / 4.0
|
||||
centerY = y - dimension.heightPx / 4.0
|
||||
|
||||
-- TODO: Make axis tick size a parameter
|
||||
getTick :: Number -> Int -> Int -> Line
|
||||
@@ -80,7 +109,7 @@ getTicks :: Number -> Number -> Int -> Tuple3 (Array Line) (Array Line) (Array L
|
||||
getTicks scale angle numTicks =
|
||||
tuple3 axis1Lines axis2Lines axis3Lines
|
||||
where
|
||||
foo = map (getTick scale numTicks) (range 0 numTicks)
|
||||
foo = map (getTick scale numTicks) (Array.range 0 numTicks)
|
||||
axis1Lines = map (rotateLine angle) foo
|
||||
axis2Lines = map (rotateLine (2.0 * pi / 3.0)) axis1Lines
|
||||
axis3Lines = map (rotateLine (2.0 * pi / 3.0)) axis2Lines
|
||||
@@ -105,30 +134,30 @@ ternaryGraphSvg fragments = """<?xml version="1.0" encoding="UTF-8"?>
|
||||
axesPoints :: Number -> Tuple3 Point Point Point
|
||||
axesPoints angle = tuple3
|
||||
(rotate angle { x: 0.0, y: 1.0 })
|
||||
(rotate angle { x: -(sin (2.0 * pi / 3.0)), y : -0.5})
|
||||
(rotate angle { x: -(sin (2.0 * pi / 3.0)), y : -0.5 })
|
||||
(rotate angle { x: (sin (2.0 * pi / 3.0)), y: -0.5 })
|
||||
|
||||
axesPath :: Point -> Point -> Point -> XMLFragment
|
||||
axesPath p1 p2 p3 = XMLFragment $ """<path style="fill:none;stroke:#000000;stroke-width:1;stroke-linecap:bevel;stroke-linejoin:bevel;stroke-dasharray:none;stroke-opacity:1"
|
||||
""" <> "d=\"M " <> (toString p1.x) <> "," <> (toString p1.y) <> " " <> (toString p2.x) <> "," <> (toString p2.y) <> " " <> (toString p3.x) <> "," <> (toString p3.y) <> " Z\"/>"
|
||||
|
||||
tickLabelStrings :: Int -> Int -> Int -> Int -> Set.Set String
|
||||
tickLabelStrings numTicks axis1Start axis2Start axis3Start =
|
||||
tickLabelStrings :: GraphDefinition -> Set.Set String
|
||||
tickLabelStrings def =
|
||||
Set.map (\x -> "E" <> (toString (Int.toNumber x))) axisTicks
|
||||
where
|
||||
axis1Ticks = Set.fromFoldable (range axis1Start (axis1Start + numTicks - 1))
|
||||
axis2Ticks = Set.fromFoldable (range axis2Start (axis2Start + numTicks - 1))
|
||||
axis3Ticks = Set.fromFoldable (range axis3Start (axis3Start + numTicks - 1))
|
||||
axis1Ticks = Set.fromFoldable (Array.range def.axis1Start (def.axis1Start + def.numTicks))
|
||||
axis2Ticks = Set.fromFoldable (Array.range def.axis2Start (def.axis2Start + def.numTicks))
|
||||
axis3Ticks = Set.fromFoldable (Array.range def.axis3Start (def.axis3Start + def.numTicks))
|
||||
axisTicks = Set.union (Set.union axis1Ticks axis2Ticks) axis3Ticks
|
||||
|
||||
ternaryGraph :: Number -> Number -> Number -> Int -> String
|
||||
ternaryGraph scale xOffset yOffset numTicks = ternaryGraphSvg fragments
|
||||
ternaryGraph :: Number -> Number -> Number -> GraphDefinition -> Map.Map (Tup.Tuple String TextStyle) Dimension -> Either.Either String String
|
||||
ternaryGraph scale xOffset yOffset definition textDimensions = result
|
||||
where
|
||||
axisTickLines = getTicks scale pi numTicks
|
||||
axisTickLines = getTicks scale pi definition.numTicks
|
||||
axis1TickLines = map (transformLine scale xOffset yOffset) (get1 axisTickLines)
|
||||
axis2TickLines = map (transformLine scale xOffset yOffset) (get2 axisTickLines)
|
||||
axis3TickLines = map (transformLine scale xOffset yOffset) (get3 axisTickLines)
|
||||
tickLines = concat [axis1TickLines, axis2TickLines, axis3TickLines]
|
||||
tickLines = Array.concat [axis1TickLines, axis2TickLines, axis3TickLines]
|
||||
tickLinesSvg = fold $ map svgLine tickLines
|
||||
|
||||
axesPointsPi = axesPoints pi
|
||||
@@ -137,27 +166,55 @@ ternaryGraph scale xOffset yOffset numTicks = ternaryGraphSvg fragments
|
||||
axisPoint3 = transform scale xOffset yOffset (get3 axesPointsPi)
|
||||
axesPathSvg = axesPath axisPoint1 axisPoint2 axisPoint3
|
||||
|
||||
-- TODO: axis text size
|
||||
axis1TitleDim = Map.lookup (Tup.Tuple definition.axis1Label definition.axisTitleTextStyle) textDimensions
|
||||
axis2TitleDim = Map.lookup (Tup.Tuple definition.axis2Label definition.axisTitleTextStyle) textDimensions
|
||||
axis3TitleDim = Map.lookup (Tup.Tuple definition.axis3Label definition.axisTitleTextStyle) textDimensions
|
||||
|
||||
axisTitleSize = definition.axisTitleTextStyle.sizePx
|
||||
axisTitlesSvg :: Array (Either.Either String XMLFragment)
|
||||
axisTitlesSvg = [
|
||||
svgText "axis 1" 12.0 (transform scale xOffset yOffset {x: 0.0, y: 0.9}) 0.0,
|
||||
svgText "axis 2" 12.0 (transform scale xOffset yOffset {x: -(sin (2.0 * pi / 3.0)), y: -0.7}) (-60.0),
|
||||
svgText "axis 3" 12.0 (transform scale xOffset yOffset {x: (sin (2.8 * pi / 3.0)), y: -0.7}) 60.0
|
||||
case axis1TitleDim of
|
||||
Maybe.Nothing -> Either.Left ("Failed to find '" <> definition.axis1Label <> "' in dimensions map")
|
||||
Maybe.Just dim -> Either.Right $ svgText definition.axis1Label (transform scale xOffset yOffset {x: 0.0, y: 0.9}) 0.0 definition.axisTitleTextStyle dim,
|
||||
case axis2TitleDim of
|
||||
Maybe.Nothing -> Either.Left ("Failed to find '" <> definition.axis2Label <> "' in dimensions map")
|
||||
Maybe.Just dim -> Either.Right $ svgText definition.axis2Label (transform scale xOffset yOffset {x: -(sin (2.0 * pi / 3.0)), y: -0.7}) (-60.0) definition.axisTitleTextStyle dim,
|
||||
case axis3TitleDim of
|
||||
Maybe.Nothing -> Either.Left ("Failed to find '" <> definition.axis3Label <> "' in dimensions map")
|
||||
Maybe.Just dim -> Either.Right $ svgText definition.axis3Label (transform scale xOffset yOffset {x: (sin (2.8 * pi / 3.0)), y: -0.7}) 60.0 definition.axisTitleTextStyle dim
|
||||
]
|
||||
|
||||
axisTickStarts = map (\line -> line.start)
|
||||
-- TODO: tick label size
|
||||
-- TODO: axis tick label rotation
|
||||
-- TODO: axis tick start number
|
||||
axisTickLabels = \rotation -> mapWithIndex (\i point -> svgText ("E" <> (toString (Int.toNumber i))) 10.0 point 0.0)
|
||||
-- svgText :: String -> Point -> Number -> TextStyle -> Dimension -> XMLFragment
|
||||
-- svgText text { x: x, y: y } angle style dimension =
|
||||
|
||||
axisTickLabels = \rotation startI -> Array.mapWithIndex (\i point ->
|
||||
let text = ("E" <> (toString (Int.toNumber (i + startI))))
|
||||
angle = 0.0
|
||||
labelText = case Map.lookup (Tup.Tuple text definition.tickTextStyle) textDimensions of
|
||||
Maybe.Nothing -> Either.Left ("Failed to find '" <> text <> "' in dimensions map")
|
||||
Maybe.Just dimension -> Either.Right $ svgText text point angle definition.tickTextStyle dimension
|
||||
in labelText
|
||||
)
|
||||
|
||||
axis1TickLabels = axisTickLabels 0 $ axisTickStarts axis1TickLines
|
||||
axis2TickLabels = axisTickLabels 0 $ axisTickStarts axis2TickLines
|
||||
axis3TickLabels = axisTickLabels 0 $ axisTickStarts axis3TickLines
|
||||
axis1TickLabels :: Array (Either.Either String XMLFragment)
|
||||
axis1TickLabels = axisTickLabels 0.0 definition.axis1Start $ axisTickStarts axis1TickLines
|
||||
axis2TickLabels = axisTickLabels 0.0 definition.axis2Start $ axisTickStarts axis2TickLines
|
||||
axis3TickLabels = axisTickLabels 0.0 definition.axis3Start $ axisTickStarts axis3TickLines
|
||||
|
||||
tickLabelsSvg = concat [
|
||||
axis1TickLabels,
|
||||
axis2TickLabels,
|
||||
axis3TickLabels
|
||||
]
|
||||
labelFragmentsErr = Array.concat [axisTitlesSvg, axis1TickLabels, axis2TickLabels, axis3TickLabels]
|
||||
|
||||
fragments = concat [[tickLinesSvg, axesPathSvg], axisTitlesSvg, tickLabelsSvg]
|
||||
labelFragments = Array.foldr (\labelFragmentErr soFar -> case labelFragmentErr of
|
||||
Either.Left _ -> soFar
|
||||
Either.Right labelFragment -> Array.cons labelFragment soFar) [] labelFragmentsErr
|
||||
|
||||
errors = Array.foldr (\labelFragmentErr soFar -> case labelFragmentErr of
|
||||
Either.Left labelFragment -> Array.cons labelFragment soFar
|
||||
Either.Right _ -> soFar) [] labelFragmentsErr
|
||||
|
||||
fragments = Array.concat [[tickLinesSvg, axesPathSvg], labelFragments]
|
||||
result = if Array.all (\x -> Either.isRight x) labelFragmentsErr then
|
||||
Either.Right $ ternaryGraphSvg fragments
|
||||
else
|
||||
-- TODO: Include specific labels
|
||||
Either.Left $ Array.intercalate "\n" errors
|
||||
Reference in New Issue
Block a user