Remove redundant code from main

This commit is contained in:
Nathan McRae
2025-08-20 22:19:14 -07:00
parent 2a4b5702af
commit 5b4cf834a0

View File

@@ -105,14 +105,16 @@ getAllTextDimensions document svgContainer strings = do
pure myMap
update :: Event -> Effect Unit
update e = do
updateEvent :: Event -> Effect Unit
updateEvent _ = do update
update :: Effect Unit
update = do
w <- window
d <- document w
let document = HTMLDoc.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"
@@ -183,66 +185,13 @@ main = do
w <- window
d <- document w
let dd = HTMLDoc.toDocument d
domParser <- makeDOMParser
svgContainer <- getNodeById dd "svg-container"
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"
}
, tickSize: TernaryGraph.Pixels 10.0
, 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 dd svgContainer textStyles
log $ Foldable.foldr (\dim str -> str <> "\n" <> (toString dim.widthPx) <> ", " <> (toString dim.heightPx)) "" $ Map.values textDimensions
let mySVGErr = ternaryGraph 100.0 50.0 70.0 graphDef textDimensions
mySVG <- case mySVGErr of
Left error -> throw error
Right svg -> pure svg
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
newNode <- importNode svgNode true dd
appendChild newNode svgContainer
listener <- eventListener update
listener <- eventListener updateEvent
inputElement <- myGetElementById dd "ticks"
addEventListener (EventType "input") listener true (Element.toEventTarget inputElement)
tickSizeEl <- myGetElementById dd "tick-size"
addEventListener (EventType "input") listener true (Element.toEventTarget tickSizeEl)
--inputMay <- getElementById "ticks" $ toNonElementParentNode dd
--inputNode <- case inputMay of
--Nothing -> throw $ "Unable to find " <> containerID
--Just e -> pure $ Element.toNode e
update