| blob | c386e5668d5fb7eb853516d68f196c9230c76e4e |
1 {*
2 * Copyright (C) 2024 Mikulas Patocka
3 *
4 * This file is part of Ajla.
5 *
6 * Ajla is free software: you can redistribute it and/or modify it under the
7 * terms of the GNU General Public License as published by the Free Software
8 * Foundation, either version 3 of the License, or (at your option) any later
9 * version.
10 *
11 * Ajla is distributed in the hope that it will be useful, but WITHOUT ANY
12 * WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
13 * A PARTICULAR PURPOSE. See the GNU General Public License for more details.
14 *
15 * You should have received a copy of the GNU General Public License along with
16 * Ajla. If not, see <https://www.gnu.org/licenses/>.
17 *}
19 unit ui.curses;
21 uses io;
22 uses treemap;
23 uses ui.event;
24 uses ui.rect;
26 type curses;
28 fn curses_init(implicit w : world, d : dhandle, h : list(handle), env : treemap(bytes, bytes)) : (world, curses);
29 fn curses_done(implicit w : world, curs : curses) : world;
31 fn curses_set_pos~inline(curs : curses, x y : int) : curses;
32 fn curses_get_pos~inline(curs : curses) : (int, int);
33 fn curses_restrict_viewport(curs : curses, x1 x2 y1 y2 : int, xo yo : int) : curses;
34 fn curses_revert_viewport(curs : curses) : curses;
35 fn curses_get_scissors(curs : curses) : rect;
36 fn curses_valid_viewport(curs : curses) : bool;
37 fn curses_test_viewport(curs : curses, x1 x2 y1 y2 : int) : bool;
38 fn curses_n_colors~inline(curs : curses) : int;
39 fn curses_set_fgcolor(curs : curses, r g b : uint16) : curses;
40 fn curses_set_bgcolor(curs : curses, r g b : uint16) : curses;
41 const curses_underline : uint8 := 1;
42 const curses_blink : uint8 := 2;
43 const curses_bold : uint8 := 4;
44 const curses_invert : uint8 := 8;
45 private const curses_acs : uint8 := 16;
46 private const curses_left_wide : uint8 := 32;
47 private const curses_right_wide : uint8 := 64;
48 fn curses_set_attributes(curs : curses, flags : uint8) : curses;
49 fn curses_set_cursor~inline(curs : curses, x y : int) : curses;
50 fn curses_print(curs : curses, str : string) : curses;
51 fn curses_set_char(curs : curses, x y : int, ch : char) : curses;
52 fn curses_fill_rect(curs : curses, x1 x2 y1 y2 : int, ch : char) : curses;
53 fn curses_recolor_rect(curs : curses, x1 x2 y1 y2 : int) : curses;
54 fn curses_hline(curs : curses, x1 : int, x2 : int, y : int, width : int) : curses;
55 fn curses_vline(curs : curses, x : int, y1 : int, y2 : int, width : int) : curses;
56 fn curses_box(curs : curses, x1 x2 y1 y2 : int, width : int) : curses;
57 fn curses_frame(curs : curses, x y : int, frame : uint16) : curses;
59 fn curses_update(w : world, curs : curses) : (world, curses);
61 fn curses_get_event(w : world, curs : curses, t : type, altmq : msgqueue(t)) : (world, curses, event);
63 implementation
65 uses charset;
66 uses exception;
67 uses ui.termcap;
68 uses pcode;
70 type packets := list(int32);
72 type ccolor := uint8;
74 const color_16_offset : ccolor := 16;
75 const color_216_offset : ccolor := 32;
77 record cchar~flat [
78 ch : char;
79 fgcolor : ccolor;
80 bgcolor : ccolor;
81 attrib : uint8;
82 ]
84 fn cchar_equal~inline(b1 b2 : cchar) : bool := b1.ch = b2.ch and b1.fgcolor = b2.fgcolor and b1.bgcolor = b2.bgcolor and b1.attrib = b2.attrib;
85 implicit fn instance_eq_cchar~inline : class_eq(cchar) :=
86 class_eq(cchar).[
87 equal : cchar_equal,
88 ];
90 option color_mode~flat [
91 mono;
92 color16;
93 color256;
94 ]
96 const acs_map~lazy : array(byte, [#110000])
97 [
98 var am := array_sparse(byte, 0, [#110000]);
99 am[#00a3] := '}';
100 am[#00b0] := 'f';
101 am[#00b1] := 'g';
102 am[#00b7] := '~';
103 am[#03c0] := '{';
104 am[#2190] := ',';
105 am[#2191] := '-';
106 am[#2192] := '+';
107 am[#2193] := '.';
108 am[#2260] := '|';
109 am[#2264] := 'y';
110 am[#2265] := 'z';
111 am[#23ba] := 'o';
112 am[#23bb] := 'p';
113 am[#23bc] := 'r';
114 am[#23bd] := 's';
115 am[#240b] := 'i';
116 am[#2500] := 'q';
117 am[#2502] := 'x';
118 am[#250c] := 'l';
119 am[#2510] := 'k';
120 am[#2514] := 'm';
121 am[#2518] := 'j';
122 am[#251c] := 't';
123 am[#2524] := 'u';
124 am[#252c] := 'w';
125 am[#2534] := 'v';
126 am[#253c] := 'n';
127 am[#2550] := 'q';
128 am[#2551] := 'x';
129 am[#2552] := 'l';
130 am[#2553] := 'l';
131 am[#2554] := 'l';
132 am[#2555] := 'k';
133 am[#2556] := 'k';
134 am[#2557] := 'k';
135 am[#2558] := 'm';
136 am[#2559] := 'm';
137 am[#255a] := 'm';
138 am[#255b] := 'j';
139 am[#255c] := 'j';
140 am[#255d] := 'j';
141 am[#255e] := 't';
142 am[#255f] := 't';
143 am[#2560] := 't';
144 am[#2561] := 'u';
145 am[#2562] := 'u';
146 am[#2563] := 'u';
147 am[#2564] := 'w';
148 am[#2565] := 'w';
149 am[#2566] := 'w';
150 am[#2567] := 'v';
151 am[#2568] := 'v';
152 am[#2569] := 'v';
153 am[#256a] := 'n';
154 am[#256b] := 'n';
155 am[#256c] := 'n';
156 am[#2588] := '0';
157 am[#2591] := 'h';
158 am[#2592] := 'a';
159 am[#25c6] := '`';
160 return am;
161 ]
163 record viewport [
164 x1 x2 y1 y2 : int;
165 xo yo : int;
166 ]
168 record curses [
169 packet_mode : bool;
170 tc : termcap;
171 loc : locale;
172 acs_map : array(byte, [#110000]);
173 prefer_acs_map : bool;
174 frame_fallback : bool;
176 const x y : int;
177 cm : color_mode;
178 underline_supported : bool;
179 blink_supported : bool;
180 bold_supported : bool;
181 altcharset_map : array(byte, [#80]);
182 have_set_attributes : bool;
183 have_right_bottom : bool;
184 tilde_glitch : bool;
186 buffer : array(cchar, [y, x]);
187 back_buffer : array(cchar, [y, x]);
188 h : list(handle);
190 fgcolor : ccolor;
191 bgcolor : ccolor;
192 attributes : uint8;
193 px : int;
194 py : int;
195 scissors : rect;
196 xo : int;
197 yo : int;
198 old_viewport : list(viewport);
200 cx : int;
201 cy : int;
203 current_cx : int;
204 current_cy : int;
205 current_fgcolor : int;
206 current_bgcolor : int;
207 current_attributes : int;
208 cursor_visible : bool;
210 sgr_underline : bool;
211 sgr_inverse : bool;
212 sgr_blink : bool;
213 sgr_bold : bool;
214 sgr_altcharset : bool;
216 lines_redraw : int64;
217 mouse_visible : bool;
218 mouse_x : int;
219 mouse_y : int;
221 q : msgqueue(event);
222 kbd_thread : bottom_type;
223 resize_thread : bottom_type;
224 suspend_thread : bottom_type;
225 mouse_thread : bottom_type;
227 event_buffer : list(event);
228 ]
230 fn curses_hide_mouse(implicit curs : curses) : (curses, bytes, packets);
232 fn curses_string_sgr(implicit curs : curses) : (curses, bytes)
233 [
234 var str := "";
235 var s : bytes;
236 if curs.have_set_attributes then [
237 curs.tc, s := termcap_substitute_string(curs.tc, tc_s_set_attributes, [
238 tc_param.num.(0),
239 tc_param.num.(select(curs.sgr_underline, 0, 1)),
240 tc_param.num.(select(curs.sgr_inverse, 0, 1)),
241 tc_param.num.(select(curs.sgr_blink, 0, 1)),
242 tc_param.num.(0),
243 tc_param.num.(select(curs.sgr_bold, 0, 1)),
244 tc_param.num.(0),
245 tc_param.num.(0),
246 tc_param.num.(select(curs.sgr_altcharset, 0, 1)),
248 ]);
249 str += s;
250 ] else [
251 curs.tc, s := termcap_substitute_string(curs.tc, tc_s_exit_attribute_mode, empty(tc_param));
252 str += s;
253 if curs.sgr_underline then [
254 curs.tc, s := termcap_substitute_string(curs.tc, tc_s_enter_underline_mode, empty(tc_param));
255 str += s;
256 ]
257 if curs.sgr_inverse then [
258 curs.tc, s := termcap_substitute_string(curs.tc, tc_s_enter_reverse_mode, empty(tc_param));
259 str += s;
260 ]
261 if curs.sgr_blink then [
262 curs.tc, s := termcap_substitute_string(curs.tc, tc_s_enter_blink_mode, empty(tc_param));
263 str += s;
264 ]
265 if curs.sgr_bold then [
266 curs.tc, s := termcap_substitute_string(curs.tc, tc_s_enter_bold_mode, empty(tc_param));
267 str += s;
268 ]
269 if curs.sgr_altcharset then [
270 curs.tc, s := termcap_substitute_string(curs.tc, tc_s_enter_alt_charset_mode, empty(tc_param));
271 str += s;
272 ]
273 ]
274 if not curs.cm is mono then [
275 curs.current_fgcolor := -1;
276 curs.current_bgcolor := -1;
277 ]
278 return str;
279 ]
281 fn curses_string_color(implicit curs : curses, fg bg : ccolor, attributes : int) : (curses, bytes)
282 [
283 var str := "";
284 var s : bytes;
285 var sgr_underline := curs.underline_supported and (attributes and curses_underline) <> 0;
286 var sgr_inverse := false;
287 if curs.cm is mono then [
288 sgr_inverse := bg > fg xor (attributes and curses_invert) <> 0;
289 ] else [
290 if (attributes and curses_invert) <> 0 then
291 fg, bg := bg, fg;
292 ]
293 var sgr_blink := curs.blink_supported and (attributes and curses_blink) <> 0;
294 var sgr_bold := curs.bold_supported and (attributes and curses_bold) <> 0;
295 if curs.bold_supported, not curs.cm is color256, fg >= 8 then
296 sgr_bold := true;
297 var sgr_altcharset := (attributes and curses_acs) <> 0;
298 if sgr_underline <> curs.sgr_underline or
299 sgr_inverse <> curs.sgr_inverse or
300 sgr_blink <> curs.sgr_blink or
301 sgr_bold <> curs.sgr_bold or
302 sgr_altcharset <> curs.sgr_altcharset then [
303 curs.sgr_underline := sgr_underline;
304 curs.sgr_inverse := sgr_inverse;
305 curs.sgr_blink := sgr_blink;
306 curs.sgr_bold := sgr_bold;
307 curs.sgr_altcharset := sgr_altcharset;
308 s := curses_string_sgr(curs);
309 str += s;
310 ]
311 if not curs.cm is mono then [
312 if curs.current_fgcolor <> fg then [
313 curs.tc, s := termcap_substitute_string(curs.tc, tc_s_set_a_foreground, [ tc_param.num.(select(curs.cm is color16, fg, fg and 7)) ]);
314 str += s;
315 curs.current_fgcolor := fg;
316 ]
317 if curs.current_bgcolor <> bg then [
318 curs.tc, s := termcap_substitute_string(curs.tc, tc_s_set_a_background, [ tc_param.num.(select(curs.cm is color16, bg, bg and 7)) ]);
319 str += s;
320 curs.current_bgcolor := bg;
321 ]
322 ] else [
323 curs.current_fgcolor := fg;
324 curs.current_bgcolor := bg;
325 ]
326 return str;
327 ]
329 fn default_16_rgb(i : int) : (int, int, int)
330 [
331 var rc := select(i bt 0, 0, 1000);
332 var gc := select(i bt 1, 0, 1000);
333 var bc := select(i bt 2, 0, 1000);
334 if not i bt 3 then [
335 rc := rc * 2 div 3;
336 gc := gc * 2 div 3;
337 bc := bc * 2 div 3;
338 ] else [
339 if rc = 0, gc = 0, bc = 0 then
340 rc, gc, bc := 1000 div 3, 1000 div 3, 1000 div 3;
341 ]
342 return rc, gc, bc;
343 ]
345 fn rgb_to_color(cm : color_mode, r g b : uint16) : ccolor
346 [
347 if cm is color256 then [
348 if r = #0000, g = #0000, b = #0000 then return color_16_offset + 0;
349 if r = #aaaa, g = #0000, b = #0000 then return color_16_offset + 1;
350 if r = #0000, g = #aaaa, b = #0000 then return color_16_offset + 2;
351 if r = #aaaa, g = #aaaa, b = #0000 then return color_16_offset + 3;
352 if r = #0000, g = #0000, b = #aaaa then return color_16_offset + 4;
353 if r = #aaaa, g = #0000, b = #aaaa then return color_16_offset + 5;
354 if r = #0000, g = #aaaa, b = #aaaa then return color_16_offset + 6;
355 if r = #aaaa, g = #aaaa, b = #aaaa then return color_16_offset + 7;
356 if r = #5555, g = #5555, b = #5555 then return color_16_offset + 8;
357 if r = #ffff, g = #0000, b = #0000 then return color_16_offset + 9;
358 if r = #0000, g = #ffff, b = #0000 then return color_16_offset + 10;
359 if r = #ffff, g = #ffff, b = #0000 then return color_16_offset + 11;
360 if r = #0000, g = #0000, b = #ffff then return color_16_offset + 12;
361 if r = #ffff, g = #0000, b = #ffff then return color_16_offset + 13;
362 if r = #0000, g = #ffff, b = #ffff then return color_16_offset + 14;
363 if r = #ffff, g = #ffff, b = #ffff then return color_16_offset + 15;
364 var rt := (5 * r + #7fff) div #ffff;
365 var gt := (5 * g + #7fff) div #ffff;
366 var bt := (5 * b + #7fff) div #ffff;
367 //eval debug("color: " + ntos(rt) + ", " + ntos(gt) + ", " + ntos(bt));
368 return color_216_offset + rt * 36 + gt * 6 + bt;
369 ]
370 var rf := r > #5555;
371 var gf := g > #5555;
372 var bf := b > #5555;
373 var bold := r > #aaaa or g > #aaaa or b > #aaaa;
374 if r = #5555, g = #5555, b = #5555 then
375 bold := true;
376 return select(rf, 0, 1) + select(gf, 0, 2) + select(bf, 0, 4) + select(bold, 0, 8);
377 ]
379 fn default_fg_color(cm : color_mode) : ccolor := rgb_to_color(cm, #aaaa, #aaaa, #aaaa);
380 fn default_bg_color(cm : color_mode) : ccolor := rgb_to_color(cm, 0, 0, 0);
382 fn curses_string_setpos(implicit curs : curses, x y : int) : (curses, bytes, packets)
383 [
384 var s := "";
385 var pkt := packets.[];
386 if x = curs.current_cx, y = curs.current_cy then
387 goto ret;
388 if curs.packet_mode then [
389 pkt := packets.[ 3, x, y ];
390 ] else [
391 curs.tc, s := termcap_substitute_string(curs.tc, tc_s_cursor_address, [ tc_param.num.(y), tc_param.num.(x) ]);
392 ]
393 curs.current_cx := x;
394 curs.current_cy := y;
395 ret:
396 return s, pkt;
397 ]
399 fn curses_prepare_for_redraw(implicit curs : curses) : curses
400 [
401 for j := 0 to curs.y do
402 for i := 0 to curs.x do
403 curs.back_buffer[j, i].ch := -2;
404 curs.lines_redraw := -1;
405 ]
407 fn curses_string_cls(implicit curs : curses) : (curses, bytes, packets)
408 [
409 if curs.packet_mode then [
410 curses_prepare_for_redraw();
411 curs.cursor_visible := true;
412 return "", packets.[ 4, 1 ];
413 ]
414 var str := "";
415 var s : bytes;
416 curs.tc, s := termcap_substitute_string(curs.tc, tc_s_exit_attribute_mode, empty(tc_param));
417 str += s;
418 s := curses_string_color(default_fg_color(curs.cm), default_bg_color(curs.cm), 0);
419 str += s;
420 if termcap_has_string(curs.tc, tc_s_clear_screen) then [
421 curs.tc, s := termcap_substitute_string(curs.tc, tc_s_clear_screen, empty(tc_param));
422 str += s;
423 curs.current_cx := 0;
424 curs.current_cy := 0;
425 ]
426 if not termcap_has_string(curs.tc, tc_s_clear_screen) or not termcap_query_bool(curs.tc, tc_b_back_color_erase) then [
427 curses_prepare_for_redraw();
428 ]
429 curs.tc, s := termcap_substitute_string(curs.tc, tc_s_cursor_normal, empty(tc_param));
430 str += s;
431 curs.cursor_visible := true;
432 return str, packets.[];
433 ]
435 fn curses_init(implicit w : world, d : dhandle, h : list(handle), env : treemap(bytes, bytes)) : (world, curses)
436 [
437 var sigtstp, stk := signal_handle("SIGTSTP");
439 var loc := locale_console_init(env);
440 var packet_mode := false;
442 var tc := exception_make(termcap, ec_sync, error_not_supported, 0, true);
444 var cm := color_mode.color16;
446 var underline_supported := false;
447 var blink_supported := false;
448 var bold_supported := false;
450 var altcharset_supported := false;
451 var altcharset_map := array_fill(byte, 0, [#80]);
453 var have_set_attributes := false;
454 var have_right_bottom := true;
455 var tilde_glitch := false;
457 var os := sysprop(SystemProperty_OS);
458 if os = SystemProperty_OS_DOS or os = SystemProperty_OS_OS2 or os = SystemProperty_OS_Windows then [
459 packet_mode := true;
460 ] else [
461 tc := termcap_init(d, env);
463 if not termcap_has_string(tc, tc_s_cursor_address) then
464 abort exception_make_str(int, ec_sync, error_not_supported, 0, false, "The terminal is too dumb");
466 var colors := termcap_query_number(tc, tc_n_max_colors);
468 cm := color_mode.mono;
469 if colors >= 8,
470 termcap_has_string(tc, tc_s_set_a_foreground),
471 termcap_has_string(tc, tc_s_set_a_background) then [
472 cm := color_mode.color16;
473 ]
474 if colors >= 256,
475 termcap_has_string(tc, tc_s_set_a_foreground),
476 termcap_has_string(tc, tc_s_set_a_background),
477 termcap_query_bool(tc, tc_b_can_change),
478 not termcap_query_bool(tc, tc_b_hue_lightness_saturation),
479 termcap_has_string(tc, tc_s_initialize_color),
480 termcap_has_string(tc, tc_s_orig_colors) then [
481 cm := color_mode.color256;
482 ]
484 underline_supported := true;
485 blink_supported := true;
486 bold_supported := true;
487 altcharset_supported := termcap_has_string(tc, tc_s_acs_chars);
488 if not cm is mono then [
489 var ncv := termcap_query_number(tc, tc_n_no_color_video);
490 if ncv >= 0 then [
491 underline_supported and= not ncv bt 1;
492 blink_supported and= not ncv bt 3;
493 bold_supported and= not ncv bt 5;
494 altcharset_supported and= not ncv bt 8;
495 ]
496 ]
497 if altcharset_supported then [
498 var str := termcap_query_string(tc, tc_s_acs_chars);
499 var i := 0;
500 while len_greater_than(str, i + 1) do [
501 var key := str[i];
502 var value := str[i + 1];
503 //eval debug("acs map: " + ntos(key) + ", " + ntos(value));
504 if key < #80 then
505 altcharset_map[key] := value;
506 i += 2;
507 ]
508 ]
509 have_set_attributes := termcap_has_string(tc, tc_s_set_attributes);
510 have_right_bottom := termcap_query_bool(tc, tc_b_eat_newline_glitch);
511 tilde_glitch := termcap_query_bool(tc, tc_b_tilde_glitch);
512 ]
514 var old_w := w;
515 var xx, yy, ox, oy := tty_size(h[0]);
516 if is_exception w then [
517 recover_world(old_w);
518 if packet_mode then [
519 xx := 80;
520 yy := 25;
521 ] else [
522 xx := termcap_query_number(tc, tc_n_columns);
523 yy := termcap_query_number(tc, tc_n_lines);
524 if xx < 0 then xx := 80;
525 if yy < 0 then yy := 24;
526 ]
527 ]
528 const x := xx;
529 const y := yy;
530 var prefer_acs_map := false;
531 if not packet_mode, list_begins_with(termcap_get_term(tc), "linux") then
532 prefer_acs_map := true;
533 var frame_fallback := false;
534 if not packet_mode, list_begins_with(termcap_get_term(tc), "cygwin") then
535 frame_fallback := true;
536 if sysprop(SystemProperty_OS) = SystemProperty_OS_Windows then
537 frame_fallback := true;
538 var space := cchar.[ ch : ' ', fgcolor : default_fg_color(cm), bgcolor : default_bg_color(cm), attrib : 0 ];
539 implicit var curs := curses.[
540 packet_mode : packet_mode,
541 tc : tc,
542 loc : loc,
543 acs_map : acs_map,
544 prefer_acs_map : prefer_acs_map,
545 frame_fallback : frame_fallback,
546 x : x,
547 y : y,
548 cm : cm,
549 underline_supported : underline_supported,
550 blink_supported : blink_supported,
551 bold_supported : bold_supported,
552 altcharset_map : altcharset_map,
553 have_set_attributes : have_set_attributes,
554 have_right_bottom : have_right_bottom,
555 tilde_glitch : tilde_glitch,
556 buffer : array_fill(space, [y, x]),
557 back_buffer : array_fill(space, [y, x]),
558 h : h,
559 fgcolor : default_fg_color(cm),
560 bgcolor : default_bg_color(cm),
561 attributes : 0,
562 px : 0,
563 py : 0,
564 xo : 0,
565 yo : 0,
566 scissors : rect.[ x1 : 0, y1 : 0, x2 : x, y2 : y ],
567 old_viewport : empty(viewport),
568 cx : 0,
569 cy : 0,
570 current_cx : -1,
571 current_cy : -1,
572 current_fgcolor : -1,
573 current_bgcolor : -1,
574 current_attributes : 0,
575 cursor_visible : true,
576 sgr_underline : false,
577 sgr_inverse : false,
578 sgr_blink : false,
579 sgr_bold : false,
580 sgr_altcharset : false,
581 lines_redraw : 0,
582 mouse_visible : false,
583 event_buffer : empty(event),
584 ];
586 curs.q := msgqueue_new(event);
588 if not packet_mode then [
589 var str := "";
590 var s : bytes;
591 var pkt : packets;
592 curs.tc, s := termcap_substitute_string(curs.tc, tc_s_enter_ca_mode, empty(tc_param));
593 str += s;
594 curs.tc, s := termcap_substitute_string(curs.tc, tc_s_keypad_xmit, empty(tc_param));
595 str += s;
596 s, pkt := curses_string_cls();
597 str += s;
598 if termcap_has_mouse(curs.tc) then [
599 var esc := bytes.[ 27 ];
600 str += esc + "[?1000h";
601 str += esc + "[?1003h";
602 str += esc + "[?1006h";
603 ]
604 if curs.cm is color256 then [
605 curs.tc, s := termcap_substitute_string(curs.tc, tc_s_orig_colors, empty(tc_param));
606 str += s;
607 for i := 0 to 16 do [
608 var rc, gc, bc := default_16_rgb(i);
609 var ccode := color_16_offset + i;
610 curs.tc, s := termcap_substitute_string(curs.tc, tc_s_initialize_color, [ tc_param.num.(ccode), tc_param.num.(rc), tc_param.num.(gc), tc_param.num.(bc) ]);
611 str += s;
612 ]
613 for r := 0 to 6 do [
614 var rc := r * 1000 div 5;
615 for g := 0 to 6 do [
616 var gc := g * 1000 div 5;
617 for b := 0 to 6 do [
618 var bc := b * 1000 div 5;
619 //eval debug("setup: " + ntos(r) + ", " + ntos(g) + ", " + ntos(b) + ": " + ntos(rc) + ", " + ntos(gc) + ", " + ntos(bc));
620 var ccode := color_216_offset + r * 36 + g * 6 + b;
621 curs.tc, s := termcap_substitute_string(curs.tc, tc_s_initialize_color, [ tc_param.num.(ccode), tc_param.num.(rc), tc_param.num.(gc), tc_param.num.(bc) ]);
622 str += s;
623 ]
624 ]
625 ]
626 ]
627 write(h[1], str);
628 ] else [
629 var s, pstr := curses_string_cls();
630 pstr +<= 1;
631 write_console_packet(curs.h[1], pstr);
632 ]
634 var ev : event := event.resize.(event_resize.[ x : x, y : y ]);
635 msgqueue_send(curs.q, ev_tag_resize, ev);
637 curs.kbd_thread := event_get_keyboard(w, h[0], curs.tc, curs.loc, curs.q);
638 curs.resize_thread := event_get_resize(w, h[0], curs.q, x, y, ox, oy);
639 curs.suspend_thread := event_get_suspend(w, curs.q, sigtstp, stk);
640 curs.mouse_thread := event_get_mouse(w, h[0], curs.q);
641 ]
643 fn curses_done(implicit w : world, implicit curs : curses) : world
644 [
645 var str := "";
646 var pstr := packets.[];
647 var s : bytes;
648 var pkt : packets;
649 if not curs.cursor_visible then [
650 if curs.packet_mode then [
651 pstr += packets.[ 4, 1 ];
652 ] else [
653 curs.tc, s := termcap_substitute_string(curs.tc, tc_s_cursor_normal, empty(tc_param));
654 str += s;
655 ]
656 ]
657 s, pkt := curses_hide_mouse();
658 str += s;
659 pstr += pkt;
660 if not curs.packet_mode then [
661 s := curses_string_color(7, 0, 0);
662 str += s;
663 curs.tc, s := termcap_substitute_string(curs.tc, tc_s_clear_screen, empty(tc_param));
664 str += s;
665 ]
666 s, pkt := curses_string_setpos(0, max(0, curs.y - 1));
667 str += s;
668 pstr += pkt;
669 if not curs.packet_mode then [
670 curs.tc, s := termcap_substitute_string(curs.tc, tc_s_exit_attribute_mode, empty(tc_param));
671 str += s;
672 if termcap_has_mouse(curs.tc) then [
673 var esc := bytes.[ 27 ];
674 str += esc + "[?1000l";
675 str += esc + "[?1003l";
676 str += esc + "[?1006l";
677 ]
678 if curs.cm is color256 then [
679 curs.tc, s := termcap_substitute_string(curs.tc, tc_s_orig_colors, empty(tc_param));
680 str += s;
681 ]
682 curs.tc, s := termcap_substitute_string(curs.tc, tc_s_keypad_local, empty(tc_param));
683 str += s;
684 curs.tc, s := termcap_substitute_string(curs.tc, tc_s_exit_ca_mode, empty(tc_param));
685 str += s;
686 ]
688 if curs.packet_mode then [
689 pstr +<= 1;
690 write_console_packet(curs.h[1], pstr);
691 ] else [
692 write(curs.h[1], str);
693 ]
694 curs.kbd_thread := exception_make(bottom_type, ec_sync, error_record_field_not_initialized, 0, false);
695 curs.resize_thread := exception_make(bottom_type, ec_sync, error_record_field_not_initialized, 0, false);
696 curs.suspend_thread := exception_make(bottom_type, ec_sync, error_record_field_not_initialized, 0, false);
697 curs.mouse_thread := exception_make(bottom_type, ec_sync, error_record_field_not_initialized, 0, false);
698 wait_for_dereferenced();
699 if not curs.packet_mode then [
700 event_reset_handle(curs.h[0]);
701 ]
702 ]
704 fn curses_resize(implicit w : world, curs : curses, const x y : int) : (world, curses)
705 [
706 var space := cchar.[ ch : ' ', fgcolor : default_fg_color(curs.cm), bgcolor : default_bg_color(curs.cm), attrib : 0 ];
707 var curs2 := curses.[
708 packet_mode : curs.packet_mode,
709 tc : curs.tc,
710 loc : curs.loc,
711 acs_map : curs.acs_map,
712 prefer_acs_map : curs.prefer_acs_map,
713 frame_fallback : curs.frame_fallback,
714 x : x,
715 y : y,
716 cm : curs.cm,
717 underline_supported : curs.underline_supported,
718 blink_supported : curs.blink_supported,
719 bold_supported : curs.bold_supported,
720 altcharset_map : curs.altcharset_map,
721 have_set_attributes : curs.have_set_attributes,
722 have_right_bottom : curs.have_right_bottom,
723 tilde_glitch : curs.tilde_glitch,
724 buffer : array_fill(space, [y, x]),
725 back_buffer : array_fill(space, [y, x]),
726 h : curs.h,
727 fgcolor : curs.fgcolor,
728 bgcolor : curs.bgcolor,
729 attributes : curs.attributes,
730 px : curs.px,
731 py : curs.py,
732 scissors : rect.[ x1 : 0, y1 : 0, x2 : x, y2 : y ],
733 xo : 0,
734 yo : 0,
735 old_viewport : curs.old_viewport,
736 cx : curs.cx,
737 cy : curs.cy,
738 current_cx : -1,
739 current_cy : -1,
740 current_fgcolor : -1,
741 current_bgcolor : -1,
742 current_attributes : 0,
743 cursor_visible : curs.cursor_visible,
744 sgr_underline : false,
745 sgr_inverse : false,
746 sgr_blink : false,
747 sgr_bold : false,
748 sgr_altcharset : false,
749 lines_redraw : -1,
750 mouse_visible : false,
751 q : curs.q,
752 kbd_thread : curs.kbd_thread,
753 resize_thread : curs.resize_thread,
754 suspend_thread : curs.suspend_thread,
755 mouse_thread : curs.mouse_thread,
756 event_buffer : curs.event_buffer,
757 ];
758 var s : bytes;
759 var pstr : packets;
760 curs2, s, pstr := curses_string_cls(curs2);
761 if curs2.packet_mode then [
762 pstr +<= 1;
763 write_console_packet(curs.h[1], pstr);
764 ] else [
765 write(curs.h[1], s);
766 ]
767 return curs2;
768 ]
770 fn curses_set_pos~inline(curs : curses, x y : int) : curses
771 [
772 x += curs.xo;
773 y += curs.yo;
774 curs.px := x;
775 curs.py := y;
776 return curs;
777 ]
779 fn curses_get_pos~inline(curs : curses) : (int, int)
780 [
781 return curs.px - curs.xo, curs.py - curs.yo;
782 ]
784 fn curses_restrict_viewport(curs : curses, x1 x2 y1 y2 : int, xo yo : int) : curses
785 [
786 var old := viewport.[
787 x1 : curs.scissors.x1,
788 x2 : curs.scissors.x2,
789 y1 : curs.scissors.y1,
790 y2 : curs.scissors.y2,
791 xo : curs.xo,
792 yo : curs.yo,
793 ];
794 curs.old_viewport +<= old;
795 x1 += curs.xo;
796 x2 += curs.xo;
797 y1 += curs.yo;
798 y2 += curs.yo;
799 curs.scissors := rect_intersection(curs.scissors, rect.[ x1 : x1, x2 : x2, y1 : y1, y2 : y2 ]);
800 curs.xo += xo;
801 curs.yo += yo;
802 return curs;
803 ]
805 fn curses_revert_viewport(curs : curses) : curses
806 [
807 var old := curs.old_viewport[len(curs.old_viewport) - 1];
808 curs.old_viewport := curs.old_viewport[ .. len(curs.old_viewport) - 1];
809 curs.scissors.x1 := old.x1;
810 curs.scissors.x2 := old.x2;
811 curs.scissors.y1 := old.y1;
812 curs.scissors.y2 := old.y2;
813 curs.xo := old.xo;
814 curs.yo := old.yo;
815 return curs;
816 ]
818 fn curses_get_scissors(curs : curses) : rect
819 [
820 var sc := curs.scissors;
821 sc.x1 -= curs.xo;
822 sc.x2 -= curs.xo;
823 sc.y1 -= curs.yo;
824 sc.y2 -= curs.yo;
825 return sc;
826 ]
828 fn curses_valid_viewport(curs : curses) : bool
829 [
830 return rect_is_valid(curses_get_scissors(curs));
831 ]
833 fn curses_test_viewport(curs : curses, x1 x2 y1 y2 : int) : bool
834 [
835 var r := rect.[ x1 : x1, x2 : x2, y1 : y1, y2 : y2 ];
836 return rect_test_intersect(curses_get_scissors(curs), r);
837 ]
839 fn curses_n_colors~inline(curs : curses) : int
840 [
841 return [ 2, 16, 256 ][ ord curs.cm ];
842 ]
844 fn curses_set_fgcolor(curs : curses, r g b : uint16) : curses
845 [
846 curs.fgcolor := rgb_to_color(curs.cm, r, g, b);
847 return curs;
848 ]
850 fn curses_set_bgcolor(curs : curses, r g b : uint16) : curses
851 [
852 curs.bgcolor := rgb_to_color(curs.cm, r, g, b);
853 return curs;
854 ]
856 fn curses_set_attributes(curs : curses, flags : uint8) : curses
857 [
858 curs.attributes := flags;
859 return curs;
860 ]
862 fn curses_set_cursor~inline(curs : curses, x y : int) : curses
863 [
864 // TODO: handle the case when the cursor points out of scissors
865 x += curs.xo;
866 y += curs.yo;
867 if curs.cx <> x or curs.cy <> y then [
868 curs.cx := x;
869 curs.cy := y;
870 curs.lines_redraw bts= curs.y;
871 ]
872 return curs;
873 ]
875 fn curses_print(curs : curses, str : string) : curses
876 [
877 if curs.py >= curs.scissors.y1, curs.py < curs.scissors.y2 then [
878 var scx1, scx2 := curs.scissors.x1, curs.scissors.x2;
879 for i := 0 to len(str) do [
880 if curs.px >= scx2 then
881 break;
882 var ch := str[i];
883 var cls := classify_character(ch);
884 if cls <= 0 then
885 continue;
886 if curs.px >= scx1 then [
887 if cls = 1 then [
888 curs.buffer[curs.py, curs.px] := cchar.[ ch : ch, fgcolor : curs.fgcolor, bgcolor : curs.bgcolor, attrib : curs.attributes ];
889 ] else if curs.packet_mode then [
890 curs.buffer[curs.py, curs.px] := cchar.[ ch : ch, fgcolor : curs.fgcolor, bgcolor : curs.bgcolor, attrib : curs.attributes ];
891 if curs.px + 1 < scx2 then
892 curs.buffer[curs.py, curs.px + 1] := cchar.[ ch : ' ', fgcolor : curs.fgcolor, bgcolor : curs.bgcolor, attrib : curs.attributes ];
893 ] else [
894 curs.buffer[curs.py, curs.px] := cchar.[ ch : ch, fgcolor : curs.fgcolor, bgcolor : curs.bgcolor, attrib : curs.attributes or curses_left_wide ];
895 if curs.px + 1 < scx2 then
896 curs.buffer[curs.py, curs.px + 1] := cchar.[ ch : ch, fgcolor : curs.fgcolor, bgcolor : curs.bgcolor, attrib : curs.attributes or curses_right_wide ];
897 ]
898 ]
899 curs.px += cls;
900 curs.lines_redraw bts= curs.py;
901 ]
902 ]
903 return curs;
904 ]
906 fn curses_get_char(curs : curses, x y : int) : char
907 [
908 x += curs.xo;
909 y += curs.yo;
910 if x >= curs.scissors.x1, x < curs.scissors.x2, y >= curs.scissors.y1, y < curs.scissors.y2 then [
911 return curs.buffer[y, x]. ch;
912 ]
913 return 0;
914 ]
916 fn curses_set_char(curs : curses, x y : int, ch : char) : curses
917 [
918 x += curs.xo;
919 y += curs.yo;
920 if x >= curs.scissors.x1, x < curs.scissors.x2, y >= curs.scissors.y1, y < curs.scissors.y2 then [
921 curs.buffer[y, x] := cchar.[ ch : ch, fgcolor : curs.fgcolor, bgcolor : curs.bgcolor, attrib : curs.attributes ];
922 curs.lines_redraw bts= y;
923 ]
924 return curs;
925 ]
927 fn curses_fill_rect(curs : curses, x1 x2 y1 y2 : int, ch : char) : curses
928 [
929 x1 += curs.xo;
930 x2 += curs.xo;
931 y1 += curs.yo;
932 y2 += curs.yo;
933 var cls := classify_character(ch);
934 if cls <> 1 then
935 ch := ' ';
936 x1 := max(x1, curs.scissors.x1);
937 x2 := min(x2, curs.scissors.x2);
938 y1 := max(y1, curs.scissors.y1);
939 y2 := min(y2, curs.scissors.y2);
940 for y := y1 to y2 do [
941 for x := x1 to x2 do [
942 curs.buffer[y, x] := cchar.[ ch : ch, fgcolor : curs.fgcolor, bgcolor : curs.bgcolor, attrib : curs.attributes ];
943 curs.lines_redraw bts= y;
944 ]
945 ]
946 return curs;
947 ]
949 fn curses_recolor_rect(curs : curses, x1 x2 y1 y2 : int) : curses
950 [
951 x1 += curs.xo;
952 x2 += curs.xo;
953 y1 += curs.yo;
954 y2 += curs.yo;
955 x1 := max(x1, curs.scissors.x1);
956 x2 := min(x2, curs.scissors.x2);
957 y1 := max(y1, curs.scissors.y1);
958 y2 := min(y2, curs.scissors.y2);
959 for y := y1 to y2 do [
960 for x := x1 to x2 do [
961 curs.buffer[y, x].fgcolor := curs.fgcolor;
962 curs.buffer[y, x].bgcolor := curs.bgcolor;
963 curs.buffer[y, x].attrib := curs.attributes or curs.buffer[y, x].attrib and (curses_acs or curses_left_wide or curses_right_wide);
964 curs.lines_redraw bts= y;
965 ]
966 ]
967 return curs;
968 ]
970 fn frame_desc~cache : array(uint16, [#30]) :=
971 array(uint16, [#30]).[
972 #ffff, #ffff, #ffff, #0101, #1101, #2101, #1202, #1200,
973 #2100, #2202, #0202, #2200, #2002, #1002, #2001, #1100,
974 #0011, #1011, #1110, #0111, #1010, #1111, #0121, #0212,
975 #0022, #0220, #2022, #2220, #0222, #2020, #2222, #2021,
976 #1012, #2120, #1210, #0012, #0021, #0120, #0210, #1212,
977 #2121, #1001, #0110, #ffff, #ffff, #ffff, #ffff, #ffff,
978 ];
980 fn frame_uni~cache : array(uint16, [#30]) :=
981 array(uint16, [#30]).[
982 #2591, #2592, #2593, #2502, #2524, #2561, #2562, #2556,
983 #2555, #2563, #2551, #2557, #255D, #255C, #255B, #2510,
984 #2514, #2534, #252C, #251C, #2500, #253C, #255E, #255F,
985 #255A, #2554, #2569, #2566, #2560, #2550, #256C, #2567,
986 #2568, #2564, #2565, #2559, #2558, #2552, #2553, #256B,
987 #256A, #2518, #250C, #2588, #2584, #258C, #2590, #2580,
988 ];
990 fn frame_to_uni~cache(frame : uint16, frame_fallback : bool) : char
991 [
992 var fd := frame_desc;
993 if frame_fallback then [
994 if (frame and #2222) <> 0 and (frame and #1111) <> 0 then [
995 frame and= #eeee;
996 ]
997 ]
998 for i := 0 to #30 do [
999 if fd[i] = frame then
1000 return frame_uni[i];
1001 ]
1002 return -1;
1003 ]
1005 fn curses_hline(curs : curses, x1 : int, x2 : int, y : int, width : int) : curses
1006 [
1007 x1 += curs.xo;
1008 x2 += curs.xo;
1009 y += curs.yo;
1010 if width <> 1, width <> 2 then
1011 return curs;
1012 var left_line := width shl 4;
1013 var right_line := width shl 12;
1014 var full_line := left_line or right_line;
1015 if y >= curs.scissors.y1, y < curs.scissors.y2 then [
1016 x1 := max(x1, curs.scissors.x1);
1017 x2 := min(x2, curs.scissors.x2);
1018 var new_ch := frame_to_uni(full_line, curs.frame_fallback);
1019 for i := x1 to x2 do [
1020 curs.buffer[y, i] := cchar.[ ch : new_ch, fgcolor : curs.fgcolor, bgcolor : curs.bgcolor, attrib : curs.attributes ];
1021 curs.lines_redraw bts= y;
1022 ]
1023 ]
1024 return curs;
1025 ]
1027 fn curses_vline(curs : curses, x : int, y1 : int, y2 : int, width : int) : curses
1028 [
1029 x += curs.xo;
1030 y1 += curs.yo;
1031 y2 += curs.yo;
1032 if width <> 1, width <> 2 then
1033 return curs;
1034 var up_line := width shl 8;
1035 var down_line := width;
1036 var full_line := up_line or down_line;
1037 if x >= curs.scissors.x1, x < curs.scissors.x2 then [
1038 y1 := max(y1, curs.scissors.y1);
1039 y2 := min(y2, curs.scissors.y2);
1040 var new_ch := frame_to_uni(full_line, curs.frame_fallback);
1041 for j := y1 to y2 do [
1042 curs.buffer[j, x] := cchar.[ ch : new_ch, fgcolor : curs.fgcolor, bgcolor : curs.bgcolor, attrib : curs.attributes ];
1043 curs.lines_redraw bts= j;
1044 ]
1045 ]
1046 return curs;
1047 ]
1049 fn curses_box(implicit curs : curses, x1 x2 y1 y2 : int, width : int) : curses
1050 [
1051 if width <> 1, width <> 2 then
1052 return;
1053 if x1 >= x2 or y1 >= y2 then
1054 return;
1055 curses_hline(x1 + 1, x2, y1, width);
1056 curses_hline(x1 + 1, x2, y2, width);
1057 curses_vline(x1, y1 + 1, y2, width);
1058 curses_vline(x2, y1 + 1, y2, width);
1059 var ech11 := frame_to_uni(#0110 * width, curs.frame_fallback);
1060 var ech12 := frame_to_uni(#1100 * width, curs.frame_fallback);
1061 var ech21 := frame_to_uni(#0011 * width, curs.frame_fallback);
1062 var ech22 := frame_to_uni(#1001 * width, curs.frame_fallback);
1063 curses_set_char(x1, y1, ech11);
1064 curses_set_char(x2, y1, ech12);
1065 curses_set_char(x1, y2, ech21);
1066 curses_set_char(x2, y2, ech22);
1067 ]
1069 fn curses_frame(implicit curs : curses, x y : int, frame : uint16) : curses
1070 [
1071 curses_set_char(x, y, frame_to_uni(frame, curs.frame_fallback));
1072 ]
1074 fn flip_color(c : ccolor) : ccolor
1075 [
1076 if c < color_16_offset then
1077 return c and 7 xor 7;
1078 var r g b : int;
1079 if c < color_216_offset then [
1080 c -= color_16_offset;
1081 r, g, b := default_16_rgb(c);
1082 r := r * 5 div 1000;
1083 g := g * 5 div 1000;
1084 b := b * 5 div 1000;
1085 ] else [
1086 c -= color_216_offset;
1087 r := c div 36;
1088 g := c div 6 mod 6;
1089 b := c mod 6;
1090 ]
1091 r := 5 - r;
1092 g := 5 - g;
1093 b := 5 - b;
1094 return color_216_offset + r * 36 + g * 6 + b;
1095 ]
1097 fn is_valid_pair(const curs : curses, x y : int) : bool
1098 [
1099 if x < 0 then
1100 return false;
1101 if x + 1 >= curs.x then
1102 return false;
1103 var ch1 := curs.buffer[y, x];
1104 var ch2 := curs.buffer[y, x + 1];
1105 if (ch1.attrib and curses_left_wide) <> 0,
1106 (ch2.attrib and curses_right_wide) <> 0,
1107 ch1.ch = ch2.ch then
1108 return true;
1109 return false;
1110 ]
1112 fn curses_load_buffer~inline(implicit curs : curses, x y : int) : cchar
1113 [
1114 var n := curs.buffer[y, x];
1115 if curs.mouse_visible, y = curs.mouse_y then
1116 if x = curs.mouse_x then
1117 goto flip;
1118 else if x = curs.mouse_x - 1, (n.attrib and curses_left_wide) <> 0, is_valid_pair(x, y) then
1119 goto flip;
1120 return n;
1121 flip:
1122 n.fgcolor := flip_color(n.fgcolor);
1123 n.bgcolor := flip_color(n.bgcolor);
1124 return n;
1125 ]
1127 fn curses_packet_attribute~inline(c : cchar) : int32
1128 [
1129 var fgcolor : int32 := c.fgcolor;
1130 var bgcolor : int32 := c.bgcolor;
1131 return (fgcolor and 4) shr 2 or (c.fgcolor and 10) or (c.fgcolor and 1) shl 2 or
1132 (bgcolor and 4) shl 2 or (c.bgcolor and 10) shl 4 or (c.bgcolor and 1) shl 6;
1133 ]
1135 fn curses_char_to_packet~inline(implicit curs : curses, n : cchar) : packets
1136 [
1137 var n_ch := n.ch;
1138 if locale_get_charset(curs.loc).mode is eightbit then [
1139 var stl := string_to_locale(curs.loc, [ n_ch ]);
1140 if len(stl) = 0 then
1141 n_ch := '*';
1142 else
1143 n_ch := stl[0];
1144 ] else [
1145 n_ch := char_to_unicode(n_ch);
1146 ]
1147 return packets.[ n_ch, curses_packet_attribute(n) ];
1148 ]
1150 fn curses_update_char(implicit curs : curses, x y : int) : (curses, bytes, packets, int)
1151 [
1152 var str := "";
1153 var s : bytes;
1154 var pkt : packets;
1156 if not curs.have_right_bottom, y = curs.y - 1 then
1157 if x = curs.x - 1 then
1158 return "", packets.[], 1;
1159 else if x = curs.x - 2, is_valid_pair(x, y) then
1160 return "", packets.[], 1;
1162 var n := curses_load_buffer(curs, x, y);
1163 if (n.attrib and curses_right_wide) <> 0, is_valid_pair(x - 1, y) then [
1164 x -= 1;
1165 n := curses_load_buffer(curs, x, y);
1166 ]
1167 curs.back_buffer[y, x] := n;
1169 if curs.packet_mode then [
1170 var pstr := packets.[ 2, x, y, 1, ] + curses_char_to_packet(n);
1171 return "", pstr, 1;
1172 ]
1174 if not locale_validate_character(curs.loc, n.ch) or curs.prefer_acs_map, n.ch < #110000 then [
1175 var a := curs.acs_map[n.ch];
1176 if a > 0 then [
1177 var b := curs.altcharset_map[a];
1178 if b > 0 then [
1179 //eval debug("remap: " + ntos(n.ch) + " -> " + ntos(a) + " -> " + ntos(b));
1180 n.ch := b;
1181 n.attrib or= curses_acs;
1182 ]
1183 ]
1184 ]
1186 s, pkt := curses_string_setpos(x, y);
1187 str += s;
1188 s := curses_string_color(n.fgcolor, n.bgcolor, n.attrib);
1189 str += s;
1191 var width := 1;
1192 if (n.attrib and (curses_left_wide or curses_right_wide)) <> 0 then [
1193 if is_valid_pair(x, y) then [
1194 width := 2;
1195 curs.back_buffer[y, x + 1] := curs.buffer[y, x + 1];
1196 goto ok_wide;
1197 ] else [
1198 n.ch := ' ';
1199 ]
1200 ]
1202 ok_wide:
1203 if (n.attrib and curses_acs) <> 0 then [
1204 str +<= n.ch;
1205 ] else if curs.tilde_glitch, n.ch = '~' then [
1206 str +<= '.';
1207 ] else if n.ch < #20 or n.ch = #7f then [
1208 str +<= '.';
1209 ] else if n.ch < #7f then [
1210 str +<= n.ch;
1211 ] else [
1212 str += string_to_locale(curs.loc, [ n.ch ]);
1213 ]
1214 curs.current_cx += width;
1215 return str, packets.[], width;
1216 ]
1218 fn curses_finish_update(implicit curs : curses) : (curses, bytes, packets)
1219 [
1220 var str := "";
1221 var pstr := packets.[];
1222 var s : bytes;
1223 var pkt : packets;
1224 var x, y := curs.cx, curs.cy;
1225 var cv := true;
1226 if x < 0 or x >= curs.x or y < 0 or y >= curs.y then [
1227 x := select(curs.x > 0, 0, curs.x - 1);
1228 y := select(curs.y > 0, 0, curs.y - 1);
1229 cv := false;
1230 ]
1231 if cv <> curs.cursor_visible then [
1232 if curs.packet_mode then [
1233 pkt := packets.[ 4, select(cv, 0, 1) ];
1234 pstr += pkt;
1235 ] else [
1236 if cv then [
1237 curs.tc, s := termcap_substitute_string(curs.tc, tc_s_cursor_normal, empty(tc_param));
1238 str += s;
1239 ] else [
1240 curs.tc, s := termcap_substitute_string(curs.tc, tc_s_cursor_invisible, empty(tc_param));
1241 str += s;
1242 ]
1243 ]
1244 curs.cursor_visible := cv;
1245 ]
1246 s, pkt := curses_string_setpos(x, y);
1247 str += s;
1248 pstr += pkt;
1249 if not curs.packet_mode then [
1250 s := curses_string_color(7, 0, curs.current_attributes);
1251 str += s;
1252 ]
1253 return str, pstr;
1254 ]
1256 fn curses_update_string(implicit curs : curses) : (curses, bytes, packets)
1257 [
1258 var str := "";
1259 var pstr := packets.[];
1260 var s : bytes;
1261 var pkt : packets;
1262 for j := 0 to curs.y do [
1263 if not curs.lines_redraw bt j then
1264 continue;
1265 if curs.packet_mode then [
1266 var first := -1;
1267 var last := -1;
1268 for i := 0 to curs.x do [
1269 var ch := curses_load_buffer(i, j);
1270 var cb := curs.back_buffer[j, i];
1271 if ch <> cb then [
1272 if first = -1 then
1273 first := i;
1274 last := i + 1;
1275 ]
1276 ]
1277 if first >= 0 then [
1278 pstr += packets.[ 2, first, j, last - first ];
1279 for i := first to last do [
1280 var ch := curses_load_buffer(i, j);
1281 curs.back_buffer[j, i] := ch;
1282 pstr += curses_char_to_packet(ch);
1283 ]
1284 ]
1285 ] else [
1286 for i := 0 to curs.x do [
1287 var ch := curses_load_buffer(i, j);
1288 var cb := curs.back_buffer[j, i];
1289 if ch <> cb then [
1290 if (ch.attrib and curses_right_wide) <> 0, is_valid_pair(i - 1, j) then
1291 i -= 1;
1292 var width : int;
1293 s, pkt, width := curses_update_char~inline(i, j);
1294 str += s;
1295 pstr += pkt;
1296 i += width - 1;
1297 ]
1298 ]
1299 ]
1300 ]
1301 s, pkt := curses_finish_update();
1302 str += s;
1303 pstr += pkt;
1304 curs.lines_redraw := 0;
1305 return str, pstr;
1306 ]
1308 fn curses_update(implicit w : world, implicit curs : curses) : (world, curses)
1309 [
1310 var str, pstr := curses_update_string(curs);
1311 if curs.packet_mode then [
1312 pstr +<= 1;
1313 write_console_packet(curs.h[1], pstr);
1314 ] else [
1315 write(curs.h[1], str);
1316 ]
1317 ]
1319 fn curses_hide_mouse(implicit curs : curses) : (curses, bytes, packets)
1320 [
1321 if curs.mouse_visible then [
1322 curs.mouse_visible := false;
1323 var s, pstr, width := curses_update_char(curs.mouse_x, curs.mouse_y);
1324 return s, pstr;
1325 ]
1326 return "", packets.[];
1327 ]
1329 fn curses_update_soft_cursor(implicit w : world, implicit curs : curses, ev : event) : (world, curses)
1330 [
1331 var width : int;
1332 var str := "";
1333 var pstr := packets.[];
1334 var s : bytes;
1335 var pkt : packets;
1336 s, pkt := curses_hide_mouse();
1337 str += s;
1338 pstr += pkt;
1339 var mx := max(min(ev.mouse.x, curs.x - 1), 0);
1340 var my := max(min(ev.mouse.y, curs.y - 1), 0);
1341 curs.mouse_visible := true;
1342 curs.mouse_x := mx;
1343 curs.mouse_y := my;
1344 s, pkt, width := curses_update_char(mx, my);
1345 str += s;
1346 pstr += pkt;
1347 if curs.packet_mode then [
1348 if len_greater_than(pstr, 0) then [
1349 s, pkt := curses_finish_update();
1350 str += s;
1351 pstr += pkt;
1352 pstr +<= 1;
1353 write_console_packet(curs.h[1], pstr);
1354 ]
1355 ] else [
1356 if len_greater_than(str, 0) then [
1357 s, pkt := curses_finish_update();
1358 str += s;
1359 write(curs.h[1], str);
1360 ]
1361 ]
1362 ]
1364 fn curses_get_event(implicit w : world, implicit curs : curses, t : type, altmq : msgqueue(t)) : (world, curses, event)
1365 [
1366 process_event_buffer:
1367 var ev : event;
1368 if len_greater_than(curs.event_buffer, 0) then [
1369 ev := curs.event_buffer[0];
1370 curs.event_buffer := curs.event_buffer[1 .. ];
1371 goto process_ev;
1372 ]
1374 if curs.lines_redraw <> 0 then [
1375 curses_update();
1376 ]
1378 var wait_for := msgqueue_any(curs.q, altmq);
1379 if wait_for then
1380 return event.altmq;
1382 pop_next:
1383 var tag : int;
1384 tag, ev := msgqueue_receive_nonblock(curs.q);
1385 if is_exception tag then
1386 goto process_event_buffer;
1387 if len_greater_than(curs.event_buffer, 0) then [
1388 var last := curs.event_buffer[len(curs.event_buffer) - 1];
1389 if ev is mouse, last is mouse, last.mouse.prev_buttons = last.mouse.buttons then
1390 curs.event_buffer := curs.event_buffer[ .. len(curs.event_buffer) - 1];
1391 if ev is keyboard, last is keyboard, ev.keyboard.key = last.keyboard.key, ev.keyboard.flags = last.keyboard.flags then [
1392 ev.keyboard.rep += last.keyboard.rep;
1393 curs.event_buffer[len(curs.event_buffer) - 1].keyboard.rep := 0;
1394 ]
1395 ]
1396 curs.event_buffer +<= ev;
1397 goto pop_next;
1399 process_ev:
1400 if ev is mouse, ev.mouse.soft_cursor then [
1401 curses_update_soft_cursor(ev);
1402 ]
1403 if ev is resize then [
1404 curses_resize(ev.resize.x, ev.resize.y);
1405 ]
1407 return ev;
1408 ]