diff --git a/src/Main.purs b/src/Main.purs index 13dd27c..c65d70f 100644 --- a/src/Main.purs +++ b/src/Main.purs @@ -1,166 +1,9 @@ module Main where -import Prelude ( discard, class Monoid, class Semigroup, Unit, ($), (<<<), (<>), (*), (+), (-), (/)) - -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) -import Data.Ord ((<)) -import Data.Ring (negate) -import Data.Tuple.Nested (Tuple3, tuple3, get1, get2, get3) import Effect (Effect) import Effect.Console (log) - -type Point = - { x :: Number - , y :: Number - } - -type Line = - { start :: Point - , end :: Point - } - --- TODO: How to do more normal math expressions? -rotate :: Number -> Point -> Point -rotate angle { x: x, y: y} = { - x: x * (cos angle) - y * (sin angle), - y: x * (sin angle) + y * (cos angle) -} - -transform :: Number -> Number -> Number -> Point -> Point -transform scale xOffset yOffset { x: x, y: y} = { - x: scale * x + xOffset, - y: scale * y + yOffset -} - -rotateLine :: Number -> Line -> Line -rotateLine angle { start: p1, end: p2} = { - start: rotate angle p1, - end: rotate angle p2 -} - -transformLine :: Number -> Number -> Number -> Line -> Line -transformLine scale xOffset yOffset { start: start, end: end } = { -start : t start, -end : t end -} - where t = transform scale xOffset yOffset - --- How to handle the different coordinate systems? --- These things should be generated in the basic coordinate system --- * ticks via generateTicks --- * axis labels --- * axis lines --- There should be a transform function that these should be passed through directly after generation - -newtype XMLFragment = XMLFragment String - -derive newtype instance xmlFragmentSemiGroup :: Semigroup XMLFragment -derive newtype instance xmlFragmentMonoid :: Monoid XMLFragment - --- TODO: Add style configuration -svgLine :: Line -> XMLFragment -svgLine { start: {x: x1, y: y1}, end: {x: x2, y: y2} } = - XMLFragment $ """ "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 $ " (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 <> "" - --- TODO: Make axis tick size a parameter -getTick :: Number -> Int -> Int -> Line -getTick scale numTicks tickI = - {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)) - -getTicks :: Number -> Number -> Int -> Tuple3 (Array Line) (Array Line) (Array Line) -getTicks scale angle numTicks = - tuple3 axis1Lines axis2Lines axis3Lines - where - foo = map (getTick scale numTicks) (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 - --- There's probably a better way to do this -unfragment :: XMLFragment -> String -unfragment (XMLFragment frag) = frag - -ternaryGraphSvg :: Array XMLFragment -> String -ternaryGraphSvg fragments = """ - -""" <> unfragment (fold fragments) <> "" - -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 }) - -axesPath :: Point -> Point -> Point -> XMLFragment -axesPath p1 p2 p3 = XMLFragment $ """ "d=\"M " <> (toString p1.x) <> "," <> (toString p1.y) <> " " <> (toString p2.x) <> "," <> (toString p2.y) <> " " <> (toString p3.x) <> "," <> (toString p3.y) <> " Z\"/>" - -ternaryGraph :: Number -> Number -> Number -> Int -> String -ternaryGraph scale xOffset yOffset numTicks = ternaryGraphSvg fragments - where - axisTickLines = getTicks scale pi 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] - tickLinesSvg = fold $ map svgLine tickLines - - axesPointsPi = axesPoints pi - 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" 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 -> 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))) 10.0 point 0.0) - - axis1TickLabels = axisTickLabels 0 $ axisTickStarts axis1TickLines - axis2TickLabels = axisTickLabels 0 $ axisTickStarts axis2TickLines - axis3TickLabels = axisTickLabels 0 $ axisTickStarts axis3TickLines - - tickLabelsSvg = concat [ - axis1TickLabels, - axis2TickLabels, - axis3TickLabels - ] - - fragments = concat [[tickLinesSvg, axesPathSvg], axisTitlesSvg, tickLabelsSvg] +import TernaryGraph (ternaryGraph) +import Prelude (($), Unit) main :: Effect Unit main = do diff --git a/src/TernaryGraph.purs b/src/TernaryGraph.purs new file mode 100644 index 0000000..f04e331 --- /dev/null +++ b/src/TernaryGraph.purs @@ -0,0 +1,161 @@ +module TernaryGraph where + +import Prelude ( discard, class Monoid, class Semigroup, Unit, ($), (<<<), (<>), (*), (+), (-), (/)) + +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) +import Data.Ord ((<)) +import Data.Ring (negate) +import Data.Tuple.Nested (Tuple3, tuple3, get1, get2, get3) + +type Point = + { x :: Number + , y :: Number + } + +type Line = + { start :: Point + , end :: Point + } + +-- TODO: How to do more normal math expressions? +rotate :: Number -> Point -> Point +rotate angle { x: x, y: y} = { + x: x * (cos angle) - y * (sin angle), + y: x * (sin angle) + y * (cos angle) +} + +transform :: Number -> Number -> Number -> Point -> Point +transform scale xOffset yOffset { x: x, y: y} = { + x: scale * x + xOffset, + y: scale * y + yOffset +} + +rotateLine :: Number -> Line -> Line +rotateLine angle { start: p1, end: p2} = { + start: rotate angle p1, + end: rotate angle p2 +} + +transformLine :: Number -> Number -> Number -> Line -> Line +transformLine scale xOffset yOffset { start: start, end: end } = { +start : t start, +end : t end +} + where t = transform scale xOffset yOffset + +-- How to handle the different coordinate systems? +-- These things should be generated in the basic coordinate system +-- * ticks via generateTicks +-- * axis labels +-- * axis lines +-- There should be a transform function that these should be passed through directly after generation + +newtype XMLFragment = XMLFragment String + +derive newtype instance xmlFragmentSemiGroup :: Semigroup XMLFragment +derive newtype instance xmlFragmentMonoid :: Monoid XMLFragment + +-- TODO: Add style configuration +svgLine :: Line -> XMLFragment +svgLine { start: {x: x1, y: y1}, end: {x: x2, y: y2} } = + XMLFragment $ """ "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 $ " (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 <> "" + +-- TODO: Make axis tick size a parameter +getTick :: Number -> Int -> Int -> Line +getTick scale numTicks tickI = + {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)) + +getTicks :: Number -> Number -> Int -> Tuple3 (Array Line) (Array Line) (Array Line) +getTicks scale angle numTicks = + tuple3 axis1Lines axis2Lines axis3Lines + where + foo = map (getTick scale numTicks) (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 + +-- There's probably a better way to do this +unfragment :: XMLFragment -> String +unfragment (XMLFragment frag) = frag + +ternaryGraphSvg :: Array XMLFragment -> String +ternaryGraphSvg fragments = """ + +""" <> unfragment (fold fragments) <> "" + +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 }) + +axesPath :: Point -> Point -> Point -> XMLFragment +axesPath p1 p2 p3 = XMLFragment $ """ "d=\"M " <> (toString p1.x) <> "," <> (toString p1.y) <> " " <> (toString p2.x) <> "," <> (toString p2.y) <> " " <> (toString p3.x) <> "," <> (toString p3.y) <> " Z\"/>" + +ternaryGraph :: Number -> Number -> Number -> Int -> String +ternaryGraph scale xOffset yOffset numTicks = ternaryGraphSvg fragments + where + axisTickLines = getTicks scale pi 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] + tickLinesSvg = fold $ map svgLine tickLines + + axesPointsPi = axesPoints pi + 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" 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 -> 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))) 10.0 point 0.0) + + axis1TickLabels = axisTickLabels 0 $ axisTickStarts axis1TickLines + axis2TickLabels = axisTickLabels 0 $ axisTickStarts axis2TickLines + axis3TickLabels = axisTickLabels 0 $ axisTickStarts axis3TickLines + + tickLabelsSvg = concat [ + axis1TickLabels, + axis2TickLabels, + axis3TickLabels + ] + + fragments = concat [[tickLinesSvg, axesPathSvg], axisTitlesSvg, tickLabelsSvg] \ No newline at end of file