1 files changed, 73 insertions, 0 deletions
diff --git a/selection.ml b/selection.ml
new file mode 100755
index 0000000..2bf41ce
--- /dev/null
+++ b/selection.ml
@@ -0,0 +1,73 @@
+module T2 = Tools.Tuple2
+
+type t =
+  | Single   of (int * int)
+  | Multiple of (int * int) * (int * int)
+
+let create c = Single c
+
+type axe =
+  | Horizontal of int
+  | Vertical of int
+  | Cell of (int * int)
+
+let is_selected sel_type t = match sel_type, t with
+  | Horizontal h , Single (x, y) -> h = x
+  | Vertical v , Single (x, y) -> v = y
+  | Cell c, Single x -> c = x
+  | Horizontal h, Multiple ((x1, _), (x2, _)) ->
+      let min_x = min x1 x2
+      and max_x = max x1 x2 in
+      min_x <= h && h <= max_x
+  | Vertical v, Multiple ((_, y1), (_, y2)) ->
+      let min_y = min y1 y2
+      and max_y = max y1 y2 in
+      min_y <= v && v <= max_y
+  | Cell (x, y), Multiple ((x1, y1), (x2, y2)) ->
+      let min_x = min x1 x2
+      and max_x = max x1 x2 in
+      let min_y = min y1 y2
+      and max_y = max y1 y2 in
+      min_x <= x && x <= max_x && min_y <= y && y <= max_y
+
+let extract = function
+  | Single x -> x
+  | Multiple (x,y) -> y
+
+let fold (f:('a -> int * int -> 'a)) (init:'a): t -> 'a = function
+  | Single x -> f init x
+  | Multiple ((x1, y1), (x2, y2)) ->
+      let min_x = min x1 x2
+      and max_x = max x1 x2
+      and min_y = min y1 y2
+      and max_y = max y1 y2 in
+      let res = ref init in
+      for x = min_x to max_x do
+        for y = min_y to max_y do
+          res := f !res (x, y)
+        done
+      done;
+      !res
+
+(** Extends the selection in one direction *)
+let extends direction t = begin
+  let extends position = match direction with
+    | Actions.Left  amount -> T2.map1 (fun v -> max 1 @@ v - amount) position
+    | Actions.Right amount -> T2.map1 ((+) amount) position
+    | Actions.Up    amount -> T2.map2 (fun v -> max 1 @@ v - amount) position
+    | Actions.Down  amount -> T2.map2 ((+) amount) position
+    | Actions.Absolute (x, y) -> x, y in
+
+  let start_pos, end_pos = match t with
+  | Single x -> x, (extends x)
+  | Multiple (x, y) -> x, (extends y) in
+
+  if start_pos = end_pos then
+    Single start_pos
+  else
+    Multiple (start_pos, end_pos)
+end
+
+let shift = function
+  | Single (start_x, start_y) -> fun (x, y) -> (x - start_x, y - start_y)
+  | Multiple ((start_x, start_y), _) -> fun (x, y) -> (x - start_x, y - start_y)