From ecf203c8250cdcca8a4e300bf7dc964a25347dfa Mon Sep 17 00:00:00 2001
From: hasufell <hasufell@hasufell.de>
Date: Fri, 14 Nov 2014 21:28:56 +0100
Subject: [PATCH] DIAG: Allow drawing the square the user path points to

---
 GUI/Gtk.hs                  | 11 +++--
 GUI/gtk2.glade              | 81 ++++++++++++++++++++++++++++++++++++-
 Graphics/Diagram/Gtk.hs     |  4 +-
 Graphics/Diagram/Plotter.hs | 26 ++++++++++++
 Graphics/Diagram/Types.hs   |  6 ++-
 5 files changed, 119 insertions(+), 9 deletions(-)

diff --git a/GUI/Gtk.hs b/GUI/Gtk.hs
index 5a87b62..7d27e59 100644
--- a/GUI/Gtk.hs
+++ b/GUI/Gtk.hs
@@ -51,8 +51,10 @@ data MyGUI = MkMyGUI {
   cB  :: ComboBox,
   -- |grid check button
   gC  :: CheckButton,
-    -- |coord check button
-  cC  :: CheckButton
+  -- |coord check button
+  cC  :: CheckButton,
+  -- |Path entry widget for the quad tree.
+  pE :: Entry
 }
 
 
@@ -84,6 +86,7 @@ makeMyGladeGUI = do
     <*> xmlGetWidget xml castToComboBox "comboalgo"
     <*> xmlGetWidget xml castToCheckButton "gridcheckbutton"
     <*> xmlGetWidget xml castToCheckButton "coordcheckbutton"
+    <*> xmlGetWidget xml castToEntry "path"
 
 
 -- |Main entry point for the GTK GUI routines.
@@ -209,6 +212,7 @@ saveAndDrawDiag fp fps mygui =
       (daW, daH) <- widgetGetSize (da mygui)
       gd'        <- toggleButtonGetActive (gC mygui)
       ct'        <- toggleButtonGetActive (cC mygui)
+      pE'        <- entryGetText (pE mygui)
 
       let
         xD = (,)         <$>
@@ -230,7 +234,8 @@ saveAndDrawDiag fp fps mygui =
                     dY  = yD',
                     alg = alg',
                     gd  = gd',
-                    ct  = ct'})
+                    ct  = ct',
+                    pQt = pE'})
                   mesh)
           renderWithDrawable dw r
           if null fps
diff --git a/GUI/gtk2.glade b/GUI/gtk2.glade
index d870db6..8d68d0e 100644
--- a/GUI/gtk2.glade
+++ b/GUI/gtk2.glade
@@ -380,6 +380,7 @@ Public License instead of this License.
     <property name="height_request">750</property>
     <property name="can_focus">False</property>
     <property name="title" translatable="yes">CG2</property>
+    <property name="window_position">mouse</property>
     <property name="type_hint">dialog</property>
     <child>
       <widget class="GtkVBox" id="vbox1">
@@ -460,6 +461,18 @@ Public License instead of this License.
             <property name="position">2</property>
           </packing>
         </child>
+        <child>
+          <widget class="GtkHSeparator" id="hseparator2">
+            <property name="visible">True</property>
+            <property name="can_focus">False</property>
+          </widget>
+          <packing>
+            <property name="expand">False</property>
+            <property name="fill">True</property>
+            <property name="padding">5</property>
+            <property name="position">3</property>
+          </packing>
+        </child>
         <child>
           <widget class="GtkHBox" id="hbox2">
             <property name="visible">True</property>
@@ -757,7 +770,71 @@ Public License instead of this License.
           <packing>
             <property name="expand">False</property>
             <property name="fill">False</property>
-            <property name="position">3</property>
+            <property name="position">4</property>
+          </packing>
+        </child>
+        <child>
+          <widget class="GtkHSeparator" id="hseparator1">
+            <property name="visible">True</property>
+            <property name="can_focus">False</property>
+          </widget>
+          <packing>
+            <property name="expand">False</property>
+            <property name="fill">True</property>
+            <property name="padding">5</property>
+            <property name="position">5</property>
+          </packing>
+        </child>
+        <child>
+          <widget class="GtkHBox" id="hbox5">
+            <property name="visible">True</property>
+            <property name="can_focus">False</property>
+            <child>
+              <widget class="GtkLabel" id="pathlabel">
+                <property name="visible">True</property>
+                <property name="can_focus">False</property>
+                <property name="label" translatable="yes">QuadTree Path</property>
+              </widget>
+              <packing>
+                <property name="expand">False</property>
+                <property name="fill">False</property>
+                <property name="padding">5</property>
+                <property name="position">0</property>
+              </packing>
+            </child>
+            <child>
+              <widget class="GtkEntry" id="path">
+                <property name="visible">True</property>
+                <property name="can_focus">True</property>
+                <property name="invisible_char">●</property>
+                <property name="primary_icon_activatable">False</property>
+                <property name="secondary_icon_activatable">False</property>
+                <property name="primary_icon_sensitive">True</property>
+                <property name="secondary_icon_sensitive">True</property>
+              </widget>
+              <packing>
+                <property name="expand">True</property>
+                <property name="fill">True</property>
+                <property name="position">1</property>
+              </packing>
+            </child>
+          </widget>
+          <packing>
+            <property name="expand">False</property>
+            <property name="fill">False</property>
+            <property name="position">6</property>
+          </packing>
+        </child>
+        <child>
+          <widget class="GtkHSeparator" id="hseparator3">
+            <property name="visible">True</property>
+            <property name="can_focus">False</property>
+          </widget>
+          <packing>
+            <property name="expand">False</property>
+            <property name="fill">True</property>
+            <property name="padding">5</property>
+            <property name="position">7</property>
           </packing>
         </child>
         <child>
