1#!/usr/bin/env perl
2# $XTermId: halves.pl,v 1.11 2022/11/17 00:45:00 tom Exp $
3# -----------------------------------------------------------------------------
4# this file is part of xterm
5#
6# Copyright 2007,2022 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# Draw a grid of characters (optionally double-width) and modify it using
35# overstrike, insert- and delete-characters to see if the double-width
36# characters are completely cleared when "partly" modified.
37use strict;
38use warnings;
39
40use Getopt::Std;
41
42our ( $opt_c, $opt_n, $opt_r, $opt_w );
43our ( $lineno, $test_string, $term_width );
44
45# returns the number of columns in the screen
46sub screen_width() {
47    open( FP, "resize -u |" ) or exit $!;
48    my (@input) = <FP>;
49    chomp @input;
50    close(FP);
51    my $result = 80;
52    for my $n ( 0 .. $#input ) {
53        if ( $input[$n] =~ /^COLUMNS=/ ) {
54            $result = $input[$n];
55            $result =~ s/^[^=]*=//;
56            $result =~ s/;.*//;
57            last;
58        }
59    }
60    return $result;
61}
62
63sub set_color($) {
64    my $code = $_[0];
65    if ( defined($opt_c) ) {
66        if ( $code == 3 ) {
67            printf "\x1b[1;33;42m";    # yellow-on-green
68        }
69        elsif ( $code == 2 ) {
70            printf "\x1b[0;31;45m";    # red-on-magenta
71        }
72        elsif ( $code == 1 ) {
73            printf "\x1b[0;36;44m";    # cyan-on-blue
74        }
75        else {
76            printf "\x1b[0;39;49m";
77        }
78    }
79}
80
81# returns a string of two-column characters given an ASCII alpha/numeric string
82sub double_cells($) {
83    my $value = $_[0];
84    $value =~ s/ /  /g;
85    pack(
86        "U*",
87        map {
88            ( $_ <= 32 || $_ > 127 )        # if non-ASCII character...
89              ? 32                          # ...just show a blank
90              : ( 0xff00 + ( $_ - 32 ) )    # map to "Fullwidth Form"
91        } unpack( "C*", $value )
92    );                                      # unpack unsigned-char characters
93}
94
95sub move_to($) {
96    printf "\x1b[%dG", $_[0] + 1;
97}
98
99sub delete_char() {
100    set_color(2);
101    printf "\x1b[%dP", 1;
102    set_color(1);
103}
104
105sub insert_once($) {
106    set_color(2);
107    printf "\x1b[%d@", length( $_[0] );
108    write_chars( $_[0] );
109}
110
111sub insert_mode($) {
112    set_color(2);
113    printf "\x1b[%dP", length( $_[0] );
114    printf "\x1b[4h";
115    write_chars( $_[0] );
116    printf "\x1b[4l";
117}
118
119sub write_chars($) {
120    set_color(3);
121    printf "%s", $_[0];
122    set_color(1);
123}
124
125# vary the starting point of each line, to make a more interesting pattern
126sub starts_of($) {
127    my $value = $_[0];
128    if ( defined($opt_w) ) {
129
130        # 0,1,1,2,2,3,3,...
131        $value = ( ( $value + 1 ) / 2 ) % length($test_string);
132    }
133    else {
134        $value %= length($test_string);
135    }
136    return $value;
137}
138
139# write the text for the given line-number
140sub testit($) {
141    my $number = $_[0];
142    my $length = $term_width;
143    if ( defined($opt_n) ) {
144        printf "%5d ", $number % 99999;
145        $length -= 6;
146    }
147
148    # if we're printing double-column characters, we have half as much
149    # space effectively - but don't forget the remainder, so we can push
150    # the characters by single-columns.
151    if ( defined($opt_c) ) {
152        set_color(1);
153        printf "\x1b[K";
154    }
155    my $starts = starts_of($number);
156    if ( defined($opt_w) ) {
157        printf " ", if ( ( $number % 2 ) != 0 );
158        $length = ( $length - ( ($number) % 2 ) ) / 2;
159    }
160    my $string = substr( $test_string, $starts );
161    while ( length($string) < $length ) {
162        $string = $string . $test_string;
163    }
164    $string = substr( $string, 0, $length );
165    if ( defined($opt_w) ) {
166        $string = double_cells($string);
167    }
168    printf "%s", $string;
169
170    # now - within the line - modify it
171    move_to( ( 4 * $term_width ) / 5 );
172    insert_mode("XX");
173    move_to( ( 3 * $term_width ) / 5 );
174    delete_char();
175    move_to( ( 2 * $term_width ) / 5 );
176    insert_once('~');
177    move_to( ( 1 * $term_width ) / 5 );
178    write_chars('~');
179    move_to(0);
180    set_color(0);
181    printf "\n";
182}
183
184sub main::HELP_MESSAGE() {
185    printf STDERR <<EOF
186Usage: $0 [options]
187
188Options:
189
190-c   use color
191-n   write line-numbers
192-r   repeat indefinitely
193-w   write wide-characters
194EOF
195      ;
196    exit;
197}
198
199&getopts('cnrw') || die();
200
201$term_width = screen_width();
202
203$test_string =
204  "0123456789 abcdefghijklmnopqrstuvwxyz ABCDEFGHIJKLMNOPQRSTUVWXYZ";
205
206binmode( STDOUT, ":utf8" );
207if ( defined($opt_r) ) {
208    for ( $lineno = 0 ; ; ++$lineno ) {
209        testit($lineno);
210    }
211}
212else {
213    for ( $lineno = 0 ; $lineno < 24 ; ++$lineno ) {
214        testit($lineno);
215    }
216}
217
218exit;
219