From 095b747de46a07ec80cbcebb8556c79026c96286 Mon Sep 17 00:00:00 2001 From: David Declerck Date: Wed, 20 Nov 2024 11:55:16 +0100 Subject: [PATCH] Merge SVN 5057, 5058, 5059, 5062, 5063 --- cobc/ChangeLog | 5 + cobc/parser.y | 15 +- libcob/ChangeLog | 5 + libcob/screenio.c | 240 +++++++++++++++++++++-- tests/testsuite.src/run_manual_screen.at | 104 +++++++++- tests/testsuite.src/syn_screen.at | 2 +- 6 files changed, 339 insertions(+), 32 deletions(-) diff --git a/cobc/ChangeLog b/cobc/ChangeLog index e79b5e1cb..7968351dc 100644 --- a/cobc/ChangeLog +++ b/cobc/ChangeLog @@ -50,6 +50,11 @@ * typeck.c (cb_emit_sort_init): generate call to cob_file_sort_options * help.c (cobc_print_usage_dialect): extended -fregister help +2023-05-28 Simon Sobisch + + * parser.y: allow expressions for screen related clauses + COL, LINE, LINES, SIZE, COLOR + 2023-05-26 Simon Sobisch * parser.y, reserved.c: added RIGHTLINE - GC extension matching LEFLINE diff --git a/cobc/parser.y b/cobc/parser.y index ab91fd19a..bdb396b7e 100644 --- a/cobc/parser.y +++ b/cobc/parser.y @@ -11928,7 +11928,7 @@ at_line_column: &check_line_col_duplicate); if ((CB_LITERAL_P ($2) && cb_get_int ($2) == 0) || $2 == cb_zero) { - cb_verify (cb_accept_display_extensions, "COLUMN 0"); + cb_verify_x ($2, cb_accept_display_extensions, "COLUMN 0"); } if (!line_column) { @@ -11950,17 +11950,15 @@ at_line_column: ; line_number: - LINE _number num_id_or_lit + LINE _number exp { - /* FIXME: arithmetic expression should be possible, too, only numeric literals! */ $$ = $3; } ; column_number: - column_or_col_or_position_or_pos _number num_id_or_lit + column_or_col_or_position_or_pos _number exp { - /* FIXME: arithmetic expression should be possible, too, only numeric literals! */ $$ = $3; } ; @@ -12001,9 +11999,8 @@ accp_attr: check_repeated ("BLINK", SYN_CLAUSE_8, &check_duplicate); set_dispattr (COB_SCREEN_BLINK); } -| COLOR _is num_id_or_lit +| COLOR _is exp { - /* FIXME: arithmetic expression should be possible, too! */ check_repeated ("COLOR", SYN_CLAUSE_30, &check_duplicate); set_attribs (0, NULL, NULL, NULL, NULL, NULL, NULL, NULL, $3, NULL); } @@ -13549,7 +13546,7 @@ display_window_clauses: SCREEN is optional(=implied) for ERASE here */ display_window_clause: pop_up_or_handle /* DISPLAY WINDOW actually only takes POP-UP */ -| LINES num_id_or_lit +| LINES exp { /* TODO: store */ } @@ -13715,7 +13712,7 @@ disp_attr: check_repeated ("REVERSE-VIDEO", SYN_CLAUSE_14, &check_duplicate); set_dispattr (COB_SCREEN_REVERSE); } -| SIZE _is num_id_or_lit +| SIZE _is exp { check_repeated ("SIZE", SYN_CLAUSE_15, &check_duplicate); set_attribs (0, NULL, NULL, NULL, NULL, NULL, $3, NULL, NULL, NULL); diff --git a/libcob/ChangeLog b/libcob/ChangeLog index d6ee8cd47..48949b8cb 100644 --- a/libcob/ChangeLog +++ b/libcob/ChangeLog @@ -87,6 +87,11 @@ * common.h: added COB_SCREEN_RIGHTLINE, GC extension matching LEFTLINE * screenio.c (cob_screen_attr): place curses extensions within #ifdef + * screenio.c (cob_screen_attr): return attr which may be adjusted by + parsing COLOR / CONTROL attributes + * screenio.c (cob_addnstr_graph): variant of cob_addnstr for CONTROL + GRAPHICS that outputs each character / WACS symbols separately + * screenio.c (cob_screen_puts, field_display): handle COB_SCREEN_GRAPHICS 2023-05-25 Chuck Haatvedt diff --git a/libcob/screenio.c b/libcob/screenio.c index 3eaea13e7..da1211cda 100644 --- a/libcob/screenio.c +++ b/libcob/screenio.c @@ -80,6 +80,18 @@ #endif #endif +/* work around broken system headers or compile flags defining + NCURSES_WIDECHAR / PDC_WIDE but not including the actual definitions */ +#if defined (NCURSES_WIDECHAR) && !defined (WACS_HLINE) +#undef NCURSES_WIDECHAR +#endif +#if defined (PDC_WIDE) && !defined (WACS_HLINE) +#undef PDC_WIDE +#endif +#if defined (NCURSES_WIDECHAR) || defined (PDC_WIDE) +#define WITH_WIDE_FUNCTIONS +#endif + /* include internal and external libcob definitions, forcing exports */ #define COB_LIB_EXPIMP #include "coblocal.h" @@ -367,7 +379,7 @@ cob_get_color_pair (const short fg_color, const short bg_color) { /* some implementations (especially PDCursesMod 64-bit CHTYPE) provide more color pairs than we currently support, limit appropriate */ - const short max_clr_pairs = COLOR_PAIRS < SHRT_MAX ? COLOR_PAIRS : SHRT_MAX - 1; + const short max_clr_pairs = COLOR_PAIRS < SHRT_MAX ? (short)COLOR_PAIRS : SHRT_MAX - 1; short color_pair_number; short fg_defined, bg_defined; @@ -875,7 +887,7 @@ adjust_attr_from_control_field (cob_flags_t *attr, cob_field *control, } } -static void +static cob_flags_t cob_screen_attr (cob_field *fgc, cob_field *bgc, cob_flags_t attr, cob_field *control, cob_field *color, const enum screen_statement stmt) { @@ -983,6 +995,7 @@ cob_screen_attr (cob_field *fgc, cob_field *bgc, cob_flags_t attr, if (attr & COB_SCREEN_BELL) { cob_beep (); } + return attr; } static int @@ -1079,7 +1092,7 @@ cob_screen_init (void) { /* some implementations (especially PDCursesMod 64-bit CHTYPE) provide more color pairs than we currently support, limit appropriate */ - const short max_clr_pairs = COLOR_PAIRS < SHRT_MAX ? COLOR_PAIRS : SHRT_MAX - 1; + const short max_clr_pairs = COLOR_PAIRS < SHRT_MAX ? (short)COLOR_PAIRS : SHRT_MAX - 1; short color_pair_number; for (color_pair_number = 2; color_pair_number < max_clr_pairs; ++color_pair_number) { @@ -1417,6 +1430,199 @@ cob_addnstr (const char *data, const int size) addnstr (data, size); } +/* variant of cob_addnstr that outputs each character separately, + replacing special values by WACS symbols for CONTROL GRAPHICS */ +static void +cob_addnstr_graph (const char *data, const int size) +{ + int count; + raise_ec_on_truncation (size); + + for (count = 0; count < size; count++) { + const char c = *data++; + switch (c) { + case 'j': /* lower-right corner */ +#if defined (WITH_WIDE_FUNCTIONS) + add_wch (WACS_LRCORNER); +#else + addch (ACS_LRCORNER); +#endif + break; + case 'J': /* lower-right corner, double */ +#if defined (WACS_D_LRCORNER) && defined (WITH_WIDE_FUNCTIONS) + add_wch (WACS_D_LRCORNER); +#elif defined (ACS_D_LRCORNER) + addch (ACS_D_LRCORNER); +#else + addch ((const chtype)'+'); +#endif + break; + case 'k': /* upper-right corner */ +#if defined (WITH_WIDE_FUNCTIONS) + add_wch (WACS_URCORNER); +#else + addch (ACS_URCORNER); +#endif + break; + case 'K': /* upper-right corner, double */ +#if defined (WACS_D_URCORNER) && defined (WITH_WIDE_FUNCTIONS) + add_wch (WACS_D_URCORNER); +#elif defined (ACS_D_URCORNER) + addch (ACS_D_URCORNER); +#else + addch ((const chtype)'+'); +#endif + break; + case 'm': /* lower-left corner */ +#if defined (WITH_WIDE_FUNCTIONS) + add_wch (WACS_LLCORNER); +#else + addch (ACS_LLCORNER); +#endif + break; + case 'M': /* lower-left corner, double */ +#if defined (WACS_D_LLCORNER) && defined (WITH_WIDE_FUNCTIONS) + add_wch (WACS_D_LLCORNER); +#elif defined (ACS_D_LLCORNER) + addch (ACS_D_LLCORNER); +#else + addch ((const chtype)'+'); +#endif + break; + case 'l': /* upper-left corner */ +#if defined (WITH_WIDE_FUNCTIONS) + add_wch (WACS_ULCORNER); +#else + addch (ACS_ULCORNER); +#endif + break; + case 'L': /* upper-left corner, double */ +#if defined (WACS_D_ULCORNER) && defined (WITH_WIDE_FUNCTIONS) + add_wch (WACS_D_ULCORNER); +#elif defined (ACS_D_ULCORNER) + addch (ACS_D_ULCORNER); +#else + addch ((const chtype)'+'); +#endif + break; + case 'n': /* plus */ +#if defined (WITH_WIDE_FUNCTIONS) + add_wch (WACS_PLUS); +#else + addch (ACS_PLUS); +#endif + break; + case 'N': /* plus, double */ +#if defined (WACS_D_PLUS) && defined (WITH_WIDE_FUNCTIONS) + add_wch (WACS_D_PLUS); +#elif defined (ACS_D_PLUS) + addch (ACS_D_PLUS); +#else + addch ((const chtype)'+'); +#endif + break; + case 'q': /* horizontal line */ +#if defined (WITH_WIDE_FUNCTIONS) + add_wch (WACS_HLINE); +#else + addch (ACS_HLINE); +#endif + break; + case 'Q': /* horizontal line, double */ +#if defined (WACS_D_HLINE) && defined (WITH_WIDE_FUNCTIONS) + add_wch (WACS_D_HLINE); +#elif defined (ACS_D_HLINE) + addch (ACS_D_HLINE); +#else + addch ((const chtype)'-'); +#endif + break; + case 'x': /* vertical line */ +#if defined (WITH_WIDE_FUNCTIONS) + add_wch (WACS_VLINE); +#else + addch (ACS_VLINE); +#endif + break; + case 'X': /* vertical line, double */ +#if defined (WACS_D_VLINE) && defined (WITH_WIDE_FUNCTIONS) + add_wch (WACS_D_VLINE); +#elif defined (ACS_D_VLINE) + addch (ACS_D_VLINE); +#else + addch ((const chtype)'|'); +#endif + break; + case 't': /* left tee */ +#if defined (WITH_WIDE_FUNCTIONS) + add_wch (WACS_LTEE); +#else + addch (ACS_LTEE); +#endif + break; + case 'T': /* left tee , double */ +#if defined (WACS_D_LTEE) && defined (WITH_WIDE_FUNCTIONS) + add_wch (WACS_D_LTEE); +#elif defined (ACS_D_LTEE) + addch (ACS_D_LTEE); +#else + addch ((const chtype)'+'); +#endif + break; + case 'u': /* right tee */ +#if defined (WITH_WIDE_FUNCTIONS) + add_wch (WACS_RTEE); +#else + addch (ACS_RTEE); +#endif + break; + case 'U': /* right tee , double */ +#if defined (WACS_D_RTEE) && defined (WITH_WIDE_FUNCTIONS) + add_wch (WACS_D_RTEE); +#elif defined (ACS_D_RTEE) + addch (ACS_D_RTEE); +#else + addch ((const chtype)'+'); +#endif + break; + case 'v': /* bottom tee */ +#if defined (WITH_WIDE_FUNCTIONS) + add_wch (WACS_BTEE); +#else + addch (ACS_BTEE); +#endif + break; + case 'V': /* bottom tee , double */ +#if defined (WACS_D_BTEE) && defined (WITH_WIDE_FUNCTIONS) + add_wch (WACS_D_BTEE); +#elif defined (ACS_D_BTEE) + addch (ACS_D_BTEE); +#else + addch ((const chtype)'+'); +#endif + break; + case 'w': /* top tee */ +#if defined (WITH_WIDE_FUNCTIONS) + add_wch (WACS_TTEE); +#else + addch (ACS_TTEE); +#endif + break; + case 'W': /* top tee , double */ +#if defined (WACS_D_TTEE) && defined (WITH_WIDE_FUNCTIONS) + add_wch (WACS_D_TTEE); +#elif defined (ACS_D_TTEE) + addch (ACS_D_TTEE); +#else + addch ((const chtype)'+'); +#endif + break; + default: + addch ((const chtype)c); + } + } +} + static void cob_addch (const chtype c) { @@ -1591,7 +1797,6 @@ cob_screen_puts (cob_screen *s, cob_field *f, const cob_u32_t is_input, #if 0 /* RXWRXW - Attr */ cob_screen_attr (s->foreg, s->backg, s->attr, NULL, NULL, stmt); #endif - /* TODO: replace character by special "char" if s->attr & GRPAHICS */ if (s->attr & COB_SCREEN_INPUT) { cob_screen_attr (s->foreg, s->backg, s->attr, NULL, NULL, stmt); if (s->prompt) { @@ -1611,8 +1816,12 @@ cob_screen_puts (cob_screen *s, cob_field *f, const cob_u32_t is_input, } } } else if (!is_input) { - cob_screen_attr (s->foreg, s->backg, s->attr, NULL, NULL, stmt); - cob_addnstr ((char *)f->data, (int)f->size); + const cob_flags_t attr = cob_screen_attr (s->foreg, s->backg, s->attr, NULL, NULL, stmt); + if (attr & COB_SCREEN_GRAPHICS) { + cob_addnstr_graph ((char *)f->data, (int)f->size); + } else { + cob_addnstr ((char *)f->data, (int)f->size); + } } else { column += (int)f->size; cob_move_cursor (line, column); @@ -3135,7 +3344,7 @@ field_display (cob_field *f, cob_flags_t fattr, const int line, const int column pending_accept = 1; } - cob_screen_attr (fgc, bgc, fattr, control, color, DISPLAY_STATEMENT); + fattr = cob_screen_attr (fgc, bgc, fattr, control, color, DISPLAY_STATEMENT); if (!(fattr & COB_SCREEN_NO_DISP)) { /* figurative constant and WITH SIZE repeats the literal */ @@ -3152,8 +3361,11 @@ field_display (cob_field *f, cob_flags_t fattr, const int line, const int column cob_addnstr ((char *)f->data, size_display % fsize); } } else { - /* TODO: replace character by special "char" if f->attr & GRPAHICS */ - cob_addnstr ((char *)f->data, cob_min_int (size_display, fsize)); + if (fattr & COB_SCREEN_GRAPHICS) { + cob_addnstr_graph ((char *)f->data, cob_min_int (size_display, fsize)); + } else { + cob_addnstr ((char *)f->data, cob_min_int (size_display, fsize)); + } if (size_display > fsize) { /* WITH SIZE larger than field displays trailing spaces */ cob_addnch (size_display - fsize, COB_CH_SP); @@ -3176,7 +3388,7 @@ field_display (cob_field *f, cob_flags_t fattr, const int line, const int column static void field_accept (cob_field *f, cob_flags_t fattr, const int sline, const int scolumn, cob_field *fgc, cob_field *bgc, cob_field *fscroll, cob_field *ftimeout, - cob_field *prompt, cob_field *size_is, cob_field *cursor, + cob_field *prompt, cob_field *size_is, cob_field *cursor, cob_field *control, cob_field *color) { unsigned char *p; @@ -3875,8 +4087,6 @@ field_accept (cob_field *f, cob_flags_t fattr, const int sline, const int scolum if (cursor) { /* horizontal position stored in CURSOR clause */ if (!COB_FIELD_CONSTANT (cursor)) { - int cline; - int ccolumn; getyx (stdscr, cline, ccolumn); if (cline == sline) { cob_set_int (cursor, ccolumn + 1 - scolumn); @@ -4568,8 +4778,8 @@ cob_sys_get_csr_pos (unsigned char *fld) /* group with sizes up to 64k (2 * 2 bytes) as used by Fujitsu (likely with a limit of 254 which does _not_ apply to GnuCOBOL) */ - const cob_u16_t bline = cline; - const cob_u16_t bcol = ccol; + const cob_u16_t bline = (cob_u16_t) cline; + const cob_u16_t bcol = (cob_u16_t) ccol; memcpy (f->data, &bline, 2); memcpy (f->data + 2, &bcol, 2); } else { @@ -4696,6 +4906,8 @@ cob_sys_set_scr_size (unsigned char *line, unsigned char *col) init_cob_screen_if_needed (); #if !defined (WITH_EXTENDED_SCREENIO) || !defined (HAVE_RESIZE_TERM) + COB_UNUSED (line); + COB_UNUSED (col); cob_set_exception (COB_EC_IMP_FEATURE_DISABLED); return -1; #else diff --git a/tests/testsuite.src/run_manual_screen.at b/tests/testsuite.src/run_manual_screen.at index 89cc70394..8394e09e6 100644 --- a/tests/testsuite.src/run_manual_screen.at +++ b/tests/testsuite.src/run_manual_screen.at @@ -1217,8 +1217,8 @@ AT_CLEANUP AT_SETUP([field BACKGROUND- / FOREGROUND-COLOUR via CONTROL]) -AT_KEYWORDS([BACKGROUND-COLOR BACKGROUND-COLOUR FOREGROUND-COLOR -COLOR COLOUR REVERSED HIGHLIGHT BLINK]) +AT_KEYWORDS([screen DISPLAY REVERSED HIGHLIGHT BLINK COLOR +BACKGROUND-COLOR BACKGROUND-COLOUR FOREGROUND-COLOR COLOUR]) AT_SKIP_IF([test "$COB_HAS_CURSES" != "yes"]) @@ -1278,14 +1278,25 @@ AT_DATA([prog.cob], [[ PROCEDURE DIVISION. testme. MOVE 2 TO LIN - DISPLAY scr1 AT LINE LIN COL 2 - CONTROL "LEFTLINE OVERLINE RIGHTLINE" + DISPLAY scr1 ( 1:1) AT LINE LIN COL 2 + CONTROL "LEFTLINE OVERLINE" + DISPLAY scr1 ( 2:) AT LINE LIN COL 2 + 1 + CONTROL "OVERLINE" + DISPLAY scr1 (75:) AT LINE LIN COL 2 + 75 + CONTROL "OVERLINE RIGHTLINE" ADD 1 TO LIN - DISPLAY scr2 AT LINE LIN COL 2 - CONTROL "LEFTLINE RIGHTLINE" + DISPLAY scr2 ( 1:1) AT LINE LIN COL 2 + CONTROL "LEFTLINE" + DISPLAY scr2 ( 2:) AT LINE LIN COL 2 + 1 + DISPLAY scr2 (75:) AT LINE LIN COL 2 + 75 + CONTROL "RIGHTLINE" ADD 1 TO LIN - DISPLAY scr3 AT LINE LIN COL 2 - CONTROL "LEFTLINE UNDERLINE RIGHTLINE" + DISPLAY scr3 ( 1:1) AT LINE LIN COL 2 + CONTROL "LEFTLINE UNDERLINE" + DISPLAY scr3 ( 2:) AT LINE LIN COL 2 + 1 + CONTROL "UNDERLINE" + DISPLAY scr3 (75:) AT LINE LIN COL 2 + 75 + CONTROL "UNDERLINE RIGHTLINE" * ADD 2 TO LIN PERFORM dspcol @@ -1336,6 +1347,83 @@ MANUAL_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) AT_CLEANUP +AT_SETUP([line draw characters via CONTROL GRAPHICS]) +AT_KEYWORDS([screen DISPLAY]) + +AT_SKIP_IF([test "$COB_HAS_CURSES" != "yes"]) + +AT_DATA([prog.cob], [[ + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 success-flag PIC X VALUE 'Y'. + 88 success VALUE 'Y', 'y'. + + 77 LIN-START PIC 99 COMP-5. + 77 LIN PIC 99 COMP-5. + + 01 scr1 PIC X(75) + VALUE 'Enter "y" if you see line draw characters. ' + & 'The first set (single/double)'. + 01 scr2 PIC X(75) + VALUE 'uses HIGHLIGHT, the second uses ' + & 'LOWLIGHT, BLINK and MAGENTA.'. + + 01 graphcontrol PIC X(50) VALUE 'HIGH, GRAPHICS'. + + PROCEDURE DIVISION. + testme. + MOVE 2 TO LIN + DISPLAY scr1 AT LINE LIN COL 2 + ADD 1 TO LIN + DISPLAY scr2 AT LINE LIN COL 2 + * + MOVE 5 TO LIN-START + PERFORM dspcol + MOVE 12 TO LIN-START + MOVE "LOW BLINK FCOLOR=MAGENTA GRAPHICS" TO graphcontrol + PERFORM dspcol + * + ACCEPT success-flag AT 1801 UPDATE REQUIRED + + IF success AND COB-CRT-STATUS = 0 + GOBACK RETURNING 0 + ELSE + GOBACK RETURNING 1. + + dspcol. + * Single-line graphics + MOVE LIN-START TO LIN + DISPLAY "lqqqqwqqqqk" LINE LIN COL 05, CONTROL graphcontrol. + ADD 1 TO LIN + DISPLAY "x x x" LINE LIN COL 05, CONTROL graphcontrol. + ADD 1 TO LIN + DISPLAY "tqqqqnqqqqu" LINE LIN COL 05, CONTROL graphcontrol. + ADD 1 TO LIN + DISPLAY "x x x" LINE LIN COL 05, CONTROL graphcontrol. + ADD 1 TO LIN + DISPLAY "mqqqqvqqqqj" LINE LIN COL 05, CONTROL graphcontrol. + ADD 1 TO LIN + * Double-line graphics + MOVE LIN-START TO LIN + DISPLAY "LQQQQWQQQQK" LINE LIN COL 20, CONTROL graphcontrol. + ADD 1 TO LIN + DISPLAY "X X X" LINE LIN COL 20, CONTROL graphcontrol. + ADD 1 TO LIN + DISPLAY "TQQQQNQQQQU" LINE LIN COL 20, CONTROL graphcontrol. + ADD 1 TO LIN + DISPLAY "X X X" LINE LIN COL 20, CONTROL graphcontrol. + ADD 1 TO LIN + DISPLAY "MQQQQVQQQQJ" LINE LIN COL 20, CONTROL graphcontrol. +]]) + +AT_CHECK([$COMPILE prog.cob], [0], [], []) +MANUAL_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) + +AT_CLEANUP + + AT_SETUP([BEEP]) AT_KEYWORDS([BELL FLASH]) diff --git a/tests/testsuite.src/syn_screen.at b/tests/testsuite.src/syn_screen.at index efb0c6d79..44e057355 100644 --- a/tests/testsuite.src/syn_screen.at +++ b/tests/testsuite.src/syn_screen.at @@ -812,7 +812,7 @@ prog.cob:10: error: syntax error, unexpected COL prog.cob:11: error: syntax error, unexpected COL, expecting Literal or [)] or Identifier prog.cob:12: error: syntax error, unexpected COL, expecting Literal or [)] or Identifier prog.cob:19: error: syntax error, unexpected COL -prog.cob:20: error: syntax error, unexpected COL, expecting Literal or Identifier or ZERO +prog.cob:20: error: syntax error, unexpected COL ]) AT_CHECK([$COMPILE_ONLY -fregister=LIN,COL prog.cob], [0], [], [])