1#!/usr/bin/env perl
2# $XTermId: sgrPushPop2.pl,v 1.4 2020/12/13 15:05:06 tom Exp $
3# -----------------------------------------------------------------------------
4# this file is part of xterm
5#
6# Copyright 2019,2020 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
35use strict;
36use warnings;
37
38use Getopt::Std;
39
40$| = 1;
41
42our ( $opt_b, $opt_n, $opt_r );
43
44$Getopt::Std::STANDARD_HELP_VERSION = 1;
45&getopts('bn:r:') || die(
46    "Usage: $0 [options]\n
47Options:\n
48  -b      color backgrounds instead of foregrounds
49  -n NUM  limit test to NUM rows (default: 9)
50  -r NUM  rotate example-columns (e.g, -r1 puts direct-color in middle)
51"
52);
53$opt_n = 9 unless ( defined $opt_n );
54$opt_r = 0 unless ( defined $opt_r );
55
56our @xterm_ansi = (
57    0x000000,    #black
58    0xcd0000,    #red3
59    0x00cd00,    #green3
60    0xcdcd00,    #yellow3
61    0x0000ee,    #blue2
62    0xcd00cd,    #magenta3
63    0x00cdcd,    #cyan3
64    0xe5e5e5     #gray90
65);
66
67# The lengths in @example_title differ to ensure that the trailing "END!"
68# should be the same color as the middle column, regardless of "-r" rotation.
69our $example_title = "COLOR-";
70our @example_title = ( "Indexed", "ANSI8", "Direct" );
71
72# demonstrate selective SGR pop by a two-level test where the top-level has
73# ANSI colors, while the lower-level iterates over a color test-pattern,
74# alternating between direct-color and indexed-colors.
75
76sub choose_fgbg($$) {
77    my $fg     = shift;
78    my $bg     = shift;
79    my $result = $opt_b ? $bg : $fg;
80    return $result;
81}
82
83sub choose_column($) {
84    my $code = shift;
85    return ( $code + $opt_r ) % 3;
86}
87
88sub pushSGR($) {
89    my $params = shift;
90    printf "\x1b[%s#{", $params;
91}
92
93sub popSGR() {
94    printf "\x1b[#}";
95}
96
97sub mark_l() {
98    printf " {";
99}
100
101sub mark_r() {
102    printf "} ";
103}
104
105sub standard_example() {
106    &mark_l;
107    my $text = $example_title . $example_title[1];
108    for my $n ( 0 .. length($text) - 1 ) {
109        printf "\x1b[%dm", ( $n % 7 ) + 1 + &choose_fgbg( 30, 40 );
110        printf "%s", substr( $text, $n, 1 );
111    }
112    &mark_r;
113}
114
115# The first 16 colors of xterm-256's palette match the ANSI+aixterm range.
116# Do not imitate the bold-colors.
117sub indexed_example() {
118    &mark_l;
119    my $text = $example_title . $example_title[0];
120    for my $n ( 0 .. length($text) - 1 ) {
121        my $c = ( $n % 7 ) + 1;
122        printf "\x1b[%d;5:%dm", &choose_fgbg( 38, 48 ), $c;
123        printf "%s", substr( $text, $n, 1 );
124    }
125    &mark_r;
126}
127
128# Imitate the "ANSI" colors from xterm's palette.
129# (Again bold colors are not imitated here).
130sub direct_example() {
131    &mark_l;
132    my $text = $example_title . $example_title[2];
133    for my $n ( 0 .. length($text) - 1 ) {
134        my $c = ( $n % 7 ) + 1;
135        my $r = ( $xterm_ansi[$c] / ( 256 * 256 ) ) % 256;
136        my $g = ( $xterm_ansi[$c] / (256) ) % 256;
137        my $b = ( $xterm_ansi[$c] ) % 256;
138        printf "\x1b[%d;2:1:%d:%d:%dm", &choose_fgbg( 38, 48 ), $r, $g, $b;
139        printf "%s", substr( $text, $n, 1 );
140    }
141    &mark_r;
142}
143
144sub run_example($) {
145    my $column = shift;
146    &indexed_example  if ( &choose_column($column) == 0 );
147    &standard_example if ( &choose_column($column) == 1 );
148    &direct_example   if ( &choose_column($column) == 2 );
149}
150
151sub video_name($) {
152    my $code   = shift;
153    my $result = "?";
154    $result = "normal"            if ( $code == 0 );
155    $result = "bold"              if ( $code == 1 );
156    $result = "faint"             if ( $code == 2 );
157    $result = "italicized"        if ( $code == 3 );
158    $result = "underlined"        if ( $code == 4 );
159    $result = "blink"             if ( $code == 5 );
160    $result = "inverse"           if ( $code == 7 );
161    $result = "crossed-out"       if ( $code == 9 );
162    $result = "double-underlined" if ( $code == 21 );
163    return $result;
164}
165
166sub reset_video() {
167    printf "\x1b[m";
168}
169
170sub set_video($) {
171    my $row   = shift;
172    my $param = "";
173    my $cycle = 9;
174    $param = 0  if ( ( $row % $cycle ) == 0 );
175    $param = 1  if ( ( $row % $cycle ) == 1 );
176    $param = 2  if ( ( $row % $cycle ) == 2 );
177    $param = 3  if ( ( $row % $cycle ) == 3 );
178    $param = 4  if ( ( $row % $cycle ) == 4 );
179    $param = 5  if ( ( $row % $cycle ) == 5 );
180    $param = 7  if ( ( $row % $cycle ) == 6 );
181    $param = 9  if ( ( $row % $cycle ) == 7 );
182    $param = 21 if ( ( $row % $cycle ) == 8 );
183    printf "%-20s",    &video_name($param);
184    printf "\x1b[%dm", $param;
185}
186
187printf "\x1b[H\x1b[J";
188
189&pushSGR("");
190printf "\x1b[40;37mSetting ambient colors to white-on-black\n";
191
192# The three columns (indexed, ANSI, direct) will look similar.
193&pushSGR("");
194
195printf "Testing white-on-black with columns %s,%s,%s\n",
196  $example_title[ &choose_column(0) ],
197  $example_title[ &choose_column(1) ],
198  $example_title[ &choose_column(2) ];
199
200for my $row ( 0 .. $opt_n ) {
201
202    &pushSGR("30;31");    # save/restore only foreground/background color
203    &set_video($row);     # this attribute is set for the whole row
204    &run_example(0);
205    &popSGR;
206
207    &run_example(1);
208
209    &pushSGR("30;31");    # save/restore only foreground/background color
210    &run_example(2);
211    &popSGR;
212    printf "END!";        # this is in the last color used in the middle column
213    &reset_video();
214    printf "\n";
215}
216
217&popSGR;
218printf "The ambient colors should still be white-on-black.\n";
219&popSGR;
220printf "Now we should be back to whatever it was before we got here.\n";
221
2221;
223