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 $TERMCAP = $ENV{'TERMCAP'};
22 $TERMCAP = '/etc/termcap' unless $TERMCAP;
23 if ($TERMCAP !~ m:^/:) {
24 if ($TERMCAP !~ /(^|\|)$TERM[:\|]/) {
25 $TERMCAP = '/etc/termcap';
28 if ($TERMCAP =~ m:^/:) {
32 open(TERMCAP,'<$TERMCAP') || die \"Can't open $TERMCAP\";
36 if (/(^|\\|)$TERM\[:\\|]/) {
38 while (chop eq '\\\\') {
50 } while s/:tc=([^:]+):/:/ && ($TERM = $1);
54 foreach $field (split(/:[\s:\\]*/,$TERMCAP)) {
55 if ($field =~ /^\w\w$/) {
58 elsif ($field =~ /^(\w\w)#(.*)/) {
59 $TC{$1} = $2 if $TC{$1} eq '';
61 elsif ($field =~ /^(\w\w)=(.*)/) {
65 s/\\(\d\d\d)/pack('c',$1 & 0177)/eg;
73 s/\^(.)/pack('c',ord($1) & 31)/eg;
76 $TC{$entry} = $_ if $TC{$entry} eq '';
79 $TC{'pc'} = "\0" if $TC{'pc'} eq '';
80 $TC{'bc'} = "\b" if $TC{'bc'} eq '';
83 @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);
86 local($string,$affcnt,$FH) = @_;
88 if ($string =~ /(^[\d.]+)(\*?)(.*)$/) {
92 $decr = $Tputs[$ospeed];
95 $string .= $TC{'pc'} x ($ms / $decr);
98 print $FH $string if $FH;
103 local($string) = shift(@_);
106 local($code,$tmp) = @_;
110 while ($string =~ /^([^%]*)%(.)(.*)/) {
115 $result .= sprintf("%d",shift(@tmp));
117 elsif ($code eq '.') {
119 if ($tmp == 0 || $tmp == 4 || $tmp == 10) {
121 ++$tmp, $after .= $TC{'up'} if $TC{'up'};
124 ++$tmp, $after .= $TC{'bc'};
127 $result .= sprintf("%c",$tmp);
130 elsif ($code eq '+') {
131 $result .= sprintf("%c",shift(@tmp)+ord($string));
132 $string = substr($string,1,99);
135 elsif ($code eq 'r') {
140 elsif ($code eq '>') {
141 ($code,$tmp,$string) = unpack("CCa99",$string);
142 if ($tmp[$[] > $code) {
146 elsif ($code eq '2') {
147 $result .= sprintf("%02d",shift(@tmp));
150 elsif ($code eq '3') {
151 $result .= sprintf("%03d",shift(@tmp));
154 elsif ($code eq 'i') {
156 @tmp = ($code+1,$tmp+1);
162 $result . $string . $after;