|
definition:
|
graphSvgRek :: Float -> Float -> Float -> NodeID -> DGGraph -> [ChoiceMapping]
-> [(NodeID, Point)] -> ([XmlExp], [(NodeID, Point)])
graphSvgRek levelHeight leafWidth leftBound currNID graph chMap drawnNodes
| elem currNID (fst (unzip drawnNodes)) = ([], drawnNodes)
| otherwise = ((dgNodeSvg currNode (posX,posY)) : children, drawnNodes')
where
(children, drawnNodes') = (childrenSvg currChldrn leftBound
(currChldrn !?? ((-1 +) <$> (lookup currNID chMap)))
((currNID, (posX,posY)) : drawnNodes))
currNode = findDGNode graph currNID
currChldrn = childrenDG currNode
currGraphWidth = fst (graphMetric modeWidth (map fst drawnNodes) graph currNID)
posY = ((toFloat (depthDG currNode)) + 0.5) * levelHeight
posX = leftBound + ((toFloat currGraphWidth) * leafWidth / 2)
childrenSvg :: [NodeID] -> Float -> Maybe NodeID -> [(NodeID, Point)] -> ([XmlExp], [(NodeID, Point)])
childrenSvg [] _ _ pMap = ([], pMap)
childrenSvg (c:cs) currLeft choiceChld pMap =
let --TODO: add graphWidth as argument to GraphSvgRek to reduce calculations of it
cWidth = fst (graphMetric modeWidth (map fst pMap) graph c)
(subG, newpMap) = graphSvgRek levelHeight leafWidth currLeft c graph chMap pMap
(nextChildrn, newpMap') = (childrenSvg cs (currLeft + (toFloat cWidth) * leafWidth) choiceChld newpMap)
currChld = findDGNode graph c
in ((connection currNode currChld currLeft levelHeight leafWidth ((Just c) == choiceChld) newpMap' cWidth)
: (subG ++ nextChildrn), newpMap')
--draw a connection between the current node and the current child
connection :: DGNode -> DGNode -> Float -> Float -> Float -> Bool -> [(NodeID, Point)] -> Int -> XmlExp
connection currNode c currLeft levelHeight leafWidth thick pMap cWidth =
let midX = (currLeft + (toFloat cWidth) * leafWidth / 2)
--TODO: move transX if child and parent are on the same x-coord!
transX = if chldLvl > startLvl
then midX
else midX + (absMax ((chldX - midX) * 0.4) 40)
startLvl = depthDG currNode
chldLvl = depthDG c
transTo = if chldLvl > startLvl then chldLvl-1 else chldLvl
sWidth = if thick then 3 else 1
chldShort = if (chldLvl /= startLvl + 1) then 0 else (snd nodeSize)/2
(posX, posY) = fromMaybe (error "Error in connection, couldnt find position")
(lookup (nodeIDDG currNode) pMap)
(chldX, chldY) = fromMaybe (error "Error in connection, couldnt find position")
(lookup (nodeIDDG c) pMap)
in XElem "g" [("stroke-width", show sWidth)]
-- curve to the regular position of child node
([ (bezierSvg
(posX, posY + ((snd nodeSize) / 2))
(midX, ((toFloat startLvl) + 1.5) * levelHeight - chldShort)
sWidth) ] ++
-- bow for connection to node on higher level
( condList (chldLvl <= startLvl)
[ (bezBowSvg
(midX, ((toFloat startLvl) + 1.5) * levelHeight)
(transX, ((toFloat startLvl) + 1.5) * levelHeight)
1) ] ) ++
-- straight line over n levels
( condList (chldLvl /= startLvl + 1)
[ (nLevelConnection transX (startLvl+1) transTo sWidth) ] ) ++
-- curve to actual position of node on lower level
( condList (chldLvl > startLvl + 1)
[ (bezierSvg
(transX, ((toFloat chldLvl) - 0.5) * levelHeight)
(chldX, chldY - (snd nodeSize)/2)
sWidth) ] ) ++
-- bow to actual position of node on higher level
( condList (chldLvl <= startLvl)
[ (bezBowSvg
(transX, ((toFloat chldLvl) + 0.5) * levelHeight)
(chldX, ((toFloat chldLvl) + 0.5) * levelHeight - (snd nodeSize) / 2)
(-1) ) ] ) )
nLevelConnection :: Float -> Int -> Int -> Int -> XmlExp
nLevelConnection posX startLevel endLevel sWidth
| startLevel == endLevel = XText ""
| otherwise = XElem "line"
[ ( "x1", show posX ),
( "y1", show (((toFloat startLevel) + 0.5) * levelHeight) ),
( "x2", show posX ),
( "y2", show (((toFloat endLevel) + 0.5) * levelHeight) ),
( "stroke", "black" ),
( "stroke-width", (show sWidth) ) ]
[]
|
|
iotype:
|
{(_,_,_,_,_,_,_) |-> {(,)}}
|
|
signature:
|
Prelude.Float -> Prelude.Float -> Prelude.Float -> Prelude.Int -> [DGNode]
-> [(Prelude.Int, Prelude.Int)]
-> [(Prelude.Int, (Prelude.Float, Prelude.Float))]
-> ([XML.XmlExp], [(Prelude.Int, (Prelude.Float, Prelude.Float))])
|