7 @EXPORT = qw(&Tgetent &Tputs &Tgoto $ispeed $ospeed %TC);
9 # $RCSfile: termcap.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:24:16 $
13 # ioctl(TTY,$TIOCGETP,$foo);
14 # ($ispeed,$ospeed) = unpack('cc',$foo);
16 # &Tgetent('vt100'); # sets $TC{'cm'}, etc.
17 # &Tputs(&Tgoto($TC{'cm'},$col,$row), 0, 'FILEHANDLE');
18 # &Tputs($TC{'dl'},$affcnt,'FILEHANDLE');
22 local($TERMCAP,$_,$entry,$loop,$field);
24 warn "Tgetent: no ospeed set" unless $ospeed;
25 foreach $key (keys(%TC)) {
28 $TERM = $ENV{'TERM'} unless $TERM;
29 $TERM =~ s/(\W)/\\$1/g;
30 $TERMCAP = $ENV{'TERMCAP'};
31 $TERMCAP = '/etc/termcap' unless $TERMCAP;
32 if ($TERMCAP !~ m:^/:) {
33 if ($TERMCAP !~ /(^|\|)$TERM[:\|]/) {
34 $TERMCAP = '/etc/termcap';
37 if ($TERMCAP =~ m:^/:) {
41 open(TERMCAP,'<$TERMCAP') || croak \"Can't open $TERMCAP\";
45 if (/(^|\\|)${TERM}[:\\|]/) {
47 while (chop eq '\\\\') {
59 } while s/:tc=([^:]+):/:/ && ($TERM = $1);
63 foreach $field (split(/:[\s:\\]*/,$TERMCAP)) {
64 if ($field =~ /^\w\w$/) {
67 elsif ($field =~ /^(\w\w)#(.*)/) {
68 $TC{$1} = $2 unless defined $TC{$1};
70 elsif ($field =~ /^(\w\w)=(.*)/) {
74 s/\\(\d\d\d)/pack('c',oct($1) & 0177)/eg;
82 s/\^(.)/pack('c',ord($1) & 31)/eg;
85 $TC{$entry} = $_ unless defined $TC{$entry};
88 $TC{'pc'} = "\0" unless defined $TC{'pc'};
89 $TC{'bc'} = "\b" unless defined $TC{'bc'};
92 @Tputs = (0,200,133.3,90.9,74.3,66.7,50,33.3,16.7,8.3,5.5,4.1,2,1,.5,.2);
95 local($string,$affcnt,$FH) = @_;
97 if ($string =~ /(^[\d.]+)(\*?)(.*)$/) {
101 $decr = $Tputs[$ospeed];
104 $string .= $TC{'pc'} x ($ms / $decr);
107 print $FH $string if $FH;
112 local($string) = shift(@_);
115 local($code,$tmp) = @_;
119 while ($string =~ /^([^%]*)%(.)(.*)/) {
124 $result .= sprintf("%d",shift(@tmp));
126 elsif ($code eq '.') {
128 if ($tmp == 0 || $tmp == 4 || $tmp == 10) {
130 ++$tmp, $after .= $TC{'up'} if $TC{'up'};
133 ++$tmp, $after .= $TC{'bc'};
136 $result .= sprintf("%c",$tmp);
139 elsif ($code eq '+') {
140 $result .= sprintf("%c",shift(@tmp)+ord($string));
141 $string = substr($string,1,99);
144 elsif ($code eq 'r') {
149 elsif ($code eq '>') {
150 ($code,$tmp,$string) = unpack("CCa99",$string);
151 if ($tmp[$[] > $code) {
155 elsif ($code eq '2') {
156 $result .= sprintf("%02d",shift(@tmp));
159 elsif ($code eq '3') {
160 $result .= sprintf("%03d",shift(@tmp));
163 elsif ($code eq 'i') {
165 @tmp = ($code+1,$tmp+1);
171 $result . $string . $after;