#!/usr/bin/env perl # $XTermId: under-latin.pl,v 1.6 2020/01/31 00:16:52 tom Exp $ # ----------------------------------------------------------------------------- # this file is part of xterm # # Copyright 2020 by Thomas E. Dickey # # All Rights Reserved # # Permission is hereby granted, free of charge, to any person obtaining a # copy of this software and associated documentation files (the # "Software"), to deal in the Software without restriction, including # without limitation the rights to use, copy, modify, merge, publish, # distribute, sublicense, and/or sell copies of the Software, and to # permit persons to whom the Software is furnished to do so, subject to # the following conditions: # # The above copyright notice and this permission notice shall be included # in all copies or substantial portions of the Software. # # THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS # OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF # MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. # IN NO EVENT SHALL THE ABOVE LISTED COPYRIGHT HOLDER(S) BE LIABLE FOR ANY # CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, # TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE # SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. # # Except as contained in this notice, the name(s) of the above copyright # holders shall not be used in advertising or otherwise to promote the # sale, use or other dealings in this Software without prior written # authorization. # ----------------------------------------------------------------------------- # Print a text-test pattern using Latin-1 characters that have these features: # a) accents # b) descenders # c) underlining use strict; use warnings; use Getopt::Std; use Term::ReadKey; $| = 1; our ( $opt_b, $opt_i, $opt_u ); our $ROWS = 24; our $COLS = 4; our @sample; sub underlined($$) { my $text = shift; my $code = shift; $text = sprintf "\033[4m%s\033[24m", $text if ($code); return $text; } sub print_row($) { my $y = shift; my $cells = $y * 5; for my $x ( 0 .. $COLS ) { printf "%s", &underlined( $sample[ $cells % 2 ], ( $cells % 4 ) > 1 ? 1 : 0 ); ++$cells; } } sub main::HELP_MESSAGE() { printf STDERR <= $ROWS ); } if ( -t 1 ) { printf "\033[m"; ReadMode 'cbreak'; my $key = ReadKey(30); ReadMode 'normal'; } printf "\n"; 1;