1#!/usr/bin/env perl
2# $XTermId: report-sgr.pl,v 1.35 2019/07/21 21:55:49 tom Exp $
3# -----------------------------------------------------------------------------
4# this file is part of xterm
5#
6# Copyright 2018,2019 by Thomas E. Dickey
7#
8#                         All Rights Reserved
9#
10# Permission is hereby granted, free of charge, to any person obtaining a
11# copy of this software and associated documentation files (the
12# "Software"), to deal in the Software without restriction, including
13# without limitation the rights to use, copy, modify, merge, publish,
14# distribute, sublicense, and/or sell copies of the Software, and to
15# permit persons to whom the Software is furnished to do so, subject to
16# the following conditions:
17#
18# The above copyright notice and this permission notice shall be included
19# in all copies or substantial portions of the Software.
20#
21# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
22# OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
23# MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
24# IN NO EVENT SHALL THE ABOVE LISTED COPYRIGHT HOLDER(S) BE LIABLE FOR ANY
25# CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
26# TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
27# SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
28#
29# Except as contained in this notice, the name(s) of the above copyright
30# holders shall not be used in advertising or otherwise to promote the
31# sale, use or other dealings in this Software without prior written
32# authorization.
33# -----------------------------------------------------------------------------
34# Test the report-sgr option of xterm.
35
36# TODO: add "-8" option, for 8-bit controls
37
38use strict;
39use warnings;
40
41use Getopt::Long qw(:config auto_help no_ignore_case);
42use Pod::Usage;
43use Term::ReadKey;
44
45our ( $opt_colors, $opt_direct, $opt_help, $opt_man );
46
47our $csi = "\033[";
48our $osc = "\033]";
49our $st  = "\033\\";
50
51our @sgr_names = qw(
52  Normal
53  Bold
54  Faint
55  Italicized
56  Underlined
57  Blink
58  Fast-Blink
59  Inverse
60  Invisible
61  Crossed-Out
62);
63
64our ( $row_max, $col_max );
65our ( $mark,    $top_row );
66
67our $cur_sgr = 0;
68
69# indexed colors, e.g., "ANSI"
70our %indexed_f = qw ( default 1 c 7 );
71our %indexed_b = qw ( default 1 c 0 );
72
73# direct colors
74our %direct_f = qw ( default 0 r 255 g 0 b 0 );
75our %direct_b = qw ( default 0 r 0 g 0 b 255 );
76
77our $which_value = "video-attributes";
78our $which_color = "red";
79
80our ( $row_1st, $col_1st, $row_now, $col_now );
81
82sub beep() {
83    printf "\a";
84}
85
86sub cup($$) {
87    my $r = shift;
88    my $c = shift;
89    printf "%s%d;%dH", $csi, $r, $c;
90}
91
92sub el($) {
93    printf "%s%sK", $csi, $_[0];
94}
95
96sub ed($) {
97    printf "%s%sJ", $csi, $_[0];
98}
99
100sub sgr($) {
101    printf "%s%sm", $csi, $_[0];
102}
103
104sub same_rgb($$) {
105    my %c1     = %{ $_[0] };
106    my %c2     = %{ $_[1] };
107    my $result = 1;
108    $result = 0 if ( $c1{r} ne $c2{r} );
109    $result = 0 if ( $c1{g} ne $c2{g} );
110    $result = 0 if ( $c1{b} ne $c2{b} );
111    return $result;
112}
113
114sub color_name($) {
115    my $code = shift;
116    my $result;
117    if ($opt_direct) {
118        $result = $code;
119    }
120    else {
121        if ( $code < 0 ) {
122            $result = "default";
123        }
124        else {
125            $result = $code;
126        }
127    }
128    return $result;
129}
130
131sub color_code($$) {
132    my $isfg   = shift;
133    my $result = "";
134    my $base   = $isfg ? 30 : 40;
135    if ($opt_direct) {
136        $result = sprintf "%d:2", $base + 8;
137        if ($isfg) {
138            $result .= sprintf ":%d:%d:%d",    #
139              $direct_f{r},                    #
140              $direct_f{g},                    #
141              $direct_f{b};
142        }
143        else {
144            $result .= sprintf ":%d:%d:%d",    #
145              $direct_b{r},                    #
146              $direct_b{g},                    #
147              $direct_b{b};
148        }
149    }
150    else {
151        my %data = $isfg ? %indexed_f : %indexed_b;
152        if ( &is_default( \%data ) ) {
153            $result = $base + 9;
154        }
155        else {
156            if ( $opt_colors <= 16 ) {
157                $base += 60 if ( $data{c} >= 8 );
158                $result = $base + $data{c};
159            }
160            else {
161                $result = sprintf "%d:5:%d", $base + 8, $data{c};
162            }
163        }
164    }
165    return $result;
166}
167
168sub show_string($) {
169    my $value = $_[0];
170    my $n;
171
172    $value = "" unless $value;
173    my $result = "";
174    for ( $n = 0 ; $n < length($value) ; $n += 1 ) {
175        my $c = ord substr( $value, $n, 1 );
176        if ( $c == ord '\\' ) {
177            $result .= "\\\\";
178        }
179        elsif ( $c == 0x1b ) {
180            $result .= "\\E";
181        }
182        elsif ( $c == 0x7f ) {
183            $result .= "^?";
184        }
185        elsif ( $c == 32 ) {
186            $result .= "\\s";
187        }
188        elsif ( $c < 32 ) {
189            $result .= sprintf( "^%c", $c + 64 );
190        }
191        elsif ( $c > 128 ) {
192            $result .= sprintf( "\\%03o", $c );
193        }
194        else {
195            $result .= chr($c);
196        }
197    }
198
199    return $result;
200}
201
202sub get_reply($) {
203    my $command = $_[0];
204    my $reply   = "";
205
206    print STDOUT $command;
207    autoflush STDOUT 1;
208    while (1) {
209        my $test = ReadKey 0.02;
210        last if not defined $test;
211
212        $reply .= $test;
213    }
214    return $reply;
215}
216
217sub show_status() {
218    &cup( 1, 1 );
219    &el(2);
220    my $show = "";
221    my $parm = "";
222    if ($mark) {
223        my $r1 = ( $row_now > $row_1st ) ? $row_1st : $row_now;
224        my $r2 = ( $row_now < $row_1st ) ? $row_1st : $row_now;
225        my $c1 = ( $col_now > $col_1st ) ? $col_1st : $col_now;
226        my $c2 = ( $col_now < $col_1st ) ? $col_1st : $col_now;
227        $show = sprintf "[%d,%d] [%d,%d] ", $r1, $c1, $r2, $c2;
228        $parm = sprintf "%d;%d;%d;%d",      $r1, $c1, $r2, $c2;
229    }
230    else {
231        $show = sprintf "[%d,%d] ", $row_now, $col_now;
232        $parm = sprintf "%d;%d;%d;%d",    #
233          $row_now, $col_now,    #
234          $row_now, $col_now;
235    }
236    my $send = sprintf "%s%s#|", $csi, $parm;
237    printf "%s %s ", $show, &show_string($send);
238    &cup( $row_now, $col_now );
239    my $reply = &get_reply($send);
240    &cup( 2, 1 );
241    &el(2);
242    printf "read %s", &show_string($reply);
243    &cup( $row_now, $col_now );
244}
245
246sub toggle_default() {
247    if ($opt_direct) {
248        if ( $which_value =~ /^f/ ) {
249            $direct_f{default} = !$direct_f{default};
250        }
251        elsif ( $which_value =~ /^b/ ) {
252            $direct_b{default} = !$direct_b{default};
253        }
254        else {
255            &beep;
256        }
257    }
258    else {
259        if ( $which_value =~ /^f/ ) {
260            $indexed_f{default} = !$indexed_f{default};
261        }
262        elsif ( $which_value =~ /^b/ ) {
263            $indexed_b{default} = !$indexed_b{default};
264        }
265        else {
266            &beep;
267        }
268    }
269
270    &show_example;
271}
272
273sub is_default($) {
274    my $result = 0;
275    my %data   = %{ $_[0] };
276    $result = ( $data{default} != 0 );
277    return $result;
278}
279
280sub change_color($$) {
281    my $inc  = $_[0];
282    my %data = %{ $_[1] };
283    my $name = $_[2];
284    $data{$name} = ( $data{$name} + $opt_colors + $inc ) % $opt_colors;
285    return %data;
286}
287
288sub set_which_value($) {
289    $which_value = shift;
290    &show_example;
291}
292
293sub set_which_color($) {
294    $which_color = shift;
295    &show_example;
296}
297
298sub change_value($) {
299    my $inc = shift;
300    if ( $which_value =~ /^v/ ) {
301        $cur_sgr = ( $cur_sgr + 10 + $inc ) % 10;
302    }
303    elsif ( $which_value =~ /^f/ ) {
304        if ($opt_direct) {
305            %direct_f = &change_color( $inc, \%direct_f, "r" )
306              if ( $which_color =~ /^r/ );
307            %direct_f = &change_color( $inc, \%direct_f, "g" )
308              if ( $which_color =~ /^g/ );
309            %direct_f = &change_color( $inc, \%direct_f, "b" )
310              if ( $which_color =~ /^b/ );
311        }
312        else {
313            %indexed_f = &change_color( $inc, \%indexed_f, "c" );
314        }
315    }
316    elsif ( $which_value =~ /^b/ ) {
317        if ($opt_direct) {
318            %direct_b = &change_color( $inc, \%direct_b, "r" )
319              if ( $which_color =~ /^r/ );
320            %direct_b = &change_color( $inc, \%direct_b, "g" )
321              if ( $which_color =~ /^g/ );
322            %direct_b = &change_color( $inc, \%direct_b, "b" )
323              if ( $which_color =~ /^b/ );
324        }
325        else {
326            %indexed_b = &change_color( $inc, \%indexed_b, "c" );
327        }
328    }
329    &show_example;
330}
331
332sub show_example() {
333    &cup( $top_row, 1 );
334    my $init = "0";
335    if ($opt_direct) {
336        $init .= sprintf ";%s", &color_code(1);
337        $init .= sprintf ";%s", &color_code(0);
338    }
339    else {
340        $init .= sprintf ";%s", &color_code(1)
341          unless ( &is_default( \%indexed_f ) );
342        $init .= sprintf ";%s", &color_code(0)
343          unless ( &is_default( \%indexed_b ) );
344    }
345    &ed(0);
346    for my $n ( 0 .. 9 ) {
347        my $mode = $n;
348        $mode = $init if ( $n == 0 );
349        &cup( $n + $top_row, 1 );
350        if ($opt_direct) {
351            &sgr($init);
352            &sgr( &same_rgb( \%direct_f, \%direct_b ) ? "0" : $init );
353        }
354        else {
355            &sgr( $indexed_f{c} eq $indexed_b{c} ? "0" : $init );
356        }
357        printf "%s SGR %d: %-12s",    #
358          ( $cur_sgr == $n ) ? "-->" : "   ",    #
359          $n, $sgr_names[$n];
360        $mode .= ";$cur_sgr" unless ( $cur_sgr eq "0" );
361        &sgr($mode);
362        printf "%.55s",                          #
363          "abcdefghijklmnopqrstuvwxyz" .         #
364          "ABCDEFGHIJKLMNOPQRSTUVWXYZ" .         #
365          "0123456789";
366    }
367    &sgr(0);
368    my $end = $top_row + 11;
369    &cup( $end++, 1 );
370    printf 'Change %s with "<" or ">".',
371      ( $opt_direct and ( $which_value !~ /^v/ ) )
372      ? ( sprintf "%s(%s)", $which_value, $which_color )
373      : $which_value;
374    &cup( $end++, 1 );
375    printf "Current SGR %d (%s)", $cur_sgr, $sgr_names[$cur_sgr];
376    if ($opt_direct) {
377        &cup( $end++, 1 );
378
379        printf "Colors: direct";
380        &cup( $end++, 1 );
381
382        if ( &is_default( \%direct_f ) ) {
383            printf "       fg( default )";
384        }
385        else {
386            printf "       fg( r=%s, g=%s, b=%s )",    #
387              &color_name( $direct_f{r} ),             #
388              &color_name( $direct_f{g} ),             #
389              &color_name( $direct_f{b} );
390        }
391        &cup( $end++, 1 );
392
393        if ( &is_default( \%direct_b ) ) {
394            printf "       bg( default )";
395        }
396        else {
397            printf "       bg( r=%s, g=%s, b=%s )",    #
398              &color_name( $direct_b{r} ),             #
399              &color_name( $direct_b{g} ),             #
400              &color_name( $direct_b{b} );
401        }
402    }
403    else {
404        &cup( $end++, 1 );
405        printf "Colors: indexed";
406        if ( &is_default( \%indexed_f ) ) {
407            printf ", fg=default";
408        }
409        else {
410            printf ", fg=%s", &color_name( $indexed_f{c} );
411        }
412        if ( &is_default( \%indexed_b ) ) {
413            printf ", bg=default";
414        }
415        else {
416            printf ", bg=%s", &color_name( $indexed_b{c} );
417        }
418    }
419    &cup( $end++, 1 );
420    printf ' ("q" to quit, "?" for help)';
421}
422
423sub init_screensize() {
424    $row_max = 24;
425    $col_max = 80;
426    &cup( 9999, 9999 );
427    my $result = &get_reply( $csi . "6n" );
428    if ( $result =~ /^$csi[[:digit:];]+R$/ ) {
429        $result =~ s/^$csi[;]*//;
430        $result =~ s/[;]*R$//;
431        my @params = split /;/, $result;
432        if ( $#params == 1 ) {
433            $row_max = $params[0];
434            $col_max = $params[1];
435        }
436    }
437    &cup( 1, 1 );
438}
439
440sub startup_screen() {
441    ReadMode 'ultra-raw', 'STDIN';
442}
443
444sub restore_screen() {
445    &sgr(0);
446    printf "%s102%s", $osc, $st if ($opt_direct);
447    &cup( $row_max, 1 );
448    ReadMode 'restore', 'STDIN';
449}
450
451GetOptions(
452    'colors=i',    #
453    'help|?',      #
454    'direct',      #
455    'man'
456) || pod2usage(2);
457pod2usage(1) if $opt_help;
458pod2usage( -verbose => 2 ) if $opt_man;
459
460$opt_colors = ( $opt_direct ? 256 : 8 ) unless ($opt_colors);
461$opt_colors = 8 if ( $opt_colors < 8 );
462
463&startup_screen;
464
465&init_screensize;
466
467$mark    = 0;
468$top_row = 4;
469$row_now = $row_1st = $top_row;
470$col_now = $col_1st = 1;
471
472&ed(2);
473&show_example;
474
475while (1) {
476    my $cmd;
477
478    &show_status;
479    &cup( $row_now, $col_now );
480    $cmd = ReadKey 0;
481    if ( $cmd eq "?" ) {
482        &restore_screen;
483        system( $0 . " -man" );
484        &startup_screen;
485        &show_example;
486        $cmd = ReadKey 0;
487    }
488    elsif ( $cmd eq " " ) {
489        $mark    = ( $mark != 0 ) ? 0 : 1;
490        $row_1st = $row_now;
491        $col_1st = $col_now;
492    }
493    elsif ( $cmd eq chr(12) ) {
494        &show_example;
495    }
496    elsif ( $cmd eq "h" ) {
497        $col_now-- if ( $col_now > 1 );
498    }
499    elsif ( $cmd eq "j" ) {
500        $row_now++ if ( $row_now < $row_max );
501    }
502    elsif ( $cmd eq "k" ) {
503        $row_now-- if ( $row_now > 1 );
504    }
505    elsif ( $cmd eq "l" ) {
506        $col_now++ if ( $col_now < $col_max );
507    }
508    elsif ( $cmd eq "q" ) {
509        &restore_screen;
510        printf "\r\n...quit\r\n";
511        last;
512    }
513    elsif ( $cmd eq "=" ) {
514        &cup( $row_now = $row_1st + $cur_sgr, $col_now = 24 );
515    }
516    elsif ( $cmd eq "v" ) {
517        &set_which_value("video-attributes (SGR)");
518    }
519    elsif ( $cmd eq "f" ) {
520        &set_which_value("foreground");
521    }
522    elsif ( $cmd eq "b" ) {
523        &set_which_value("background");
524    }
525    elsif ( $cmd eq "d" ) {
526        &toggle_default;
527    }
528    elsif ( $cmd eq "<" ) {
529        &change_value(-1);
530    }
531    elsif ( $cmd eq ">" ) {
532        &change_value(1);
533    }
534    elsif ( $opt_direct and ( $cmd eq "R" ) ) {
535        &set_which_color("red");
536    }
537    elsif ( $opt_direct and ( $cmd eq "G" ) ) {
538        &set_which_color("green");
539    }
540    elsif ( $opt_direct and ( $cmd eq "B" ) ) {
541        &set_which_color("blue");
542    }
543    else {
544        &beep;
545    }
546}
547
5481;
549
550__END__
551
552=head1 NAME
553
554report-sgr.pl - demonstrate xterm's report-SGR control sequence
555
556=head1 SYNOPSIS
557
558report-sgr.pl [options]
559
560  Options:
561    -help            brief help message
562    -8               use 8-bit controls
563    -colors=NUM      specify number of indexed colors
564    -direct          use direct-colors, rather than indexed
565
566=head1 OPTIONS
567
568=over 8
569
570=item B<-help>
571
572Print a brief help message and exit.
573
574=item B<-man>
575
576Print the extended help message and exit.
577
578=item B<-colors>
579
580Specify the number of indexed colors.
581
582=item B<-direct>
583
584Use direct-colors (e.g., an RGB value), rather than indexed (e.g., ANSI colors).
585
586=back
587
588=head1 DESCRIPTION
589
590B<report-sgr> displays a normal line, as well as one for each SGR code 1-9,
591with a test-string showing the effect of the SGR.  Two SGR codes can be
592combined, as well as foreground and background colors.
593
594=head1 Commands
595
596=over 8
597
598=item B<q>
599
600Quit the program with B<q>.  It will ignore B<^C> and other control characters.
601
602=item B<h>, B<j>, B<k>, B<l>
603
604As you move the cursor around the screen (with vi-style h,j,k,l characters),
605the script sends an XTREPORTSGR control to the terminal, asking what the video
606attributes are for the currently selected cell.  The script displays the result
607on the second line of the screen.
608
609=item B<space>
610
611XTREPORTSGR returns an SGR control sequence which could be used to set the
612terminal's current video attributes to match the attributes found in all cells
613of the rectangle specified by this script.  Use the spacebar to toggle the mark
614which denotes one corner of the rectangle.  The current cursor position is the
615other corner.
616
617=item B<=>
618
619Move the cursor to the first cell of the test-data for the currently selected
620SGR code (the one with B<-->>).
621
622=item B<v>
623
624Select the video-attribute mode.
625
626=item B<f>
627
628Select the foreground-color mode.
629
630=item B<b>
631
632Select the background-color mode.
633
634=item B<R>
635
636When direct-colors are chosen, select the red-component of
637the currently selected foreground or background mode.
638
639=item B<G>
640
641When direct-colors are chosen, select the green-component of
642the currently selected foreground or background mode.
643
644=item B<B>
645
646When direct-colors are chosen, select the blue-component of
647the currently selected foreground or background mode.
648
649=item B<d>
650
651Toggle between the selected colors and the terminal's default colors.
652
653=item B<<>
654
655Decrease the index of video-attribute to combine, or the color value
656depending on the selected mode.
657
658=item B<>>
659
660Increase the index of video-attribute to combine, or the color value
661depending on the selected mode.
662
663=item B<^L>
664
665Repaint the screen.
666
667=back
668
669=cut
670