code search function to query quad tree

fcore/quad-tree.sml

@@ -244,4 +244,117 @@ struct
         Vector.concat vec
       end
   end
+
+  (* building and querying quad tree, plus compression *)
+  datatype quad_tree =
+    LEAF of {x: int, y: int, ex: int, ey: int, data: int}
+  | NODE of {tl: quad_tree, tr: quad_tree, bl: quad_tree, br: quad_tree}
+  | EMPTY
+
+  fun buildTree (x, y, size, grid) =
+    if x >= Vector.length grid orelse y >= Vector.length grid then
+      EMPTY
+    else if quadHasSameColour (x, y, x + size, y + size, grid) then
+      let
+        val yAxis = Vector.sub (grid, x)
+        val data = Vector.sub (yAxis, y)
+      in
+        if data = ignoreData then
+          EMPTY
+        else
+          let
+            val ex = x + size
+            val ey = y + size
+          in
+            LEAF {x = x, y = y, ex = ex, ey = ey, data = data}
+          end
+      end
+    else
+      (if size mod 2 = 0 orelse size = 1 then
+         let
+           val halfSize = size div 2
+           val tl = buildTree (x, y, halfSize, grid)
+           val tr = buildTree (x + halfSize, y, halfSize, grid)
+           val bl = buildTree (x, y + halfSize, halfSize, grid)
+           val br = buildTree (x + halfSize, y + halfSize, halfSize, grid)
+         in
+           NODE {tl = tl, tr = tr, bl = bl, br = br}
+         end
+       else
+         (* handles odd-number divisions.
+          * For example, `7 div 2` is 3 because of integer division. 
+          * We would not cover every pixel unless we handle odd numbers specially. *)
+         let
+           val halfSizeBefore = size div 2
+           val halfSizeAfter = (size + 1) div 2
+           val tl = buildTree (x, y, halfSizeAfter, grid)
+           val tr = buildTree (x + halfSizeBefore, y, halfSizeAfter, grid)
+           val bl = buildTree (x, y + halfSizeBefore, halfSizeAfter, grid)
+           val br =
+             buildTree
+               (x + halfSizeBefore, y + halfSizeBefore, halfSizeAfter, grid)
+         in
+           NODE {tl = tl, tr = tr, bl = bl, br = br}
+         end)
+
+  fun getItemWithDataAt (x, y, qx, qy, size, tree, data) =
+    case tree of
+      EMPTY => NONE
+    | LEAF (item as {x = ix, y = iy, ex = iex, ey = iey, data = oldData}) =>
+        if data = oldData then
+          (* data matches *)
+          if (x >= ix andalso x <= iex) andalso (y >= iy andalso y <= iey) then
+            (* search coordinates are in item *)
+            SOME item
+          else
+            NONE
+        else
+          NONE
+    | NODE {tl, tr, bl, br} =>
+        if size mod 2 = 0 orelse size = 1 then
+          let
+            val halfSize = size div 2
+            val qmx = x + halfSize
+            val qfx = x + size
+            val qmy = y + halfSize
+            val qfy = y + size
+          in
+            if y >= qy andalso y <= qmy then
+              (* top *)
+              if x >= qx andalso x <= qmx then
+                (* top left *)
+                getItemWithDataAt (x, y, qx, qy, halfSize, tl, data)
+              else
+                (* top right *)
+                getItemWithDataAt (x, y, qx + halfSize, qy, halfSize, tr, data)
+            else (* bottom *) if x >= qx andalso x <= qmx then
+              (* bottom left *)
+              getItemWithDataAt (x, y, qx, qy + halfSize, halfSize, bl, data)
+            else
+              (* bottom right *)
+              getItemWithDataAt
+                (x, y, qx + halfSize, qy + halfSize, halfSize, br, data)
+          end
+        else
+          let
+            val halfSizeBefore = size div 2
+            val halfSizeAfter = (size + 1) div 2
+            val qmx = x + halfSizeBefore
+            val qmy = y + halfSizeBefore
+          in
+            if y >= qy andalso y <= qmy then
+              (* top *)
+              if x >= qx andalso x <= qmx then
+                (* top left *)
+                getItemWithDataAt (x, y, qx, qy, halfSizeAfter, tl, data)
+              else
+                (* top right *)
+                getItemWithDataAt (x, y, qmx, qy, halfSizeAfter, tr, data)
+            else (* bottom *) if x >= qx andalso x <= qmx then
+              (* bottom left *)
+              getItemWithDataAt (x, y, qx, qmy, halfSizeAfter, bl, data)
+            else
+              (* bottom right *)
+              getItemWithDataAt (x, y, qmx, qmy, halfSizeAfter, br, data)
+          end
 end