nathanmcrae/ternary-graph-generator
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Get basic output working

Browse Source
This commit is contained in:
Nathan McRae
2025-07-20 16:48:39 -07:00
parent 445a976f2e
commit 9c24c884a6
1 changed files with 25 additions and 22 deletions
Download Patch File Download Diff File Expand all files Collapse all files

45
src/Main.purs
View File

@@ -1,10 +1,11 @@
module Main where module Main where
import Prelude (discard, class Monoid, class Semigroup, Unit, ($), (<<<), (<>), (*), (+), (-), (/)) import Prelude ( discard, class Monoid, class Semigroup, Unit, ($), (<<<), (<>), (*), (+), (-), (/))
import Data.Array (range, concat, mapWithIndex) import Data.Array ((!!), concat, cons, mapWithIndex, range)
import Data.Functor (map) import Data.Functor (map)
import Data.Int (toNumber) import Data.Int (toNumber)
import Data.Maybe
import Data.Number (cos, pi, sin) import Data.Number (cos, pi, sin)
import Data.Number.Format (toString) import Data.Number.Format (toString)
import Data.List (fold) import Data.List (fold)
@@ -66,25 +67,26 @@ derive newtype instance xmlFragmentMonoid :: Monoid XMLFragment
svgLine :: Line -> XMLFragment svgLine :: Line -> XMLFragment
svgLine { start: {x: x1, y: y1}, end: {x: x2, y: y2} } = 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" XMLFragment $ """<path style="fill:none;stroke:#000000;stroke-width:0.5;stroke-linecap:butt;stroke-linejoin:miter;stroke-dasharray:none;stroke-opacity:1"
""" <> (toString x1) <> "," <> (toString y1) <> " " <> (toString x2) <> "," <> (toString y2) <> "\"/>" """ <> "d=\"M " <> (toString x1) <> "," <> (toString y1) <> " " <> (toString x2) <> "," <> (toString y2) <> "\"/>"
-- TODO: position at center of text
svgText :: String -> Number -> Point -> Number -> XMLFragment svgText :: String -> Number -> Point -> Number -> XMLFragment
svgText text fontSize { x: x, y: y } angle = 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\" " 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>" <> "transform=\"translate(" <> (toString x) <> ", " <> (toString y) <> ") rotate(" <> (toString angle) <> ")\">" <> text <> "</text>"
-- TODO: Make axis tick size a parameter -- TODO: Make axis tick size a parameter
getTick :: Number -> Int -> Int -> Line getTick :: Number -> Int -> Int -> Line
getTick scale numTicks tickI = getTick scale numTicks tickI =
{start: {x: x, y: -(0.5 + scale / 5.0)}, end: {x: x, y: y}} {start: {x: x, y: -(0.5 + 5.0 / scale)}, end: {x: x, y: y}}
where where
x = 2.0 * (sin (pi / 3.0)) * (toNumber tickI) / (toNumber numTicks) - (sin (pi / 3.0)) x = 2.0 * (sin (pi / 3.0)) * (toNumber tickI) / (toNumber numTicks) - (sin (pi / 3.0))
y = if tickI < numTicks / 2 y = if tickI < numTicks / 2
then 1.0 + x * 1.5 / (sin (pi / 3.0)) then 1.0 + x * 1.5 / (sin (pi / 3.0))
else 1.0 + x * 1.5 / (sin (pi / 3.0)) else 1.0 - x * 1.5 / (sin (pi / 3.0))
getTicks :: Number -> Number -> Int -> Tuple3 (Array Line) (Array Line) (Array Line) getTicks :: Number -> Number -> Int -> Tuple3 (Array Line) (Array Line) (Array Line)
getTicks scale angle numTicks = --tuple3 [] [] [] getTicks scale angle numTicks =
tuple3 axis1Lines axis2Lines axis3Lines tuple3 axis1Lines axis2Lines axis3Lines
where where
foo = map (getTick scale numTicks) (range 0 numTicks) foo = map (getTick scale numTicks) (range 0 numTicks)
@@ -113,7 +115,7 @@ axesPoints :: Number -> Tuple3 Point Point Point
axesPoints angle = tuple3 axesPoints angle = tuple3
(rotate angle { x: 0.0, y: 1.0 }) (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.8 * pi / 3.0)), y: -0.5 }) (rotate angle { x: (sin (2.0 * pi / 3.0)), y: -0.5 })
axesPath :: Point -> Point -> Point -> XMLFragment 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" 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"
@@ -123,28 +125,30 @@ ternaryGraph :: Number -> Number -> Number -> Int -> String
ternaryGraph scale xOffset yOffset numTicks = ternaryGraphSvg fragments ternaryGraph scale xOffset yOffset numTicks = ternaryGraphSvg fragments
where where
axisTickLines = getTicks scale pi numTicks axisTickLines = getTicks scale pi numTicks
axis1TickLines = get1 axisTickLines axis1TickLines = map (transformLine scale xOffset yOffset) (get1 axisTickLines)
axis2TickLines = get2 axisTickLines axis2TickLines = map (transformLine scale xOffset yOffset) (get2 axisTickLines)
axis3TickLines = get3 axisTickLines axis3TickLines = map (transformLine scale xOffset yOffset) (get3 axisTickLines)
tickLines = concat [axis1TickLines, axis2TickLines, axis3TickLines] -- (cons axis1TickLines (cons axis2TickLines [axis3TickLines)) tickLines = concat [axis1TickLines, axis2TickLines, axis3TickLines]
transformMyLine = transformLine scale xOffset yOffset tickLinesSvg = fold $ map svgLine tickLines
tickLinesSvg = fold $ map (svgLine <<< transformMyLine) tickLines
axesPointsPi = axesPoints pi axesPointsPi = axesPoints pi
axesPathSvg = axesPath (get1 axesPointsPi) (get2 axesPointsPi) (get3 axesPointsPi) axisPoint1 = transform scale xOffset yOffset (get1 axesPointsPi)
axisPoint2 = transform scale xOffset yOffset (get2 axesPointsPi)
axisPoint3 = transform scale xOffset yOffset (get3 axesPointsPi)
axesPathSvg = axesPath axisPoint1 axisPoint2 axisPoint3
-- TODO: axis text size -- TODO: axis text size
axisTitlesSvg = [ axisTitlesSvg = [
svgText "axis 1" 1.0 (transform scale xOffset yOffset {x: 0.0, y: 1.2}) 0.0, svgText "axis 1" 12.0 (transform scale xOffset yOffset {x: 0.0, y: 1.2}) 0.0,
svgText "axis 2" 1.0 (transform scale xOffset yOffset {x: -(sin (2.0 * pi / 3.0)), y: -0.7}) (-60.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" 1.0 (transform scale xOffset yOffset {x: (sin (2.8 * 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
] ]
axisTickStarts = map (\line -> transform scale xOffset yOffset line.start) axisTickStarts = map (\line -> line.start)
-- TODO: tick label size -- TODO: tick label size
-- TODO: axis tick label rotation -- TODO: axis tick label rotation
-- TODO: axis tick start number -- TODO: axis tick start number
axisTickLabels = \rotation -> mapWithIndex (\i point -> svgText ("E" <> (toString (toNumber i))) 1.0 point 0.0) axisTickLabels = \rotation -> mapWithIndex (\i point -> svgText ("E" <> (toString (toNumber i))) 10.0 point 0.0)
axis1TickLabels = axisTickLabels 0 $ axisTickStarts axis1TickLines axis1TickLabels = axisTickLabels 0 $ axisTickStarts axis1TickLines
axis2TickLabels = axisTickLabels 0 $ axisTickStarts axis2TickLines axis2TickLabels = axisTickLabels 0 $ axisTickStarts axis2TickLines
@@ -161,4 +165,3 @@ ternaryGraph scale xOffset yOffset numTicks = ternaryGraphSvg fragments
main :: Effect Unit main :: Effect Unit
main = do main = do
log $ ternaryGraph 100.0 50.0 50.0 10 log $ ternaryGraph 100.0 50.0 50.0 10
log $ toString $ toNumber (5 / 3)