1#!/usr/bin/env perl
2# $XTermId: decsed.pl,v 1.6 2015/02/22 01:37:20 tom Exp $
3# -----------------------------------------------------------------------------
4# this file is part of xterm
5#
6# Copyright 2015 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# Exercise DECSED (erase display) with or without DECSCA (protect against
35# DECSED).
36use strict;
37
38use Getopt::Std;
39
40our ( $opt_c,  $opt_n,       $opt_p,     $opt_w );
41our ( $lineno, $test_string, $term_wide, $term_high );
42
43sub move($$) {
44    my $y = shift;
45    my $x = shift;
46    printf "\x1b[%d;%dH", $y, $x;
47}
48
49sub protect($) {
50    my $code = shift;
51    printf "\x1b[%d\"q", $code;
52}
53
54sub set_color($) {
55    my $code = shift;
56    if ( $code == 1 ) {
57        printf "\x1b[0;36;44m";    # cyan-on-blue
58    }
59    else {
60        printf "\x1b[0;39;49m";
61    }
62}
63
64# returns a string of two-column characters given an ASCII alpha/numeric string
65sub double_cells($) {
66    my $value = $_[0];
67    $value =~ s/ /  /g;
68    pack(
69        "U*",
70        map {
71            ( $_ <= 32 || $_ > 127 )    # if non-ASCII character...
72              ? 32                      # ...just show a blank
73              : ( 0xff00 + ( $_ - 32 ) )    # map to "Fullwidth Form"
74          } unpack( "C*", $value )
75    );                                      # unpack unsigned-char characters
76}
77
78# write the text for the given line-number
79sub fill_line($$) {
80    my $number = shift;
81    my $offset = shift;
82    my $length = $opt_w ? ( $term_wide / 2 ) : $term_wide;
83    my $actual;
84    my $margin = 0;
85    $actual = $length;
86    my $string = $test_string;
87    while ( ( $opt_w ? ( 2 * length($string) ) : length($string) ) <
88        ( $offset + $length ) )
89    {
90        $string = $string . $test_string;
91    }
92    $string = substr( $string, $offset, $length );
93    $string = double_cells($string) if ($opt_w);
94    printf "%s", $string;
95
96    printf "\n";
97    return ++$offset;
98}
99
100sub main::HELP_MESSAGE() {
101    printf STDERR <<EOF
102Usage: $0 [options] DECSED [y [x]]
103
104The test
105    fills the screen (-n for normal, -w for wide characters, default DECALN)
106    then positions to the given y,x (default is middle of screen),
107    writes a '*' at the cursor position
108    moves back to given y,x again
109    erases with the DECSED value (0=below, 1=above, 2=all=default),
110    moves the cursor up/down one line to avoid overwriting by prompt
111
112Options:
113
114-c   use color
115-n   write normal-characters rather than using DECALN
116-p   protect screen against erasure using DECSCA (DECALN is unprotected)
117-w   write wide-characters rather than using DECALN
118EOF
119      ;
120    exit;
121}
122
123&getopts('cnpw') || &main::HELP_MESSAGE;
124
125$term_wide = `tput cols`;
126$term_high = `tput lines`;
127
128$test_string =
129  "0123456789 ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz";
130
131my $parm_DECSED = ( $#ARGV >= 0 ) ? $ARGV[0] : 2;
132my $parm_ycoord = ( $#ARGV >= 1 ) ? $ARGV[1] : $term_high / 2;
133my $parm_xcoord = ( $#ARGV >= 2 ) ? $ARGV[2] : $term_wide / 2;
134
135binmode( STDOUT, ":utf8" );
136&protect(1)   if ($opt_p);
137&set_color(1) if ($opt_c);
138if ( $opt_n or $opt_w ) {
139    my $offset = 0;
140    for ( $lineno = 0 ; $lineno < $term_high - 1 ; ++$lineno ) {
141        $offset = &fill_line( $lineno, $offset );
142    }
143}
144else {
145    printf "\x1b#8";    # DECALN
146}
147&move( $parm_ycoord, $parm_xcoord );
148printf '*';
149&move( $parm_ycoord, $parm_xcoord );
150printf "\x1b[?%dJ", $parm_DECSED;
151if ( $parm_DECSED == 0 ) {
152    &move( $parm_ycoord + 1, $parm_xcoord );
153}
154elsif ( $parm_DECSED == 1 ) {
155    &move( $parm_ycoord - 1, $parm_xcoord );
156}
157&set_color(0) if ($opt_c);
158&protect(0)   if ($opt_p);
159
160exit;
161