@@ -773,7 +850,7 @@ Show quad tree squares</property>
           <packing>
             <property name="expand">False</property>
             <property name="fill">False</property>
-            <property name="position">4</property>
+            <property name="position">8</property>
           </packing>
         </child>
       </widget>
diff --git a/Graphics/Diagram/Gtk.hs b/Graphics/Diagram/Gtk.hs
index 3a59206..89be33c 100644
--- a/Graphics/Diagram/Gtk.hs
+++ b/Graphics/Diagram/Gtk.hs
@@ -19,8 +19,8 @@ diag p obj@(Object _)
       mkDiag (mconcat [convexHPText, convexHP, convexHLs, coordPoints, plotterBG])
              p obj
   | alg p == 4 =
-      mkDiag (mconcat [squares, coordPointsText, coordPoints, polyLines,
-                       plotterBG])
+      mkDiag (mconcat [quadPathSquare, squares, coordPointsText,
+                       coordPoints, polyLines, plotterBG])
              p obj
   | otherwise = mempty
 diag p objs@(Objects _)
diff --git a/Graphics/Diagram/Plotter.hs b/Graphics/Diagram/Plotter.hs
index 6f1d8ad..295b555 100644
--- a/Graphics/Diagram/Plotter.hs
+++ b/Graphics/Diagram/Plotter.hs
@@ -6,11 +6,13 @@ import Algebra.VectorTypes
 import Algorithms.ConvexHull.GrahamScan
 import Algorithms.RangeSearch.Core
 import Algorithms.PolygonIntersection.Core
+import Data.Maybe
 import Data.Monoid
 import Diagrams.Backend.Cairo
 import Diagrams.Prelude hiding ((<>))
 import Graphics.Diagram.Types
 import Graphics.Gloss.Data.Extent
+import Parser.PathParser
 
 
 -- |Creates a Diagram that shows the coordinates from the points
@@ -188,6 +190,30 @@ squares = Diag f
     f _ _ = mempty
 
 
+-- |Create a diagram that shows a single square of the RangeSearch algorithm
+-- from the quad tree in red, according to the given path in pQt.
+quadPathSquare :: Diag
+quadPathSquare = Diag f
+  where
+    f p (Object []) = mempty
+    f p (Object vt) =
+      (\((xmin, xmax), (ymin, ymax)) -> rect (xmax - xmin) (ymax - ymin)
+        # moveTo (p2 ((xmax + xmin) / 2,(ymax + ymin) / 2)) # lw thin # lc red)
+        (getSquare (stringToQuads (pQt p)) (qt, []))
+      where
+        quads :: [QuadOrOrient]
+        quads = stringToQuads (pQt p)
+        getSquare :: [QuadOrOrient] -> Zipper PT -> Square
+        getSquare [] z = getSquareByZipper (dX p, dY p) z
+        getSquare (q:qs) z = case q of
+          Orient x -> getSquare qs (fromMaybe z (findNeighbor x z))
+          Quad x -> getSquare qs (fromMaybe z (goQuad x z))
+        qt :: QuadTree PT
+        qt = quadTree vtf (dX p, dY p)
+        vtf :: [PT]
+        vtf = filterValidPT p vt
+
+
 -- |Creates a Diagram that shows an XAxis which is bound
 -- by the dimensions given in xD from DiagProp.
 xAxis :: Diag
diff --git a/Graphics/Diagram/Types.hs b/Graphics/Diagram/Types.hs
index 15aec10..7d529fd 100644
--- a/Graphics/Diagram/Types.hs
+++ b/Graphics/Diagram/Types.hs
@@ -53,7 +53,9 @@ data DiagProp = MkProp {
   -- |If we want to show the coordinates as text.
   ct :: Bool,
   -- |Square size used to show the grid and x/y-axis.
-  sqS :: Double
+  sqS :: Double,
+  -- |The path to a quad in the quad tree.
+  pQt :: String
 }
 
 
@@ -83,7 +85,7 @@ instance Monoid Diag where
 
 -- |The default properties of the Diagram.
 defaultProp :: DiagProp
-defaultProp = MkProp 2 (0,500) (0,500) 0 False False 50
+defaultProp = MkProp 2 (0,500) (0,500) 0 False False 50 ""
 
 
 -- |Extract the lower bound of the x-axis dimension.