1#!/usr/bin/env perl
2# $XTermId: under-latin.pl,v 1.6 2020/01/31 00:16:52 tom Exp $
3# -----------------------------------------------------------------------------
4# this file is part of xterm
5#
6# Copyright 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 a text-test pattern using Latin-1 characters that have these features:
35#	a) accents
36#	b) descenders
37#	c) underlining
38
39use strict;
40use warnings;
41
42use Getopt::Std;
43use Term::ReadKey;
44
45$| = 1;
46
47our ( $opt_b, $opt_i, $opt_u );
48
49our $ROWS = 24;
50our $COLS = 4;
51
52our @sample;
53
54sub underlined($$) {
55    my $text = shift;
56    my $code = shift;
57    $text = sprintf "\033[4m%s\033[24m", $text if ($code);
58    return $text;
59}
60
61sub print_row($) {
62    my $y     = shift;
63    my $cells = $y * 5;
64    for my $x ( 0 .. $COLS ) {
65        printf "%s",
66          &underlined( $sample[ $cells % 2 ], ( $cells % 4 ) > 1 ? 1 : 0 );
67        ++$cells;
68    }
69}
70
71sub main::HELP_MESSAGE() {
72    printf STDERR <<EOF
73Usage: $0 [options]
74
75Options:
76
77-b         write a pattern in bold-text
78-i         write a pattern in italic-text
79-u         write text in UTF-8
80EOF
81      ;
82    exit;
83}
84
85$Getopt::Std::STANDARD_HELP_VERSION = 1;
86&getopts('biu') || &main::HELP_MESSAGE;
87
88if ( -t 0 ) {
89    my $size = `stty size`;
90    chomp $size;
91    if ( $size =~ /^\d+\s+\d+$/ ) {
92        my @size = split /\s+/, $size;
93        $ROWS = $size[0];
94        $COLS = $size[1] - 4;
95        $COLS /= 2 if ( $opt_b or $opt_i );
96        $COLS /= 7;
97        $COLS = int($COLS) - 1;
98    }
99}
100
101binmode( STDOUT, ":utf8" ) if ($opt_u);
102
103$sample[0] = sprintf "%c%c%c%c%c%c%c", 192, 193, 194, 195, 196, 197, 198;
104$sample[1] = sprintf "gjpqy%c%c", 199, 255;
105
106for my $y ( 0 .. ( $ROWS - 1 ) ) {
107    printf "%3d ", $y + 1;
108    printf "\033[1m" if ( $opt_b and $opt_i );
109    &print_row($y);
110    printf "\033[22m" if ( $opt_b and $opt_i );
111    if ( $opt_b or $opt_i ) {
112        printf "\033[%dm", $opt_i ? 3 : 1;
113        &print_row($y);
114        printf "\033[%dm", $opt_i ? 23 : 22;
115    }
116    printf "\n" unless ( $y + 1 >= $ROWS );
117}
118
119if ( -t 1 ) {
120    printf "\033[m";
121    ReadMode 'cbreak';
122    my $key = ReadKey(30);
123    ReadMode 'normal';
124}
125printf "\n";
126
1271;
128