Get text centering working

Required significant architectural changes

src/Main.purs

@@ -9,12 +9,13 @@ import Data.Foldable as Foldable
 import Data.Map as Map
 import Data.Maybe (Maybe(..))
 import Data.Number.Format (toString)
+import Data.Set as Set
 import Data.Tuple as Tup
 import Effect (Effect)
 import Effect.Console (log)
 import Effect.Class (liftEffect)
 import Effect.Exception (throw)
-import TernaryGraph (ternaryGraph, tickLabelStrings)
+import TernaryGraph (Dimension, ternaryGraph, TextStyle, tickLabelStrings)
 import Web.DOM.Document (contentType
   , createElement
   , Document
@@ -27,14 +28,16 @@ import Web.DOM.Document (contentType
   )
 import Web.DOM.DOMParser (makeDOMParser, parseSVGFromString)
 import Web.DOM.Element as Element -- (Element, setAttribute, toEventTarget, toNode) as Element
-import Web.DOM.Node (appendChild, Node, nodeName, setTextContent)
+import Web.DOM.Node (appendChild, childNodes, Node, nodeName, removeChild, setTextContent)
+import Web.DOM.NodeList as NodeList
 import Web.DOM.NonElementParentNode (getElementById)
 import Web.DOM.ParentNode (firstElementChild)
 import Web.Event.Event (Event, EventType(..))
 import Web.Event.EventTarget (addEventListener, eventListener)
 import Web.HTML (window)
+import Web.HTML.HTMLElement as HTMLElement
 import Web.HTML.HTMLInputElement as HTMLInput
-import Web.HTML.HTMLDocument (toDocument)
+import Web.HTML.HTMLDocument as HTMLDoc
 import Web.HTML.Window (document)
 
 myGetElementById :: Document -> String -> Effect Element.Element
@@ -51,19 +54,18 @@ getNodeById doc id = do
     Nothing -> throw $ "Unable to find element with ID '" <> id <> "'"
     Just e -> pure $ Element.toNode e
 
-type Dimension =
-  { widthPx :: Number
-  , heightPx :: Number
-  }
-
-type TextStyle =
-  {  typeface :: String
-  ,  sizePx :: Number
-  }
-
-getTextDimensions :: Document -> TextStyle -> String -> Effect Dimension
-getTextDimensions doc style text = do
+getTextDimensions :: HTMLDoc.HTMLDocument -> TextStyle -> String -> Effect Dimension
+getTextDimensions htmlDoc style text = do
+  let doc = HTMLDoc.toDocument htmlDoc
   el :: Element.Element <- createElement "span" doc
+
+  bodyMay <- HTMLDoc.body htmlDoc
+  bodyNode <- case bodyMay of 
+    Nothing -> throw "Could not find body of HTML document"
+    Just e -> pure $ Element.toNode (HTMLElement.toElement e)
+
+  appendChild (Element.toNode el) bodyNode
+
   let styleText = ( 
   "font" <> style.typeface
   <> ";font: " <> style.typeface
@@ -78,16 +80,19 @@ getTextDimensions doc style text = do
   setTextContent text (Element.toNode el)
   width <- Element.clientWidth el
   height <- Element.clientHeight el
+
+  removeChild (Element.toNode el) bodyNode
+
   pure { widthPx: width, heightPx: height }
 
-converter :: Document -> (Map.Map (Tup.Tuple String TextStyle) Dimension) -> (Tup.Tuple String TextStyle) -> Effect (Map.Map (Tup.Tuple String TextStyle) Dimension)
+converter :: HTMLDoc.HTMLDocument -> (Map.Map (Tup.Tuple String TextStyle) Dimension) -> (Tup.Tuple String TextStyle) -> Effect (Map.Map (Tup.Tuple String TextStyle) Dimension)
 converter doc map textTuple = do
   let text = Tup.fst textTuple
   let style = Tup.snd textTuple
   dimension <- getTextDimensions doc style text
   pure $ Map.insert textTuple dimension map
 
-getAllTextDimensions :: forall f. Foldable.Foldable f => Document -> f (Tup.Tuple String TextStyle) -> Effect (Map.Map (Tup.Tuple String TextStyle) Dimension)
+getAllTextDimensions :: forall f. Foldable.Foldable f => HTMLDoc.HTMLDocument -> f (Tup.Tuple String TextStyle) -> Effect (Map.Map (Tup.Tuple String TextStyle) Dimension)
 getAllTextDimensions doc strings = 
   Foldable.foldM (converter doc) Map.empty strings
 
@@ -95,7 +100,7 @@ update :: Event -> Effect Unit
 update e = do
   w <- window
   d <- document w
-  let document = toDocument d
+  let document = HTMLDoc.toDocument d
   domParser <- makeDOMParser
 
   log "update"
@@ -107,28 +112,34 @@ update e = do
 
   svgContainer <- getNodeById document "svg-container"
 
-  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 graphDef = { axis1Label: "axis 1"
+  , axis2Label: "axis 2"
+  , axis3Label: "axis 3"
+  , axis1Start: 0
+  , axis2Start: 1
+  , axis3Start: 20
+  , numTicks: ticks
+  , tickTextStyle: { sizePx: 12.0
+    , typeface: "Liberation Sans"
+    }
+  , axisTitleTextStyle: { sizePx: 16.0
+    , typeface: "Liberation Mono"
+    }
   }
 
-  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)
+  let tickText = tickLabelStrings graphDef
+
+  let tickTextStyles = Foldable.foldr (\text textStyleArray -> Array.cons (Tup.Tuple text graphDef.tickTextStyle) textStyleArray) [] tickText 
+  let textStyles = tickTextStyles <> [ (Tup.Tuple graphDef.axis1Label graphDef.axisTitleTextStyle)
+    , (Tup.Tuple graphDef.axis2Label graphDef.axisTitleTextStyle)
+    , (Tup.Tuple graphDef.axis3Label graphDef.axisTitleTextStyle)
   ]
-  textDimensions <- getAllTextDimensions document textStyles
+  textDimensions <- getAllTextDimensions d textStyles
 
-  let mySVG = ternaryGraph 100.0 50.0 50.0 ticks textDimensions
+  let mySVGErr = ternaryGraph 100.0 50.0 50.0 graphDef textDimensions
+  mySVG <- case mySVGErr of
+    Left error -> throw error
+    Right svg -> pure svg
   
   svgDocMay <- parseSVGFromString mySVG domParser
   svgDoc <- case svgDocMay of
@@ -140,7 +151,9 @@ update e = do
     Nothing -> throw "no child in svg doc"
     Just el -> pure $ Element.toNode el
 
-  -- TODO: remove existing node?
+  containerKids <- (childNodes svgContainer) >>= NodeList.toArray
+  Foldable.for_ containerKids \kid -> do
+    removeChild kid svgContainer
 
   newNode <- importNode svgNode true document
   appendChild newNode svgContainer
@@ -149,12 +162,46 @@ main :: Effect Unit
 main = do
   w <- window
   d <- document w
-  let dd = toDocument d
+  let dd = HTMLDoc.toDocument d
   domParser <- makeDOMParser
 
   svgContainer <- getNodeById dd "svg-container"
 
-  let mySVG = ternaryGraph 100.0 50.0 50.0 10
+  let graphDef = { axis1Label: "axis 1"
+  , axis2Label: "axis 2"
+  , axis3Label: "axis 3"
+  , axis1Start: 0
+  , axis2Start: 1
+  , axis3Start: 20
+  , numTicks: 10
+  , tickTextStyle: { sizePx: 12.0
+    , typeface: "Liberation Sans"
+    }
+  , axisTitleTextStyle: { sizePx: 16.0
+    , typeface: "Liberation Mono"
+    }
+  }
+
+  let tickText = tickLabelStrings graphDef
+
+  log $ Array.intercalate ",\n" (Set.toUnfoldable tickText)
+
+  let tickTextStyles = Foldable.foldr (\text textStyleArray -> Array.cons (Tup.Tuple text graphDef.tickTextStyle) textStyleArray) [] tickText 
+  let textStyles = tickTextStyles <> [ (Tup.Tuple graphDef.axis1Label graphDef.axisTitleTextStyle)
+    , (Tup.Tuple graphDef.axis2Label graphDef.axisTitleTextStyle)
+    , (Tup.Tuple graphDef.axis3Label graphDef.axisTitleTextStyle)
+  ]
+  textDimensions <- getAllTextDimensions d textStyles
+
+  log $ Foldable.foldr (\dim str -> str <> "\n" <> (toString dim.widthPx) <> ", " <> (toString dim.heightPx)) "" $ Map.values textDimensions
+
+  let textDimensions2 = Map.mapMaybe (\dim -> Just {widthPx: 0.0, heightPx: 0.0}) textDimensions
+
+  let mySVGErr = ternaryGraph 100.0 50.0 50.0 graphDef textDimensions2
+  mySVG <- case mySVGErr of
+    Left error -> throw error
+    Right svg -> pure svg
+  
   svgDocMay <- parseSVGFromString mySVG domParser
   svgDoc <- case svgDocMay of
     Left error -> throw error