justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Continue work on using links for placement positions

Browse Source
This commit is contained in:
justin
2021-11-04 14:40:53 +00:00
parent a9b802b883
commit 6933c4d3b3
3 changed files with 39 additions and 21 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Layout.hs
+4 -5
View File
@@ -64,13 +64,12 @@ assignPlacementSpots rm = plmnts ++ plmnts'
(lnkplmnts, plmnts) = partition islnk (_rmPS rm)
islnk Placement{_placementSpot=PSLnk{}} = True
islnk _ = False
(_,plmnts') = mapAccumR f (_rmLinks rm) lnkplmnts
(la,lb) = head $ _rmUsedLinks rm
lnkTo = (la,lb+1.5*pi)
(_,plmnts') = mapAccumR f (map (invShiftLinkBy lnkTo) $ _rmLinks rm) lnkplmnts
(la,lb) = _rmShift rm
lnkTo = (la,lb)
f lnks plmnt =
let (x:xs,ys) = partition (_psLinkTest $ _placementSpot plmnt) lnks
thepair = bimap (invShiftPointBy lnkTo) (\r -> r - snd lnkTo)
$ _psLinkShift (_placementSpot plmnt) x
thepair = _psLinkShift (_placementSpot plmnt) x
in (xs++ys, updatePS (updatePSLnkUsing thepair) plmnt)
updatePSLnkUsing :: (Point2,Float) -> PlacementSpot -> PlacementSpot