1 ;# $RCSfile: termcap.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:24:16 $
5 ;# ioctl(TTY,$TIOCGETP,$foo);
6 ;# ($ispeed,$ospeed) = unpack('cc',$foo);
7 ;# require 'termcap.pl';
8 ;# &Tgetent('vt100'); # sets $TC{'cm'}, etc.
9 ;# &Tputs(&Tgoto($TC{'cm'},$col,$row), 0, 'FILEHANDLE');
10 ;# &Tputs($TC{'dl'},$affcnt,'FILEHANDLE');
14 local($TERMCAP,$_,$entry,$loop,$field);
16 warn "Tgetent: no ospeed set" unless $ospeed;
17 foreach $key (keys(TC)) {
20 $TERM = $ENV{'TERM'} unless $TERM;
21 $TERM =~ s/(\W)/\\$1/g;
22 $TERMCAP = $ENV{'TERMCAP'};
23 $TERMCAP = '/etc/termcap' unless $TERMCAP;
24 if ($TERMCAP !~ m:^/:) {
25 if ($TERMCAP !~ /(^|\|)$TERM[:\|]/) {
26 $TERMCAP = '/etc/termcap';
29 if ($TERMCAP =~ m:^/:) {
33 open(TERMCAP,'<$TERMCAP') || die \"Can't open $TERMCAP\";
37 if (/(^|\\|)${TERM}[:\\|]/) {
39 while (chop eq '\\\\') {
51 } while s/:tc=([^:]+):/:/ && ($TERM = $1);
55 foreach $field (split(/:[\s:\\]*/,$TERMCAP)) {
56 if ($field =~ /^\w\w$/) {
59 elsif ($field =~ /^(\w\w)#(.*)/) {
60 $TC{$1} = $2 if $TC{$1} eq '';
62 elsif ($field =~ /^(\w\w)=(.*)/) {
66 s/\\(\d\d\d)/pack('c',$1 & 0177)/eg;
74 s/\^(.)/pack('c',ord($1) & 31)/eg;
77 $TC{$entry} = $_ if $TC{$entry} eq '';
80 $TC{'pc'} = "\0" if $TC{'pc'} eq '';
81 $TC{'bc'} = "\b" if $TC{'bc'} eq '';
84 @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);
87 local($string,$affcnt,$FH) = @_;
89 if ($string =~ /(^[\d.]+)(\*?)(.*)$/) {
93 $decr = $Tputs[$ospeed];
96 $string .= $TC{'pc'} x ($ms / $decr);
99 print $FH $string if $FH;
104 local($string) = shift(@_);
107 local($code,$tmp) = @_;
111 while ($string =~ /^([^%]*)%(.)(.*)/) {
116 $result .= sprintf("%d",shift(@tmp));
118 elsif ($code eq '.') {
120 if ($tmp == 0 || $tmp == 4 || $tmp == 10) {
122 ++$tmp, $after .= $TC{'up'} if $TC{'up'};
125 ++$tmp, $after .= $TC{'bc'};
128 $result .= sprintf("%c",$tmp);
131 elsif ($code eq '+') {
132 $result .= sprintf("%c",shift(@tmp)+ord($string));
133 $string = substr($string,1,99);
136 elsif ($code eq 'r') {
141 elsif ($code eq '>') {
142 ($code,$tmp,$string) = unpack("CCa99",$string);
143 if ($tmp[$[] > $code) {
147 elsif ($code eq '2') {
148 $result .= sprintf("%02d",shift(@tmp));
151 elsif ($code eq '3') {
152 $result .= sprintf("%03d",shift(@tmp));
155 elsif ($code eq 'i') {
157 @tmp = ($code+1,$tmp+1);
163 $result . $string . $after;