hasufell/cga
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Implement visualizing the quad tree in a separate window

Browse Source 
This window creation still sucks a bit, we should realize it
without actually showing it.
This commit is contained in:
hasufell 2014-11-15 03:58:38 +01:00
parent 5fa5afc073
commit f3cabab280
No known key found for this signature in database
GPG Key ID: 220CD1C5BDEED020
6 changed files with 104 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
Algorithms/RangeSearch/QuadTree.hs
View File

@ -8,6 +8,7 @@ module Algorithms.RangeSearch.QuadTree
lookupByPath',
getSquareByZipper,
rootNode,
quadTreeToRoseTree,
Orient(North,East,West,South),
Quad(NW,NE,SW,SE),
QuadTree,
@ -19,6 +20,7 @@ import Algebra.Vector
import Data.Foldable (foldlM)
import Data.List (partition)
import Data.Maybe (fromJust)
import Data.Tree
import Diagrams.TwoD.Types
@ -200,3 +202,19 @@ lookupByNeighbors :: [Orient] -> Zipper a -> Maybe (Zipper a)
lookupByNeighbors = flip (foldlM (flip findNeighbor))
quadTreeToRoseTree :: Zipper PT -> Tree String
quadTreeToRoseTree z = case z of
(TNil, _) -> Node printOrigin []
(TLeaf a, _) -> Node (printOrigin ++ "\n" ++ (show . unp2 $ a)) []
_ -> Node printOrigin
[quadTreeToRoseTree (fromJust . goNW $ z)
, quadTreeToRoseTree (fromJust . goNE $ z)
, quadTreeToRoseTree (fromJust . goSW $ z)
, quadTreeToRoseTree (fromJust . goSE $ z)]
where
printOrigin
| isNWchild z = "NW"
| isNEchild z = "NE"
| isSWchild z = "SW"
| isSEchild z = "SE"
| otherwise = "root"

4
CG2.cabal
View File

@ -60,7 +60,7 @@ executable Gtk
-- other-extensions:
-- Other library packages from which modules are imported.
build-depends: base >=4.6 && <4.8, diagrams-lib >=1.2 && <1.3, diagrams-cairo >=1.2 && <1.3, transformers >=0.4 && <0.5, glade >=0.12 && <0.13, gtk >=0.12 && <0.13, directory >=1.2 && <1.3, dequeue >= 0.1.5, multiset-comb >= 0.2.1, gloss >= 1.2.0.1, safe >= 0.3.8
build-depends: base >=4.6 && <4.8, diagrams-lib >=1.2 && <1.3, diagrams-cairo >=1.2 && <1.3, transformers >=0.4 && <0.5, glade >=0.12 && <0.13, gtk >=0.12 && <0.13, directory >=1.2 && <1.3, dequeue >= 0.1.5, multiset-comb >= 0.2.1, gloss >= 1.2.0.1, safe >= 0.3.8, containers >= 0.5.0.0, diagrams-contrib >= 1.1.2.1
-- Directories containing source files.
-- hs-source-dirs:
@ -80,7 +80,7 @@ executable Gif
-- other-extensions:
-- Other library packages from which modules are imported.
build-depends: base >=4.6 && <4.8, diagrams-lib >=1.2 && <1.3, diagrams-cairo >=1.2 && <1.3, transformers >=0.4 && <0.5, JuicyPixels >= 3.1.7.1, dequeue >= 0.1.5, multiset-comb >= 0.2.1, gloss >= 1.2.0.1, safe >= 0.3.8
build-depends: base >=4.6 && <4.8, diagrams-lib >=1.2 && <1.3, diagrams-cairo >=1.2 && <1.3, transformers >=0.4 && <0.5, JuicyPixels >= 3.1.7.1, dequeue >= 0.1.5, multiset-comb >= 0.2.1, gloss >= 1.2.0.1, safe >= 0.3.8, containers >= 0.5.0.0, diagrams-contrib >= 1.1.2.1
-- Directories containing source files.
-- hs-source-dirs:

64
GUI/Gtk.hs
View File

