1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
|
(*
This file is part of licht.
licht is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
licht is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with licht. If not, see <http://www.gnu.org/licenses/>.
*)
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)
let move direction t =
let position = extract t in
let position' = begin match direction with
| Actions.Left quant -> Tools.Tuple2.replace1 (max 1 ((fst position) - quant)) position
| Actions.Right quant -> Tools.Tuple2.replace1 ((fst position) + quant) position
| Actions.Up quant -> Tools.Tuple2.replace2 (max 1 ((snd position) - quant)) position
| Actions.Down quant -> Tools.Tuple2.replace2 ((snd position) + quant) position
| Actions.Absolute (x, y)-> (x, y)
end in
if position = position' then
None
else
Some (create position')
|
