Get basic output working

This commit is contained in:
Nathan McRae
2025-07-20 16:48:39 -07:00
parent 445a976f2e
commit 9c24c884a6

View File

@@ -2,9 +2,10 @@ module Main where
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.Int (toNumber)
import Data.Maybe
import Data.Number (cos, pi, sin)
import Data.Number.Format (toString)
import Data.List (fold)
@@ -66,25 +67,26 @@ derive newtype instance xmlFragmentMonoid :: Monoid XMLFragment
svgLine :: Line -> XMLFragment
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"
""" <> (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 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>"
-- TODO: Make axis tick size a parameter
getTick :: Number -> Int -> Int -> Line
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
x = 2.0 * (sin (pi / 3.0)) * (toNumber tickI) / (toNumber numTicks) - (sin (pi / 3.0))
y = if tickI < numTicks / 2
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 scale angle numTicks = --tuple3 [] [] []
getTicks scale angle numTicks =
tuple3 axis1Lines axis2Lines axis3Lines
where
foo = map (getTick scale numTicks) (range 0 numTicks)
@@ -113,7 +115,7 @@ 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.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 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
where
axisTickLines = getTicks scale pi numTicks
axis1TickLines = get1 axisTickLines
axis2TickLines = get2 axisTickLines
axis3TickLines = get3 axisTickLines
tickLines = concat [axis1TickLines, axis2TickLines, axis3TickLines] -- (cons axis1TickLines (cons axis2TickLines [axis3TickLines))
transformMyLine = transformLine scale xOffset yOffset
tickLinesSvg = fold $ map (svgLine <<< transformMyLine) tickLines
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]
tickLinesSvg = fold $ map svgLine tickLines
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
axisTitlesSvg = [
svgText "axis 1" 1.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 3" 1.0 (transform scale xOffset yOffset {x: (sin (2.8 * pi / 3.0)), y: -0.7}) 60.0
svgText "axis 1" 12.0 (transform scale xOffset yOffset {x: 0.0, y: 1.2}) 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
]
axisTickStarts = map (\line -> transform scale xOffset yOffset line.start)
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 (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
axis2TickLabels = axisTickLabels 0 $ axisTickStarts axis2TickLines
@@ -161,4 +165,3 @@ ternaryGraph scale xOffset yOffset numTicks = ternaryGraphSvg fragments
main :: Effect Unit
main = do
log $ ternaryGraph 100.0 50.0 50.0 10
log $ toString $ toNumber (5 / 3)