1 #!/usr/bin/perl -w 2 # $XTermId: print-vt-chars.pl,v 1.23 2020/12/13 15:05:06 tom Exp $ 3 # ----------------------------------------------------------------------------- 4 # this file is part of xterm 5 # 6 # Copyright 2018,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 # Print GL and GR, with the same charset (if possible) for testing. 35 36 use strict; 37 use warnings; 38 39 $| = 2; 40 41 use Getopt::Std; 42 43 our ( $opt_L, $opt_l, $opt_R, $opt_r, $opt_v ); 44 45 our %charsets; 46 our %caseless; 47 our $vt_level; 48 49 binmode STDOUT; 50 51 sub NRC($) { 52 printf "\033[?42%s", $_[0] ? "h" : "l"; 53 } 54 55 sub LS0($) { 56 printf "\017"; 57 } 58 59 sub LS1() { 60 printf "\016"; 61 } 62 63 sub LS1R() { 64 printf "\033~"; 65 } 66 67 sub LS2() { 68 printf "\033n"; 69 } 70 71 sub LS2R() { 72 printf "\033}"; 73 } 74 75 sub LS3() { 76 printf "\033o"; 77 } 78 79 sub LS3R($) { 80 printf "\033|"; 81 } 82 83 sub G0($) { 84 my %charset = %{ $_[0] }; 85 printf "\033(%s", $charset{TAG} if ( $charset{HOW} == 0 ); 86 } 87 88 sub G1($) { 89 my %charset = %{ $_[0] }; 90 printf "\033)%s", $charset{TAG} if ( $charset{HOW} == 0 ); 91 printf "\033-%s", $charset{TAG} if ( $charset{HOW} == 1 ); 92 } 93 94 sub G2($) { 95 my %charset = %{ $_[0] }; 96 printf "\033*%s", $charset{TAG} if ( $charset{HOW} == 0 ); 97 printf "\033.%s", $charset{TAG} if ( $charset{HOW} == 1 ); 98 } 99 100 sub G3($) { 101 my %charset = %{ $_[0] }; 102 printf "\033+%s", $charset{TAG} if ( $charset{HOW} == 0 ); 103 printf "\033/%s", $charset{TAG} if ( $charset{HOW} == 1 ); 104 } 105 106 sub init_charset($$$$$$) { 107 my %charset; 108 my $mixed = shift; 109 $charset{WHO} = $mixed; 110 $charset{HOW} = shift; 111 $charset{TAG} = shift; 112 $charset{MIN} = shift; 113 $charset{MAX} = shift; 114 $charset{NRC} = shift; 115 $charsets{$mixed} = \%charset; 116 my $lower = lc $charset{WHO}; 117 $caseless{$lower} = $charset{WHO}; 118 } 119 120 sub find_charset($) { 121 my $mixed = shift; 122 my $lower = lc $mixed; 123 my %result; 124 if ( $caseless{$lower} ) { 125 $mixed = $caseless{$lower}; 126 %result = %{ $charsets{$mixed} }; 127 undef %result 128 if ( $result{MAX} < $vt_level or $result{MIN} > $vt_level ); 129 } 130 printf STDERR "? no match for $mixed with VT-level $vt_level\n" 131 unless %result; 132 return \%result; 133 } 134 135 sub failed($) { 136 my $msg = shift; 137 printf STDERR "? %s\n", $msg; 138 exit 1; 139 } 140 141 sub valid_code($) { 142 my $code = shift; 143 my $result = 0; 144 $result = 1 if ( $code =~ /^[0-3]$/ ); 145 return $result; 146 } 147 148 sub valid_name($) { 149 my $mixed = shift; 150 my $lower = lc $mixed; 151 my $result = 0; 152 $result = 1 if ( defined( $caseless{$lower} ) ); 153 return $result; 154 } 155 156 sub setup_charsets($$$$) { 157 my $gl_code = shift; 158 my $gl_name = shift; 159 my $gr_code = shift; 160 my $gr_name = shift; 161 my %gl_data = %{ &find_charset($gl_name) }; 162 my %gr_data = %{ &find_charset($gr_name) }; 163 164 return 0 unless %gl_data; 165 return 0 unless %gr_data; 166 167 &NRC(1) if ( $gl_data{NRC} or $gr_data{NRC} ); 168 169 if ( $gl_code == 0 ) { 170 &G0( \%gl_data ); 171 &LS0; 172 } 173 elsif ( $gl_code == 1 ) { 174 &G1( \%gl_data ); 175 &LS1; 176 } 177 elsif ( $gl_code == 2 ) { 178 &G2( \%gl_data ); 179 &LS2; 180 } 181 elsif ( $gl_code == 3 ) { 182 &G3( \%gl_data ); 183 &LS3; 184 } 185 186 if ( $gr_code == 0 ) { 187 &G0( \%gr_data ); 188 } 189 elsif ( $gr_code == 1 ) { 190 &G1( \%gr_data ); 191 &LS1R; 192 } 193 elsif ( $gr_code == 2 ) { 194 &G2( \%gr_data ); 195 &LS2R; 196 } 197 elsif ( $gr_code == 3 ) { 198 &G3( \%gr_data ); 199 &LS3R; 200 } 201 return 1; 202 } 203 204 sub cleanup() { 205 &setup_charsets( 0, "ASCII", 1, "ASCII" ); 206 &NRC(0); 207 } 208 209 sub doit($$$$) { 210 my $gl_code = shift; 211 my $gl_name = shift; 212 my $gr_code = shift; 213 my $gr_name = shift; 214 215 &failed("Illegal left-code $gl_code") unless &valid_code($gl_code); 216 &failed("Illegal right-code $gr_code") unless &valid_code($gr_code); 217 &failed("Unknown left-charset $gl_name") unless &valid_name($gl_name); 218 &failed("Unknown right charset $gr_name") unless &valid_name($gr_name); 219 220 printf "GL (G%d %s):\n", $gl_code, $gl_name; 221 if ( &setup_charsets( $gl_code, $gl_name, $gr_code, $gr_name ) ) { 222 223 for my $c ( 32 .. 127 ) { 224 printf "%c", $c; 225 printf "\n" if ( ( ( $c - 31 ) % 16 ) == 0 ); 226 } 227 printf "\n"; 228 229 &cleanup; 230 } 231 232 printf "GR (G%d %s):\n", $gr_code, $gr_name; 233 if ( &setup_charsets( $gl_code, $gl_name, $gr_code, $gr_name ) ) { 234 235 for my $c ( 32 .. 127 ) { 236 printf "%c", $c + 128; 237 printf "\n" if ( ( ( $c - 31 ) % 16 ) == 0 ); 238 } 239 printf "\n"; 240 241 &cleanup; 242 } 243 } 244 245 sub main::HELP_MESSAGE() { 246 printf STDERR <<EOF 247 Usage: $0 [options] 248 249 Options: 250 251 -L code index 0-3 for GL 252 -l name charset to map to GL 253 -R code index 0-3 for GR 254 -r name charset to map to GR 255 -v level set/override VT-level 256 257 Charsets are determined by the VT-level (currently VT${vt_level}xx): 258 EOF 259 ; 260 my @known; 261 my $known = -1; 262 my $width = 0; 263 foreach my $key ( sort( keys %charsets ) ) { 264 my %charset = %{ $charsets{$key} }; 265 next if ( $charset{MAX} < $vt_level ); 266 next if ( $charset{MIN} > $vt_level ); 267 $known[ ++$known ] = $key; 268 $width = length($key) if ( length($key) > $width ); 269 } 270 $width += 3; 271 my $cols = int( 78 / $width ); 272 my $high = int( ( $known + $cols ) / $cols ); 273 for my $y ( 0 .. $high - 1 ) { 274 printf STDERR " "; 275 for my $x ( 0 .. $cols - 1 ) { 276 my $z = $x * $high + $y; 277 next if ( $z > $known ); 278 printf STDERR "%-*s", $width, $known[$z]; 279 } 280 printf STDERR "\n"; 281 } 282 exit 1; 283 } 284 285 &init_charset( "ASCII", 0, 'B', 1, 9, 0 ); 286 &init_charset( "British", 0, 'A', 1, 9, 0 ); 287 &init_charset( "DEC_Spec_Graphic", 0, '0', 1, 9, 0 ); 288 &init_charset( "DEC_Alt_Chars", 0, '1', 1, 1, 0 ); 289 &init_charset( "DEC_Alt_Graphics", 0, '2', 1, 1, 0 ); 290 &init_charset( "DEC_Supp", 0, '<', 2, 9, 0 ); 291 &init_charset( "Dutch", 0, '4', 2, 9, 1 ); 292 &init_charset( "Finnish", 0, '5', 2, 9, 1 ); 293 &init_charset( "Finnish2", 0, 'C', 2, 9, 1 ); 294 &init_charset( "French", 0, 'R', 2, 9, 1 ); 295 &init_charset( "French2", 0, 'f', 2, 9, 1 ); 296 &init_charset( "French_Canadian", 0, 'Q', 2, 9, 1 ); 297 &init_charset( "German", 0, 'K', 2, 9, 1 ); 298 &init_charset( "Italian", 0, 'Y', 2, 9, 1 ); 299 &init_charset( "Norwegian_Danish2", 0, 'E', 2, 9, 1 ); 300 &init_charset( "Norwegian_Danish3", 0, '6', 2, 9, 1 ); 301 &init_charset( "Spanish", 0, 'Z', 2, 9, 1 ); 302 &init_charset( "Swedish", 0, '7', 2, 9, 1 ); 303 &init_charset( "Swedish2", 0, 'H', 2, 9, 1 ); 304 &init_charset( "Swiss", 0, '=', 2, 9, 1 ); 305 &init_charset( "British_Latin_1", 0, 'A', 3, 9, 1 ); 306 &init_charset( "DEC_Supp_Graphic", 0, '%5', 3, 9, 0 ); 307 &init_charset( "DEC_Technical", 0, '>', 3, 9, 0 ); 308 &init_charset( "French_Canadian2", 0, '9', 3, 9, 1 ); 309 &init_charset( "Norwegian_Danish", 0, '`', 3, 9, 1 ); 310 &init_charset( "Portuguese", 0, '%6', 3, 9, 1 ); 311 &init_charset( "ISO_Greek_Supp", 1, 'F', 5, 9, 0 ); 312 &init_charset( "ISO_Hebrew_Supp", 1, 'H', 5, 9, 0 ); 313 &init_charset( "ISO_Latin_5_Supp", 1, 'M', 5, 9, 0 ); 314 &init_charset( "ISO_Latin_Cyrillic", 1, 'L', 5, 9, 0 ); 315 &init_charset( "Greek", 0, '">', 5, 9, 1 ); 316 &init_charset( "DEC_Greek", 0, '"?', 5, 9, 1 ); 317 &init_charset( "Cyrillic", 0, '&4', 5, 9, 0 ); 318 &init_charset( "DEC_Hebrew", 0, '"4', 5, 9, 0 ); 319 &init_charset( "Hebrew", 0, '%=', 5, 9, 1 ); 320 &init_charset( "Russian", 0, '&5', 5, 9, 1 ); 321 &init_charset( "SCS_NRCS", 0, '%3', 5, 9, 0 ); 322 &init_charset( "Turkish", 0, '%2', 5, 9, 1 ); 323 &init_charset( "DEC_Turkish", 0, '%0', 5, 9, 0 ); 324 325 $vt_level = 1; # don't expect much 326 if ( -t 0 and -t 1 ) { 327 my $da2 = ` 328 old=\$(stty -g); 329 stty raw -echo min 0 time 5; 330 printf '\033[>c' >/dev/tty; 331 read response; 332 stty \$old; 333 echo "\$response"`; 334 if ( $da2 =~ /^\033\[>\d+;\d+;\d+c$/ ) { 335 my $Pp = $da2; 336 $Pp =~ s/^.*>//; 337 $Pp =~ s/;.*$//; 338 if ( $Pp == 0 ) { 339 $vt_level = 1; 340 } 341 elsif ( $Pp == 1 or $Pp == 2 ) { 342 $vt_level = 2; 343 } 344 elsif ( $Pp == 18 or $Pp == 19 or $Pp == 24 ) { 345 $vt_level = 3; 346 } 347 elsif ( $Pp == 41 ) { 348 $vt_level = 4; 349 } 350 elsif ( $Pp == 61 or $Pp == 64 or $Pp == 65 ) { 351 $vt_level = 5; 352 } 353 } 354 } 355 356 $Getopt::Std::STANDARD_HELP_VERSION = 1; 357 &getopts('L:l:R:r:v:') || main::HELP_MESSAGE; 358 $vt_level = $opt_v if ( defined $opt_v ); 359 &failed("VT-level must be 1-5") if ( $vt_level < 1 or $vt_level > 5 ); 360 361 if ( $#ARGV >= 0 ) { 362 while ( $#ARGV >= 0 ) { 363 my $name = shift @ARGV; 364 &doit( 365 defined($opt_L) ? $opt_L : 2, # 366 defined($opt_l) ? $opt_l : $name, # 367 defined($opt_R) ? $opt_R : 3, # 368 defined($opt_r) ? $opt_r : $name 369 ); 370 last 371 if ( 372 defined($opt_L) # 373 and defined($opt_l) # 374 and defined($opt_R) # 375 and defined($opt_r) 376 ); 377 } 378 } 379 else { 380 &doit( 381 defined($opt_L) ? $opt_L : 2, # 382 defined($opt_l) ? $opt_l : "ASCII", # 383 defined($opt_R) ? $opt_R : 3, # 384 defined($opt_r) ? $opt_r : "ASCII" 385 ); 386 } 387 388 1; 389
Indexes created Sun Oct 18 00:25:03 UTC 2026