"Fossies" - the Fresh Open Source Software Archive 
Member "xterm-379/vttests/sgrPushPop2.pl" (13 Dec 2020, 6778 Bytes) of package /linux/misc/xterm-379.tgz:
As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style:
standard) with prefixed line numbers and
code folding option.
Alternatively you can here
view or
download the uninterpreted source code file.
For more information about "sgrPushPop2.pl" see the
Fossies "Dox" file reference documentation.
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
35 use strict;
36 use warnings;
37
38 use Getopt::Std;
39
40 $| = 1;
41
42 our ( $opt_b, $opt_n, $opt_r );
43
44 $Getopt::Std::STANDARD_HELP_VERSION = 1;
45 &getopts('bn:r:') || die(
46 "Usage: $0 [options]\n
47 Options:\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
56 our @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.
69 our $example_title = "COLOR-";
70 our @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
76 sub choose_fgbg($$) {
77 my $fg = shift;
78 my $bg = shift;
79 my $result = $opt_b ? $bg : $fg;
80 return $result;
81 }
82
83 sub choose_column($) {
84 my $code = shift;
85 return ( $code + $opt_r ) % 3;
86 }
87
88 sub pushSGR($) {
89 my $params = shift;
90 printf "\x1b[%s#{", $params;
91 }
92
93 sub popSGR() {
94 printf "\x1b[#}";
95 }
96
97 sub mark_l() {
98 printf " {";
99 }
100
101 sub mark_r() {
102 printf "} ";
103 }
104
105 sub 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.
117 sub 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).
130 sub 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
144 sub 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
151 sub 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
166 sub reset_video() {
167 printf "\x1b[m";
168 }
169
170 sub 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
187 printf "\x1b[H\x1b[J";
188
189 &pushSGR("");
190 printf "\x1b[40;37mSetting ambient colors to white-on-black\n";
191
192 # The three columns (indexed, ANSI, direct) will look similar.
193 &pushSGR("");
194
195 printf "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
200 for 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;
218 printf "The ambient colors should still be white-on-black.\n";
219 &popSGR;
220 printf "Now we should be back to whatever it was before we got here.\n";
221
222 1;