Implement visualizing the quad tree in a separate window
This window creation still sucks a bit, we should realize it without actually showing it.
This commit is contained in:
@@ -8,8 +8,10 @@ import Algorithms.RangeSearch.QuadTree
|
||||
import Algorithms.PolygonIntersection.Core
|
||||
import Data.Maybe
|
||||
import Data.Monoid
|
||||
import Data.Tree
|
||||
import Diagrams.Backend.Cairo
|
||||
import Diagrams.Prelude hiding ((<>))
|
||||
import Diagrams.TwoD.Layout.Tree
|
||||
import Graphics.Diagram.Types
|
||||
import Graphics.Gloss.Data.Extent
|
||||
import Parser.PathParser
|
||||
@@ -231,6 +233,23 @@ gifQuadPath = GifDiag f
|
||||
vtf = filterValidPT p vt
|
||||
|
||||
|
||||
-- |A diagram that shows the full Quad Tree with nodes.
|
||||
treePretty :: Diag
|
||||
treePretty = Diag f
|
||||
where
|
||||
f p (Object []) = mempty
|
||||
f p (Object vt) = prettyRoseTree (quadTreeToRoseTree (qt, []))
|
||||
where
|
||||
qt = quadTree (filterValidPT p vt) (dX p, dY p)
|
||||
prettyRoseTree :: Tree String -> Diagram Cairo R2
|
||||
prettyRoseTree t =
|
||||
renderTree (\n -> (text n # fontSizeL 5.0)
|
||||
<> rect 50.0 20.0 # fc white)
|
||||
(~~)
|
||||
(symmLayout' (with & slHSep .~ 60 & slVSep .~ 40) t)
|
||||
# scale 2 # alignT # bg white
|
||||
|
||||
|
||||
-- |Creates a Diagram that shows an XAxis which is bound
|
||||
-- by the dimensions given in xD from DiagProp.
|
||||
xAxis :: Diag
|
||||
|
||||
Reference in New Issue
Block a user