fortty Public

Watch 0 Fork 0 Star 0
Fortran · 3564 bytes Raw Blame History
1 module selection_mod
2 use cell_mod
3 use screen_mod
4 implicit none
5 private
6
7 public :: selection_t
8 public :: selection_start, selection_update, selection_end
9 public :: selection_clear, selection_contains
10 public :: selection_is_active, selection_get_bounds
11 public :: selection_normalize
12
13 type :: selection_t
14 logical :: active = .false.
15 logical :: selecting = .false. ! Mouse button held
16 integer :: start_row = 0
17 integer :: start_col = 0
18 integer :: end_row = 0
19 integer :: end_col = 0
20 end type selection_t
21
22 contains
23
24 subroutine selection_start(sel, row, col)
25 type(selection_t), intent(inout) :: sel
26 integer, intent(in) :: row, col
27
28 sel%start_row = row
29 sel%start_col = col
30 sel%end_row = row
31 sel%end_col = col
32 sel%selecting = .true.
33 sel%active = .false. ! Not active until mouse moves
34 end subroutine selection_start
35
36 subroutine selection_update(sel, row, col)
37 type(selection_t), intent(inout) :: sel
38 integer, intent(in) :: row, col
39
40 if (.not. sel%selecting) return
41
42 sel%end_row = row
43 sel%end_col = col
44
45 ! Mark as active if selection spans at least one cell
46 if (sel%start_row /= sel%end_row .or. sel%start_col /= sel%end_col) then
47 sel%active = .true.
48 end if
49 end subroutine selection_update
50
51 subroutine selection_end(sel)
52 type(selection_t), intent(inout) :: sel
53
54 sel%selecting = .false.
55 ! Keep active if we have a valid selection
56 end subroutine selection_end
57
58 subroutine selection_clear(sel)
59 type(selection_t), intent(inout) :: sel
60
61 sel%active = .false.
62 sel%selecting = .false.
63 sel%start_row = 0
64 sel%start_col = 0
65 sel%end_row = 0
66 sel%end_col = 0
67 end subroutine selection_clear
68
69 function selection_is_active(sel) result(active)
70 type(selection_t), intent(in) :: sel
71 logical :: active
72
73 active = sel%active
74 end function selection_is_active
75
76 pure subroutine selection_normalize(sel, r1, c1, r2, c2)
77 type(selection_t), intent(in) :: sel
78 integer, intent(out) :: r1, c1, r2, c2
79
80 ! Return normalized bounds (r1,c1) <= (r2,c2) in reading order
81 if (sel%start_row < sel%end_row .or. &
82 (sel%start_row == sel%end_row .and. sel%start_col <= sel%end_col)) then
83 r1 = sel%start_row
84 c1 = sel%start_col
85 r2 = sel%end_row
86 c2 = sel%end_col
87 else
88 r1 = sel%end_row
89 c1 = sel%end_col
90 r2 = sel%start_row
91 c2 = sel%start_col
92 end if
93 end subroutine selection_normalize
94
95 subroutine selection_get_bounds(sel, r1, c1, r2, c2)
96 type(selection_t), intent(in) :: sel
97 integer, intent(out) :: r1, c1, r2, c2
98
99 call selection_normalize(sel, r1, c1, r2, c2)
100 end subroutine selection_get_bounds
101
102 pure function selection_contains(sel, row, col) result(contains)
103 type(selection_t), intent(in) :: sel
104 integer, intent(in) :: row, col
105 logical :: contains
106 integer :: r1, c1, r2, c2
107
108 contains = .false.
109 if (.not. sel%active) return
110
111 call selection_normalize(sel, r1, c1, r2, c2)
112
113 ! Check if (row, col) is within selection
114 if (row < r1 .or. row > r2) return
115
116 if (r1 == r2) then
117 ! Single line selection
118 contains = (col >= c1 .and. col <= c2)
119 else if (row == r1) then
120 ! First line of multi-line selection
121 contains = (col >= c1)
122 else if (row == r2) then
123 ! Last line of multi-line selection
124 contains = (col <= c2)
125 else
126 ! Middle lines are fully selected
127 contains = .true.
128 end if
129 end function selection_contains
130
131 end module selection_mod
132