@ -25,6 +25,8 @@ import Text.Read
data MyGUI = MkMyGUI {
-- |main Window
win :: Window,
-- |Tree Window
winT :: Window,
-- |delete Button
dB :: Button,
-- |save Button
@ -35,6 +37,8 @@ data MyGUI = MkMyGUI {
fB :: FileChooserButton,
-- |drawing area
da :: DrawingArea,
-- |drawing area for the tree
daT :: DrawingArea,
-- |scaler for point thickness
hs :: HScale,
-- |entry widget for lower x bound
@ -54,7 +58,7 @@ data MyGUI = MkMyGUI {
-- |coord check button
cC :: CheckButton,
-- |Path entry widget for the quad tree.
pE :: Entry,
pE :: Entry,
-- |Horizontal box containing the path entry widget.
vbox7 :: Box
}
@ -73,12 +77,14 @@ makeMyGladeGUI = do
MkMyGUI
<$> xmlGetWidget xml castToWindow "window1"
<*> xmlGetWidget xml castToWindow "window2"
<*> xmlGetWidget xml castToButton "drawButton"
<*> xmlGetWidget xml castToButton "saveButton"
<*> xmlGetWidget xml castToButton "quitButton"
<*> xmlGetWidget xml castToFileChooserButton
"filechooserButton"
<*> xmlGetWidget xml castToDrawingArea "drawingarea"
<*> xmlGetWidget xml castToDrawingArea "treedrawingarea"
<*> xmlGetWidget xml castToHScale "hscale"
<*> xmlGetWidget xml castToEntry "xlD"
<*> xmlGetWidget xml castToEntry "xuD"
@ -124,8 +130,10 @@ makeGUI startFile = do
-- have to redraw for window overlapping and resizing on expose
_ <- onExpose (da mygui) (\_ -> drawDiag mygui >>=
(\_ -> return True))
_ <- onExpose (daT mygui) (\_ -> drawDiag mygui >>=
(\_ -> return True))
_ <- on (cB mygui) changed (drawDiag mygui)
_ <- on (cB mygui) changed (showPathWidget mygui)
_ <- on (cB mygui) changed (onPathWidgetChange mygui)
_ <- on (gC mygui) toggled (drawDiag mygui)
_ <- on (cC mygui) toggled (drawDiag mygui)
@ -134,6 +142,10 @@ makeGUI startFile = do
[Control] <- eventModifier
"q" <- eventKeyName
liftIO mainQuit
_ <- winT mygui `on` keyPressEvent $ tryEvent $ do
[Control] <- eventModifier
"q" <- eventKeyName
liftIO (widgetHide $ winT mygui)
_ <- win mygui `on` keyPressEvent $ tryEvent $ do
[Control] <- eventModifier
"s" <- eventKeyName
@ -149,7 +161,9 @@ makeGUI startFile = do
-- draw widgets and start main loop
widgetShowAll (win mygui)
widgetShowAll (winT mygui)
widgetHide (vbox7 mygui)
widgetHide (winT mygui)
mainGUI
@ -166,12 +180,16 @@ showErrorDialog str = do
-- |May hide or show the widget that holds the quad tree path entry,
-- depending on the context.
showPathWidget :: MyGUI
-- depending on the context and may also pop up the tree window.
onPathWidgetChange :: MyGUI
-> IO ()
showPathWidget mygui = do
onPathWidgetChange mygui = do
item <- comboBoxGetActive (cB mygui)
if item == 4 then widgetShow (vbox7 mygui) else widgetHide (vbox7 mygui)
if item == 4
then do
widgetShow (vbox7 mygui)
widgetShow (winT mygui)
else widgetHide (vbox7 mygui)
return ()
@ -217,6 +235,7 @@ saveAndDrawDiag fp fps mygui =
then do
mesh <- readFile fp
dw <- widgetGetDrawWindow (da mygui)
dwT <- widgetGetDrawWindow (daT mygui)
adjustment <- rangeGetAdjustment (hs mygui)
scaleVal <- adjustmentGetValue adjustment
xlD' <- entryGetText (xl mygui)
@ -225,6 +244,7 @@ saveAndDrawDiag fp fps mygui =
yuD' <- entryGetText (yu mygui)
alg' <- comboBoxGetActive (cB mygui)
(daW, daH) <- widgetGetSize (da mygui)
(daTW, daTH) <- widgetGetSize (daT mygui)
gd' <- toggleButtonGetActive (gC mygui)
ct' <- toggleButtonGetActive (cC mygui)
pE' <- entryGetText (pE mygui)
@ -236,23 +256,29 @@ saveAndDrawDiag fp fps mygui =
yD = (,) <$>
readMaybe ylD' <*>
readMaybe yuD' :: Maybe (Double, Double)
renderDiag winWidth winHeight buildDiag xD' yD' =
renderDia Cairo
(CairoOptions fps
(Dims (fromIntegral winWidth) (fromIntegral winHeight))
SVG False)
(buildDiag (def{
t = scaleVal,
dX = xD',
dY = yD',
alg = alg',
gd = gd',
ct = ct',
pQt = pE'})
mesh)
case (xD, yD) of
(Just xD', Just yD') -> do
let (s, r) = renderDia Cairo
(CairoOptions fps
(Dims (fromIntegral daW) (fromIntegral daH))
SVG False)
(diagS (def{
t = scaleVal,
dX = xD',
dY = yD',
alg = alg',
gd = gd',
ct = ct',
pQt = pE'})
mesh)
let (s, r) = renderDiag daW daH diagS xD' yD'
let (_, r') = renderDiag daTW daTH diagTreeS xD' yD'
renderWithDrawable dw r
renderWithDrawable dwT r'
if null fps
then return ()
else s

12
GUI/gtk2.glade
View File

@ -867,4 +867,16 @@ Show quad tree squares</property>
</widget>
</child>
</widget>
<widget class="GtkWindow" id="window2">
<property name="width_request">800</property>
<property name="height_request">500</property>
<property name="can_focus">False</property>
<property name="type_hint">dialog</property>
<child>
<widget class="GtkDrawingArea" id="treedrawingarea">
<property name="visible">True</property>
<property name="can_focus">False</property>
</widget>
</child>
</widget>
</glade-interface>

8
Graphics/Diagram/Gtk.hs
View File

@ -40,3 +40,11 @@ diagS :: DiagProp -> MeshString -> Diagram Cairo R2
diagS p mesh
| alg p == 2 || alg p == 3 = diag p. Objects . facesToArr $ mesh
| otherwise = (diag p . Object . meshToArr $ mesh) # bg white
-- |Create the tree diagram from a String which is supposed to be the contents
-- of an obj file.
diagTreeS :: DiagProp -> MeshString -> Diagram Cairo R2
diagTreeS p mesh
| alg p == 4 = mkDiag treePretty p (Object . meshToArr $mesh)
| otherwise = mempty

19
Graphics/Diagram/Plotter.hs
View File

@ -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