Start implementing text style/dimensions

This commit is contained in:
Nathan McRae
2025-08-09 23:06:06 -07:00
parent 4c23fbfb03
commit 9cd101ee4f

View File

@@ -2,6 +2,7 @@ module Main where
import Prelude import Prelude
import Data.Array as Array
import Data.Either (Either(..)) import Data.Either (Either(..))
import Data.Int as Int import Data.Int as Int
import Data.Foldable as Foldable import Data.Foldable as Foldable
@@ -13,7 +14,7 @@ import Effect (Effect)
import Effect.Console (log) import Effect.Console (log)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Effect.Exception (throw) import Effect.Exception (throw)
import TernaryGraph (ternaryGraph) import TernaryGraph (ternaryGraph, tickLabelStrings)
import Web.DOM.Document (contentType import Web.DOM.Document (contentType
, createElement , createElement
, Document , Document
@@ -106,7 +107,29 @@ update e = do
svgContainer <- getNodeById document "svg-container" svgContainer <- getNodeById document "svg-container"
let mySVG = ternaryGraph 100.0 50.0 50.0 ticks let tickText = tickLabelStrings ticks 0 0 10
--let allTicks = Foldable.foldr (\a b -> a <> ", " <> b) "" tickText
--log allTicks
let tickStyle = {
typeface: "Liberation Mono",
sizePx: 12.0
}
let axisTitleTextStyle = {
typeface: "Liberation Sans",
sizePx: 16.0
}
let tickTextStyles = Foldable.foldr (\text textStyleArray -> Array.cons (Tup.Tuple text tickStyle) textStyleArray) [] tickText
let textStyles = tickTextStyles <> [
(Tup.Tuple "axis 1" axisTitleTextStyle),
(Tup.Tuple "axis 2" axisTitleTextStyle),
(Tup.Tuple "axis 3" axisTitleTextStyle)
]
textDimensions <- getAllTextDimensions document textStyles
let mySVG = ternaryGraph 100.0 50.0 50.0 ticks textDimensions
svgDocMay <- parseSVGFromString mySVG domParser svgDocMay <- parseSVGFromString mySVG domParser
svgDoc <- case svgDocMay of svgDoc <- case svgDocMay of
Left error -> throw error Left error -> throw error