Add functions to calculate text dimension

spago.dhall

@@ -17,14 +17,17 @@ to generate this file without the comments in this block.
   , "effect"
   , "either"
   , "exceptions"
+  , "foldable-traversable"
   , "integers"
   , "lists"
   , "maybe"
   , "numbers"
+  , "ordered-collections"
   , "prelude"
   , "tuples"
   , "web-dom"
   , "web-dom-parser"
+  , "web-events"
   , "web-html"
   ]
 , packages = ./packages.dhall

src/Main.purs

@@ -2,14 +2,21 @@ module Main where
 
 import Prelude
 
-import Data.Maybe (Maybe(..))
 import Data.Either (Either(..))
+import Data.Int as Int
+import Data.Foldable as Foldable
+import Data.Map as Map
+import Data.Maybe (Maybe(..))
+import Data.Number.Format (toString)
+import Data.Tuple as Tup
 import Effect (Effect)
 import Effect.Console (log)
 import Effect.Class (liftEffect)
 import Effect.Exception (throw)
 import TernaryGraph (ternaryGraph)
 import Web.DOM.Document (contentType
+  , createElement
+  , Document
   , getElementsByClassName
   , importNode
   , toNode
@@ -18,15 +25,102 @@ import Web.DOM.Document (contentType
   , url
   )
 import Web.DOM.DOMParser (makeDOMParser, parseSVGFromString)
-import Web.DOM.Element (toNode) as Element
+import Web.DOM.Element as Element -- (Element, setAttribute, toEventTarget, toNode) as Element
-import Web.DOM.Node (appendChild, nodeName, setTextContent)
+import Web.DOM.Node (appendChild, Node, nodeName, setTextContent)
 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.HTMLInputElement as HTMLInput
 import Web.HTML.HTMLDocument (toDocument)
 import Web.HTML.Window (document)
 
--- Consider DOM.Simple.Types
+myGetElementById :: Document -> String -> Effect Element.Element
+myGetElementById doc id = do
+  elementMay <- getElementById id $ toNonElementParentNode doc
+  case elementMay of
+    Nothing -> throw $ "Unable to find element with ID '" <> id <> "'"
+    Just e -> pure e
+
+getNodeById :: Document -> String -> Effect Node
+getNodeById doc id = do
+  elementMay <- getElementById id $ toNonElementParentNode doc
+  case elementMay of
+    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
+  el :: Element.Element <- createElement "span" doc
+  let styleText = ( 
+  "font" <> style.typeface
+  <> ";font: " <> style.typeface
+  <> ";fontSize: " <> (toString style.sizePx) <> "px"
+  <> ";height: " <> "auto"
+  <> ";width: " <> "auto"
+  <> ";position: " <> "absolute"
+  <> ";whiteSpace: " <> "no-wrap"
+  )
+
+  Element.setAttribute "style" styleText el
+  setTextContent text (Element.toNode el)
+  width <- Element.clientWidth el
+  height <- Element.clientHeight el
+  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 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 doc strings = 
+  Foldable.foldM (converter doc) Map.empty strings
+
+update :: Event -> Effect Unit
+update e = do
+  w <- window
+  d <- document w
+  let document = toDocument d
+  domParser <- makeDOMParser
+
+  log "update"
+  inputElement <- myGetElementById document "ticks"
+  inputHTMLElement <- case HTMLInput.fromElement inputElement of
+    Nothing -> throw "'ticks' element is not an input tag"
+    Just e -> pure e
+  ticks <- (liftM1 Int.round) $ HTMLInput.valueAsNumber inputHTMLElement
+
+  svgContainer <- getNodeById document "svg-container"
+
+  let mySVG = ternaryGraph 100.0 50.0 50.0 ticks
+  svgDocMay <- parseSVGFromString mySVG domParser
+  svgDoc <- case svgDocMay of
+    Left error -> throw error
+    Right doc -> pure doc
+
+  elMay <- firstElementChild $ toParentNode svgDoc
+  svgNode <- case elMay of
+    Nothing -> throw "no child in svg doc"
+    Just el -> pure $ Element.toNode el
+
+  -- TODO: remove existing node?
+
+  newNode <- importNode svgNode true document
+  appendChild newNode svgContainer
 
 main :: Effect Unit
 main = do
@@ -35,11 +129,7 @@ main = do
   let dd = toDocument d
   domParser <- makeDOMParser
 
-  let containerID = "svg-container"
+  svgContainer <- getNodeById dd "svg-container"
-  maybeElement <- getElementById containerID $ toNonElementParentNode dd
-  node <- case maybeElement of
-    Nothing -> throw $ "Unable to find " <> containerID 
-    Just e -> pure $ Element.toNode e
 
   let mySVG = ternaryGraph 100.0 50.0 50.0 10
   svgDocMay <- parseSVGFromString mySVG domParser
@@ -53,4 +143,14 @@ main = do
     Just el -> pure $ Element.toNode el
   
   newNode <- importNode svgNode true dd
-  appendChild newNode node
+  appendChild newNode svgContainer
+
+  listener <- eventListener update
+
+  inputElement <- myGetElementById dd "ticks"
+  addEventListener (EventType "input") listener true (Element.toEventTarget inputElement)
+  log "20250727T183907"
+  --inputMay <- getElementById "ticks" $ toNonElementParentNode dd
+  --inputNode <- case inputMay of
+    --Nothing -> throw $ "Unable to find " <> containerID 
+    --Just e -> pure $ Element.toNode e