| blob | f157106c6f06e40ee722bb2babd4dc0d3ccbe9f9 |
1 (*\r
2 Copyright 2021 Anton Krotov\r
3 \r
4 This file is part of CEdit.\r
5 \r
6 CEdit is free software: you can redistribute it and/or modify\r
7 it under the terms of the GNU General Public License as published by\r
8 the Free Software Foundation, either version 3 of the License, or\r
9 (at your option) any later version.\r
10 \r
11 CEdit is distributed in the hope that it will be useful,\r
12 but WITHOUT ANY WARRANTY; without even the implied warranty of\r
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\r
14 GNU General Public License for more details.\r
15 \r
16 You should have received a copy of the GNU General Public License\r
17 along with CEdit. If not, see <http://www.gnu.org/licenses/>.\r
18 *)\r
19 \r
20 MODULE Scroll;\r
21 \r
22 IMPORT G := Graph, K := KolibriOS, U := Utils;\r
23 \r
24 CONST\r
25 \r
26 ScrollIPC* = 0;\r
27 Delay* = 40;\r
28 \r
29 TYPE\r
30 \r
31 tScroll* = RECORD\r
32 vertical, Inc*, Dec*, mouse: BOOLEAN;\r
33 top*, left*,\r
34 width*, height*: INTEGER; (* read only *)\r
35 btnSize, sliderSize: INTEGER;\r
36 pos, Slider, pos0, maxVal*, value*: INTEGER;\r
37 canvas*: G.tCanvas\r
38 END;\r
39 \r
40 \r
41 PROCEDURE create* (vertical: BOOLEAN; width, height: INTEGER; btnSize, sliderSize: INTEGER; VAR scroll: tScroll);\r
42 VAR\r
43 res: tScroll;\r
44 BEGIN\r
45 res.vertical := vertical;\r
46 res.Inc := FALSE;\r
47 res.Dec := FALSE;\r
48 res.Slider := -1;\r
49 res.mouse := FALSE;\r
50 res.left := 0;\r
51 res.top := 0;\r
52 res.width := width;\r
53 res.height := height;\r
54 res.btnSize := btnSize;\r
55 res.sliderSize := sliderSize;\r
56 res.pos := 0;\r
57 res.maxVal := 0;\r
58 res.canvas := G.CreateCanvas(width, height);\r
59 scroll := res\r
60 END create;\r
61 \r
62 \r
63 PROCEDURE Rect (canvas: G.tCanvas; left, top, right, bottom: INTEGER);\r
64 BEGIN\r
65 G.FillRect(canvas, left, top, right, bottom);\r
66 G.SetColor(canvas, K.borderColor);\r
67 G.Rect(canvas, left, top, right, bottom);\r
68 END Rect;\r
69 \r
70 \r
71 PROCEDURE _paint (scroll: tScroll);\r
72 VAR\r
73 canvas: G.tCanvas;\r
74 x, y, d, x1, x2, y1, y2,\r
75 width, height, btn: INTEGER;\r
76 \r
77 \r
78 PROCEDURE SetColor (canvas: G.tCanvas; c: BOOLEAN);\r
79 VAR\r
80 color: INTEGER;\r
81 BEGIN\r
82 IF c THEN\r
83 color := K.btnColor\r
84 ELSE\r
85 color := K.btnTextColor\r
86 END;\r
87 G.SetColor(canvas, color)\r
88 END SetColor;\r
89 \r
90 \r
91 BEGIN\r
92 btn := scroll.btnSize;\r
93 width := scroll.width;\r
94 height := scroll.height;\r
95 canvas := scroll.canvas;\r
96 G.SetColor(canvas, K.winColor);\r
97 G.clear(canvas);\r
98 G.SetColor(canvas, K.borderColor);\r
99 G.Rect(canvas, 0, 0, width - 1, height - 1);\r
100 IF scroll.vertical THEN\r
101 SetColor(canvas, ~scroll.Dec);\r
102 Rect(canvas, 0, 0, width - 1, btn - 1);\r
103 SetColor(canvas, ~scroll.Inc);\r
104 Rect(canvas, 0, height - btn, width - 1, height - 1);\r
105 G.SetColor(canvas, K.btnColor);\r
106 Rect(canvas, 0, btn + scroll.pos - 1, width - 1, btn + scroll.pos + scroll.sliderSize - 1);\r
107 \r
108 G.SetColor(canvas, K.btnTextColor);\r
109 \r
110 y := btn + scroll.pos + scroll.sliderSize DIV 2 - 1;\r
111 G.HLine(canvas, y, width DIV 4, 3*width DIV 4);\r
112 G.HLine(canvas, y - 3, width DIV 3, 2*width DIV 3);\r
113 G.HLine(canvas, y + 3, width DIV 3, 2*width DIV 3);\r
114 \r
115 d := 4*width DIV 10;\r
116 x1 := (width - d) DIV 2;\r
117 x2 := x1 + d;\r
118 \r
119 SetColor(canvas, scroll.Dec);\r
120 y := (btn - d DIV 2) DIV 2 + d DIV 2 - 1;\r
121 G.Triangle(canvas, x1 - 1, y, x2, y, G.triUp);\r
122 \r
123 SetColor(canvas, scroll.Inc);\r
124 y := y + height - btn - d DIV 2 + 1;\r
125 G.Triangle(canvas, x1 - 1, y, x2, y, G.triDown);\r
126 ELSE\r
127 SetColor(canvas, ~scroll.Dec);\r
128 Rect(canvas, 0, 0, btn - 1, height - 1);\r
129 SetColor(canvas, ~scroll.Inc);\r
130 Rect(canvas, width - btn, 0, width - 1, height - 1);\r
131 G.SetColor(canvas, K.btnColor);\r
132 Rect(canvas, btn + scroll.pos - 1, 0, btn + scroll.pos + scroll.sliderSize - 1, height - 1);\r
133 \r
134 G.SetColor(canvas, K.btnTextColor);\r
135 \r
136 x := btn + scroll.pos + scroll.sliderSize DIV 2 - 1;\r
137 G.VLine(canvas, x, height DIV 4, 3*height DIV 4);\r
138 G.VLine(canvas, x - 3, height DIV 3, 2*height DIV 3);\r
139 G.VLine(canvas, x + 3, height DIV 3, 2*height DIV 3);\r
140 \r
141 d := 4*height DIV 10;\r
142 y1 := (height - d) DIV 2;\r
143 y2 := y1 + d;\r
144 \r
145 SetColor(canvas, scroll.Dec);\r
146 x := (btn - d DIV 2) DIV 2 + d DIV 2 - 1;\r
147 G.Triangle(canvas, x, y1 - 1, x, y2, G.triLeft);\r
148 \r
149 SetColor(canvas, scroll.Inc);\r
150 x := x + width - btn - d DIV 2 + 1;\r
151 G.Triangle(canvas, x, y1 - 1, x, y2, G.triRight);\r
152 END;\r
153 G.DrawCanvas(scroll.canvas, scroll.left, scroll.top)\r
154 END _paint;\r
155 \r
156 \r
157 PROCEDURE paint* (scroll: tScroll);\r
158 BEGIN\r
159 IF scroll.canvas # NIL THEN\r
160 _paint(scroll)\r
161 END\r
162 END paint;\r
163 \r
164 \r
165 PROCEDURE resize* (VAR scroll: tScroll; width, height: INTEGER);\r
166 BEGIN\r
167 G.destroy(scroll.canvas);\r
168 scroll.canvas := G.CreateCanvas(width, height);\r
169 scroll.width := width;\r
170 scroll.height := height;\r
171 paint(scroll)\r
172 END resize;\r
173 \r
174 \r
175 PROCEDURE setValue* (VAR scroll: tScroll; value: INTEGER);\r
176 VAR\r
177 pos, maxPos, n, m: INTEGER;\r
178 BEGIN\r
179 IF scroll.vertical THEN\r
180 maxPos := scroll.height\r
181 ELSE\r
182 maxPos := scroll.width\r
183 END;\r
184 maxPos := maxPos - scroll.btnSize*2 - scroll.sliderSize + 1;\r
185 IF (value < 0) OR (scroll.maxVal <= 0) THEN\r
186 value := 0;\r
187 pos := 0\r
188 ELSIF value > scroll.maxVal THEN\r
189 value := scroll.maxVal;\r
190 pos := maxPos\r
191 ELSE\r
192 IF (maxPos + 1) >= scroll.maxVal THEN\r
193 n := (maxPos + 1) DIV scroll.maxVal;\r
194 m := (maxPos + 1) MOD scroll.maxVal;\r
195 pos := value*n + MIN(value, m)\r
196 ELSE\r
197 pos := FLOOR(FLT(value)*FLT(maxPos + 1)/FLT(scroll.maxVal))\r
198 END;\r
199 IF pos > maxPos THEN\r
200 pos := maxPos;\r
201 value := scroll.maxVal\r
202 END\r
203 END;\r
204 scroll.pos := pos;\r
205 scroll.value := value\r
206 END setValue;\r
207 \r
208 \r
209 PROCEDURE change* (VAR scroll: tScroll);\r
210 BEGIN\r
211 IF scroll.Inc THEN\r
212 setValue(scroll, scroll.value + 1)\r
213 ELSIF scroll.Dec THEN\r
214 setValue(scroll, scroll.value - 1)\r
215 END;\r
216 paint(scroll)\r
217 END change;\r
218 \r
219 \r
220 PROCEDURE ceil (p, q: INTEGER): INTEGER;\r
221 RETURN p DIV q + ORD(p MOD q # 0)\r
222 END ceil;\r
223 \r
224 \r
225 PROCEDURE setPos (VAR scroll: tScroll; pos: INTEGER);\r
226 VAR\r
227 maxPos, value, n, m, x, x0, q: INTEGER;\r
228 BEGIN\r
229 IF scroll.maxVal > 0 THEN\r
230 IF scroll.vertical THEN\r
231 maxPos := scroll.height\r
232 ELSE\r
233 maxPos := scroll.width\r
234 END;\r
235 maxPos := maxPos - scroll.btnSize*2 - scroll.sliderSize + 1;\r
236 IF pos <= 0 THEN\r
237 pos := 0;\r
238 value := 0\r
239 ELSIF pos >= maxPos THEN\r
240 pos := maxPos;\r
241 value := scroll.maxVal\r
242 ELSE\r
243 IF scroll.maxVal <= maxPos + 1 THEN\r
244 n := (maxPos + 1) DIV scroll.maxVal;\r
245 m := (maxPos + 1) MOD scroll.maxVal;\r
246 \r
247 q := m*(n + 1);\r
248 IF q < pos THEN\r
249 value := ceil(pos - m, n)\r
250 ELSIF q > pos THEN\r
251 value := ceil(pos, n + 1)\r
252 ELSE\r
253 value := m\r
254 END;\r
255 \r
256 x := value*n + MIN(value, m);\r
257 x0 := (value - 1)*n + MIN(value - 1, m);\r
258 \r
259 IF x - pos > pos - x0 THEN\r
260 pos := x0;\r
261 DEC(value)\r
262 ELSE\r
263 pos := x;\r
264 IF pos > maxPos THEN\r
265 pos := maxPos;\r
266 value := scroll.maxVal\r
267 END\r
268 END\r
269 ELSE\r
270 value := FLOOR(FLT(scroll.maxVal)*FLT(pos)/FLT(maxPos + 1))\r
271 END\r
272 END\r
273 ELSE\r
274 pos := 0;\r
275 scroll.value := 0\r
276 END;\r
277 scroll.pos := pos;\r
278 scroll.value := value\r
279 END setPos;\r
280 \r
281 \r
282 PROCEDURE isActive* (scroll: tScroll): BOOLEAN;\r
283 RETURN scroll.Inc OR scroll.Dec OR (scroll.Slider # -1)\r
284 END isActive;\r
285 \r
286 \r
287 PROCEDURE MouseMove* (VAR scroll: tScroll; x, y: INTEGER);\r
288 VAR\r
289 c: INTEGER;\r
290 BEGIN\r
291 IF scroll.Slider # -1 THEN\r
292 IF scroll.vertical THEN\r
293 c := y - scroll.top\r
294 ELSE\r
295 c := x - scroll.left\r
296 END;\r
297 setPos(scroll, scroll.pos0 + c - scroll.Slider);\r
298 paint(scroll)\r
299 END\r
300 END MouseMove;\r
301 \r
302 \r
303 PROCEDURE SendIPC*;\r
304 BEGIN\r
305 K.SendIPC(K.ThreadID(), ScrollIPC)\r
306 END SendIPC;\r
307 \r
308 \r
309 PROCEDURE MouseDown* (VAR scroll: tScroll; x, y: INTEGER);\r
310 VAR\r
311 c, size: INTEGER;\r
312 BEGIN\r
313 IF ~scroll.mouse THEN\r
314 DEC(x, scroll.left);\r
315 DEC(y, scroll.top);\r
316 scroll.mouse := TRUE;\r
317 IF U.between(1, x, scroll.width - 2) & U.between(1, y, scroll.height - 2) THEN\r
318 IF scroll.vertical THEN\r
319 c := y;\r
320 size := scroll.height\r
321 ELSE\r
322 c := x;\r
323 size := scroll.width\r
324 END;\r
325 IF U.between(scroll.btnSize + scroll.pos - 1, c, scroll.btnSize + scroll.pos + scroll.sliderSize - 1) THEN\r
326 scroll.pos0 := scroll.pos;\r
327 scroll.Slider := c\r
328 ELSIF U.between(0, c, scroll.btnSize - 1) THEN\r
329 scroll.Dec := TRUE;\r
330 SendIPC\r
331 ELSIF U.between(size - scroll.btnSize, c, size - 1) THEN\r
332 scroll.Inc := TRUE;\r
333 SendIPC\r
334 ELSE\r
335 setPos(scroll, c - scroll.btnSize - scroll.sliderSize DIV 2);\r
336 scroll.pos0 := scroll.pos;\r
337 scroll.Slider := c;\r
338 paint(scroll)\r
339 END\r
340 END\r
341 END\r
342 END MouseDown;\r
343 \r
344 \r
345 PROCEDURE MouseUp* (VAR scroll: tScroll);\r
346 BEGIN\r
347 IF scroll.mouse THEN\r
348 scroll.Slider := -1;\r
349 scroll.Inc := FALSE;\r
350 scroll.Dec := FALSE;\r
351 scroll.mouse := FALSE;\r
352 paint(scroll)\r
353 END\r
354 END MouseUp;\r
355 \r
356 \r
357 END Scroll.