1#!/usr/bin/env perl
2# $XTermId: dynamic.pl,v 1.5 2018/08/10 15:01:35 tom Exp $
3# -----------------------------------------------------------------------------
4# this file is part of xterm
5#
6# Copyright 2011-2017,2018 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# Test the dynamic-color query option of xterm.
35# The programs xtermcontrol and xtermset provide more options.
36
37use strict;
38use warnings;
39
40use Getopt::Std;
41use IO::Handle;
42
43our @color_names = (
44    "VT100 text foreground",
45    "VT100 text background",
46    "text cursor",
47    "mouse foreground",
48    "mouse background",
49    "Tektronix foreground",
50    "Tektronix background",
51    "highlight background",
52    "Tektronix cursor",
53    "highlight foreground"
54);
55
56our ( $opt_c, $opt_r );
57
58$Getopt::Std::STANDARD_HELP_VERSION = 1;
59&getopts('c:r') || die(
60    "Usage: $0 [options]\n
61Options:\n
62  -c XXX  set cursor-color
63  -r      reset colors
64"
65);
66
67sub no_reply($) {
68    open TTY, "+</dev/tty" or die("Cannot open /dev/tty\n");
69    autoflush TTY 1;
70    my $old = `stty -g`;
71    system "stty raw -echo min 0 time 5";
72
73    print TTY @_;
74    close TTY;
75    system "stty $old";
76}
77
78sub get_reply($) {
79    open TTY, "+</dev/tty" or die("Cannot open /dev/tty\n");
80    autoflush TTY 1;
81    my $old = `stty -g`;
82    system "stty raw -echo min 0 time 5";
83
84    print TTY @_;
85    my $reply = <TTY>;
86    close TTY;
87    system "stty $old";
88    if ( defined $reply ) {
89        die("^C received\n") if ( "$reply" eq "\003" );
90    }
91    return $reply;
92}
93
94sub query_color($) {
95    my $code   = $_[0];
96    my $param1 = $code + 10;
97    my $reply;
98
99    $reply = get_reply("\x1b]$param1;?\007");
100
101    return unless defined $reply;
102    if ( $reply =~ /\x1b]$param1;.*\007/ ) {
103        my $value = $reply;
104
105        $value =~ s/^\x1b]$param1;//;
106        $value =~ s/\007//;
107
108        printf "%24s = %s\n", $color_names[$code], $value;
109    }
110}
111
112sub query_colors() {
113    my $n;
114
115    for ( $n = 0 ; $n <= 9 ; ++$n ) {
116        &query_color($n);
117    }
118}
119
120sub reset_colors() {
121    my $n;
122
123    for ( $n = 0 ; $n <= 9 ; ++$n ) {
124        my $code = 110 + $n;
125        &no_reply("\x1b]$code\007");
126    }
127}
128
129if ( defined($opt_c) ) {
130    &no_reply("\x1b]12;$opt_c\007");
131}
132if ( defined($opt_r) ) {
133    &reset_colors();
134}
135
136&query_colors();
137