"Fossies" - the Fresh Open Source Software Archive 
Member "xterm-379/vttests/xorblink.pl" (24 Dec 2017, 8025 Bytes) of package /linux/misc/xterm-379.tgz:
As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style:
standard) with prefixed line numbers and
code folding option.
Alternatively you can here
view or
download the uninterpreted source code file.
For more information about "xorblink.pl" see the
Fossies "Dox" file reference documentation and the last
Fossies "Diffs" side-by-side code changes report:
372_vs_373.
1 #!/usr/bin/env perl
2 # $XTermId: xorblink.pl,v 1.16 2017/12/24 21:03:54 tom Exp $
3 # -----------------------------------------------------------------------------
4 # Copyright 2017 by Thomas E. Dickey
5 #
6 # All Rights Reserved
7 #
8 # Permission is hereby granted, free of charge, to any person obtaining a
9 # copy of this software and associated documentation files (the
10 # "Software"), to deal in the Software without restriction, including
11 # without limitation the rights to use, copy, modify, merge, publish,
12 # distribute, sublicense, and/or sell copies of the Software, and to
13 # permit persons to whom the Software is furnished to do so, subject to
14 # the following conditions:
15 #
16 # The above copyright notice and this permission notice shall be included
17 # in all copies or substantial portions of the Software.
18 #
19 # THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
20 # OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
21 # MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
22 # IN NO EVENT SHALL THE ABOVE LISTED COPYRIGHT HOLDER(S) BE LIABLE FOR ANY
23 # CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
24 # TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
25 # SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
26 #
27 # Except as contained in this notice, the name(s) of the above copyright
28 # holders shall not be used in advertising or otherwise to promote the
29 # sale, use or other dealings in this Software without prior written
30 # authorization.
31 # -----------------------------------------------------------------------------
32 # walk through the different states of cursor-blinking, with annotation
33 #
34 # Manual:
35 # +bc turn off text cursor blinking. This overrides the cursorBlink
36 # resource.
37 #
38 # -bc turn on text cursor blinking. This overrides the cursorBlink
39 # resource.
40 #
41 # cursorBlink (class CursorBlink)
42 # Specifies whether to make the cursor blink. The default is
43 # "false".
44 #
45 # Xterm-dev uses two variables to determine whether the cursor
46 # blinks. One is set by this resource. The other is set by
47 # control sequences (private mode 12 and DECSCUSR). Xterm-dev
48 # tests the XOR of the two variables.
49 #
50 # Enable Blinking Cursor (resource cursorblink)
51 # Enable (or disable) the blinking-cursor feature. This
52 # corresponds to the -bc option and the cursorBlink
53 # resource. There is also an escape sequence (see Xterm-
54 # dev Control Sequences). The menu entry and the escape
55 # sequence states are XOR'd: if both are enabled, the
56 # cursor will not blink, if only one is enabled, the cursor
57 # will blink.
58 #
59 # set-cursorblink(on/off/toggle)
60 # This action sets, unsets or toggles the cursorBlink resource.
61 # It is also invoked from the cursorblink entry in vtMenu.
62 #
63 # Control sequences:
64 #
65 # CSI ? Pm h
66 # DEC Private Mode Set (DECSET).
67 # Ps = 1 2 -> Start Blinking Cursor (att610).
68 #
69 # CSI ? Pm l
70 # DEC Private Mode Reset (DECRST).
71 # Ps = 1 2 -> Stop Blinking Cursor (att610).
72 #
73 # CSI Ps SP q
74 # Set cursor style (DECSCUSR, VT520).
75 # Ps = 0 -> blinking block.
76 # Ps = 1 -> blinking block (default).
77 # Ps = 2 -> steady block.
78 # Ps = 3 -> blinking underline.
79 # Ps = 4 -> steady underline.
80 # Ps = 5 -> blinking bar (xterm).
81 # Ps = 6 -> steady bar (xterm).
82 #
83 use strict;
84
85 use Term::ReadKey;
86
87 use IO::Handle;
88 STDERR->autoflush(1);
89 STDOUT->autoflush(1);
90
91 our %DECSET = (
92 "\e[?12h", "Start Blinking Cursor (AT&T 610)",
93 "\e[?12l", "Stop Blinking Cursor (AT&T 610)"
94 );
95
96 our %DECSCUSR = (
97 "\e[0 q",
98 "blinking block",
99 "\e[1 q",
100 "blinking block (default)",
101 "\e[2 q",
102 "steady block",
103 "\e[3 q",
104 "blinking underline",
105 "\e[4 q",
106 "steady underline",
107 "\e[5 q",
108 "blinking bar (xterm)",
109 "\e[6 q",
110 "steady bar (xterm)"
111 );
112
113 sub show($$) {
114 my $seq = shift;
115 my $txt = shift;
116 printf "%s -> %s\n", &visible($seq), $txt;
117 }
118
119 sub get_reply($$) {
120 my $seq = shift;
121 my $end = shift;
122 printf STDERR "%s", $seq;
123 my $key;
124 my $result = "";
125 $key = ReadKey(0);
126 $result .= $key;
127 if ( $key eq "\e" ) {
128
129 while (1) {
130 $key = ReadKey(100);
131 $result .= $key;
132 next if ( length($result) < length($end) );
133 last if ( substr( $result, -length($end) ) eq $end );
134 }
135 }
136 return $result;
137 }
138
139 sub mode_value($) {
140 my $value = shift;
141 if ( $value eq 1 ) {
142 $value = "set";
143 }
144 elsif ( $value eq 2 ) {
145 $value = "reset";
146 }
147 elsif ( $value eq 3 ) {
148 $value = "*set";
149 }
150 elsif ( $value eq 4 ) {
151 $value = "*reset";
152 }
153 else {
154 $value = &visible( "?" . $value );
155 }
156 return $value;
157 }
158
159 sub DECRQM($) {
160 my $mode = shift;
161 my $sequence = sprintf( "\e[?%d\$p", $mode );
162 my $reply = &get_reply( $sequence, "y" );
163 if ( $reply =~ /^\e\[\?$mode;\d+\$y$/ ) {
164 $reply =~ s/^\e\[\?$mode;(\d+)\$y$/$1/;
165 }
166 return &mode_value($reply);
167 }
168
169 sub DECRQSS($) {
170 my $request = shift;
171 my $ending = "\e\\";
172 my $sequence = sprintf( "\eP\$q%s$ending", $request );
173 my $reply = &get_reply( $sequence, $ending );
174
175 # xterm responds with
176 # DCS 1 $ r Pt ST for valid requests,
177 # DCS 0 $ r Pt ST for invalid requests.
178 #if ( $reply =~ /^\eP1\$r.*$ending$/ ) {
179 if ( $reply =~ /^\eP1\$r\d+ q\e\\$/ ) {
180 $reply =~ s/^\eP1\$r(\d+) q\e\\$/$1/;
181 }
182 return &visible($reply);
183 }
184
185 sub get_key() {
186 my $key;
187 do {
188 $key = ReadKey(0);
189 if ( $key eq "\e" ) {
190 while ( ReadKey(10) !~ /[@-~]/ ) {
191 #
192 }
193 }
194 } while ( $key eq "\e" );
195 return $key;
196 }
197
198 sub visible($) {
199 my $txt = shift;
200 $txt =~ s/\e/\\e/g;
201 $txt =~ s/\a/\\a/g;
202 return $txt;
203 }
204
205 sub test($$) {
206 my $set = shift;
207 my $msg = shift;
208
209 ReadMode 'raw';
210
211 printf STDERR "%s\t[", &visible($set);
212
213 # save the cursor position
214 printf STDERR "\e7";
215
216 # send the escape sequence
217 printf STDERR "%s", $set;
218
219 # print the description
220 printf STDERR "X] ";
221
222 printf STDERR " [C=%s,", &DECRQSS(" q");
223 printf STDERR "B=%s,", &DECRQM(12);
224 printf STDERR "M=%s,%s]", &DECRQM(13), &DECRQM(14);
225 printf STDERR " %s", $msg;
226 printf STDERR "\e[0J";
227
228 # restore the cursor position
229 printf STDERR "\e8";
230
231 # wait for any key
232 my $key = &get_key;
233 ReadMode 'restore';
234
235 # print newline
236 printf STDERR "\n";
237
238 # A backspace response makes the current line reprint (to test menus)
239 return ( $key ne "\b" and $key ne "\177" ) ? 1 : 0;
240 }
241
242 if ( -t STDOUT ) {
243 printf "Legend:\n";
244 printf " C = cursor shape (1,2 block, 3,4 underline, 5,6 left-bar)\n";
245 printf " B = escape-sequence blink\n";
246 printf " M = menu blink and XOR mode\n";
247 printf "\n";
248 printf "An asterisk means the mode is always set or reset.\n";
249 printf "Press any key to proceed; press backspace to reprint line.\n";
250 printf "\n";
251 my @DECSET = sort keys %DECSET;
252 my @DECSCUSR = sort keys %DECSCUSR;
253
254 for ( my $h = 0 ; $h <= $#DECSET ; ++$h ) {
255 $h-- unless &test( $DECSET[$h], $DECSET{ $DECSET[$h] } );
256 }
257 for my $l ( 0 .. $#DECSCUSR ) {
258 $l-- unless &test( $DECSCUSR[$l], $DECSCUSR{ $DECSCUSR[$l] } );
259 }
260 }
261 else {
262 printf "DECSET (AT&T 610 blinking cursor):\n";
263 for my $key ( sort keys %DECSET ) {
264 &show( $key, $DECSET{$key} );
265 }
266
267 printf "DECSCUSR:\n";
268 for my $key ( sort keys %DECSCUSR ) {
269 &show( $key, $DECSCUSR{$key} );
270 }
271 }
272 1;