#!/usr/local/bin/perl

#
# Copyright (c) 1992 The Ohio State University.
# All rights reserved.
#
# Redistribution and use in source and binary forms are permitted
# provided that: (1) source distributions retain this entire copyright
# notice and comment, and (2) distributions including binaries display
# the following acknowledgement:  ``This product includes software
# developed by The Ohio State University and its contributors''
# in the documentation or other materials provided with the distribution
# and in all advertising materials mentioning features or use of this
# software. Neither the name of the University nor the names of its
# contributors may be used to endorse or promote products derived
# from this software without specific prior written permission.
# THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
# Author:  Thomas A. Fine
# Email:   fine@cis.ohio-state.edu
# Org:     The Ohio State University Department of Computer and Information Sci.
# Thanks:  Frank Adelstein, J Greely
#


&gethosttype;
&getspeed;
&getsize;

$term=$ENV{'TERM'};

require 'termcap.pl';
&Tgetent($term);

#initialize some stuff

#special attributes default to standout
if ((! defined($TC{'us'})) || (! defined($TC{'ue'}))) {
  $TC{'us'}=$TC{'so'};
  $TC{'ue'}=$TC{'se'};
}
if (! defined($TC{'md'})) {
  $TC{'md'}=$TC{'us'};
  $TC{'me'}=$TC{'ue'};
}
$b_under_c=&Tputs($TC{'us'},1);
$e_under_c=&Tputs($TC{'ue'},1);
$b_stand_c=&Tputs($TC{'so'},1);
$e_stand_c=&Tputs($TC{'se'},1);
$b_bold_c= &Tputs($TC{'md'},1);
$e_all_c=  &Tputs($TC{'me'},1);

sub gethosttype {
  if (-r "/etc/sysinfo") {
    open(HOST,"/etc/sysinfo");
    $hosttype=<HOST>;
    chop($hosttype);
    $hosttype =~ s/:.*$//;
    close(HOST);
  }
  elsif (defined($ENV{'HOSTTYPE'})) {
    $hosttype=$ENV{'HOSTTYPE'};
  }
  else {
    print "Warning! Can't find hosttype\n";
  }
}

#STTY notes:
#
#O.K.  When I started this, I actually thought it would be simpler to use
#stty rather than straight ioctls, since I thought it would be more standard
#Live and learn.  Maybe I'll fix it sometime.
#
# system                      checks      prints to         comments
# SunOS 4.1
# cbreak/icanon
#   stty                      stdout      stderr            prints some stuff
#   stty -a                   stdout      stderr            prints ALL
#   stty everything           stdout      stderr            same as -a
#   stty all                  stdout      stderr            prints alot
#   stty speed                stdin       stdout
#   stty size                 stdin       stdout
#   stty -g                   stdin       stdout
#
# Dec ultrix 4.2a
# cbreak/icanon
#   stty                      stdout      stderr
#   stty -a                   stdout      stderr            prints ALL
#   stty -e                   stdout      stderr            prints ALL
#   stty everything           stdout      stderr            same as -e
#   stty all                  stdout      stderr            prints alot
#   stty speed                stdout      stdout           FUCK DEC! speed
#   stty size                 stdout      stdout           and size are useless
#   stty -g                   stdout      stderr            this works
#
# HP300 hpux 8.0
# cbreak
#  (no size parameters)
#   stty                      stdin       stdout
#   stty -a                   stdin       stdout            prints ALL
#   stty speed                                              doesn't work
#   stty size                                               doesn't work
#   stty -g                   stdin       stdout            no EOL
#
# HP700 hpux 8.0
# cbreak
#   stty                      stdin       stdout
#   stty -a                   stdin       stdout            prints ALL
#   stty speed                                              doesn't work
#   stty size                 stdin       stdout
#   stty -g                   stdin       stdout            no EOL
#
# Pyramid
# cbreak  (no min)
#   (still produces output when input is not a terminal)
#   stty                      stdout      stderr
#   stty everything           stdout      stderr            prints ALL
#   stty all                  stdout      stderr            prints alot
#   stty speed                magic       stdout            always works
#   stty size                 magic       stdout            always works
#   stty -g                                                 doesn't work
# icanon  (has min)
#   att stty                  stdin       stdout
#   att stty -a               stdin       stdout            prints ALL
#   att stty -g               stdin       stdout
#
# Multimax mmax320 running Mach   (acts just like pyramid in bsd universe)
# cbreak  (no min)
#   (still produces output when input is not a terminal)
#   stty                      stdout      stderr
#   stty everything           stdout      stderr            prints ALL
#   stty all                  stdout      stderr            prints alot
#   stty speed                magic       stdout            always works
#   stty size                 magic       stdout            always works
#   stty -g                                                 doesn't work
#


sub getspeed {
  if ($hosttype eq "mips" || $hosttype eq "decstation") {
    system("stty 2>/tmp/decsucks.$$");
    open(SPD,"/tmp/decsucks.$$");
    unlink("/tmp/decsucks.$$");
    while (<SPD>) {
      chop;
      if (/speed +[0-9]+ +baud/) {
	s/^.*speed +//;
	s/ +baud.*$//;
	$ispeed=$ospeed=$_;
	close(SPD);
	return;
      }
    }
    close(SPD);
    $ispeed=$ospeed=9600;
  }
  #them that can't do stty speed
  elsif ($hosttype eq "hp300" ||
         $hosttype eq "hp700") {
    open(SPD,"stty |");
    while (<SPD>) {
      chop;
      if (/speed +[0-9]+ +baud/) {
	s/^.*speed +//;
	s/ +baud.*$//;
	$ispeed=$ospeed=$_;
	close(SPD);
	return;
      }
    }
    close(SPD);
    $ispeed=$ospeed=9600;
  }
  else {
    open(SPD,"stty speed |");
    $ispeed=$ospeed=<SPD>;
    close SPD;
  }

  if (! $ospeed) {
    $ispeed=$ospeed=9600;
  }
}

sub getsize {
  local ($_);

  if ($hosttype eq "mips" || $hosttype eq "decstation") {
    system("stty all 2>/tmp/decsucks.$$");
    open(ROW,"/tmp/decsucks.$$");
    unlink("/tmp/decsucks.$$");
    while (<ROW>) {
      chop;
      if (/[0-9]+ +rows/) {
	$rows=$_;
	$rows =~ s/ +rows.*$//;
	$rows =~ s/^.* +//;
      }
      if (/[0-9]+ +columns/) {
	$columns=$_;
	$columns =~ s/ +columns.*$//;
	$columns =~ s/^.* +//;
      }
    }
    close(ROW);
  }
  #them that can't do stty size
  elsif ($hosttype eq "hp300") {
    #doesn't seem to have size available thru stty size
    #will set these at end
    $rows=0; $columns=0;
  }
  else {
    open(ROW,"stty size |");
    $_=<ROW>;
    chop;
    ($rows,$columns)=split(' ',$_);
    close(ROW);
  }

  if ($rows == 0) {
    if (defined($ENV{'LINES'})) {
      $rows=$ENV{'LINES'};
    }
    elsif (defined($TC{'li'})) {
      $rows=$TC{'li'};
    }
    else {
      $rows=24;
    }
  }

  if ($columns == 0) {
    if (defined($ENV{'COLUMNS'})) {
      $columns=$ENV{'COLUMNS'};
    }
    elsif (defined($TC{'co'})) {
      $columns=$TC{'co'};
    }
    else {
      $columns=80;
    }
  }
}

sub raw {
  &savestty;

  $|=1;
  if ($hosttype eq "Nothing so far fails to have stty raw") {
  }
  elsif ($hosttype eq "pyr") {
    system("stty raw -echo");
  }
  else {
    system("stty raw min 1 -echo");
  }
}

sub cbreak {
  &savestty;

  $|=1;
  if ($hosttype eq "hp300" ||
      $hosttype eq "hp700") {
    system("stty -icanon min 1 -echo");
  }
  elsif ($hosttype eq "pyr") {
    system("stty cbreak -echo");
  }
  else {
    system("stty cbreak min 1 -echo");
  }
}

sub savestty {
  if ($hosttype eq "mips" || $hosttype eq "decstation") {
    system("stty all 2>/tmp/decsucks.$$");
    open(SV,"/tmp/decsucks.$$");
    unlink("/tmp/decsucks.$$");
  }
  elsif ($hosttype eq "pyr") {
    open(SV,"att stty -g |");
  }
  else {
    open(SV,"stty -g |");
  }
  if (! defined ($CUSSsavetty)) {
    $CUSSsavetty=<SV>;
    close(SV);
    chop $CUSSsavetty;
  }
}

sub reset {
  if ($hosttype eq "pyr") {
    system("att stty $CUSSsavetty");
  }
  else {
    system("stty $CUSSsavetty");
  }
}

sub getcin {
  local($pattern) = $_[0];
  local($function) = $_[1];
  local($c);

  if ($pattern eq "") { $pattern="\000-\177"; }

  while (!(($c=getc)=~/[$pattern]/)) {
    if ($function eq "") { &beep; }
    else { &$function; }
  }
  $c;
}

sub getstring {
  local($maxlen) = $_[0];
  local($pattern) = $_[1];
  if ($pattern eq "") { $pattern="\000-\177"; }
  local($default) = $_[2];
  local($ret) = $default;
  local($c);

  local($done)=0; local($nc)=length($default);
  print $default;
  while (! $done) {
    $c=&getcin("\n$pattern");
    if ($c eq "" || $c eq "") {
      if ($nc == 0) { print ""; }
      else {
	print " ";
	$ret =~ s/.$//;
	--$nc;
      }
    }
    elsif ($c eq "\n") {
      $done=1;
    }
    else {
      if ($maxlen != 0 && $nc == $maxlen) { print ""; }
      else {
	print $c;
	$ret .= $c;
	++$nc;
      }
    }
  }
  $ret;
}

sub showmess {
  &mvcurs(0,$rows);
  &cleartoeol;
  print $_[0], " ('any' key to continue)";
  getc;
  &mvcurs(0,$rows);
  &cleartoeol;
  &mvcurs($curscol,$cursrow);
}

sub yorn {
  if (&ask("$_[0] (y or n)") eq "y") { return(1); }
  return(0);
}

sub ask {
  $ret=0;
  &mvcurs(0,$rows);
  &cleartoeol;
  print $_[0];
  $ret=getc;
  &mvcurs(0,$rows);
  &cleartoeol;
  &mvcurs($curscol,$cursrow);
  $ret;
}

sub cleartoeol {
  &Tputs($TC{'ce'},1,STDOUT);
}

sub clearscreen {
  &Tputs($TC{'cl'},1,STDOUT);
}

sub scrollup {
  if (defined($TC{'cs'})) {
    &setregion(0,$rows-1);
    &mvcurs(0,$rows-1);
    print $_[0];
    &Tputs($TC{'do'},1,STDOUT);
  }
  else {
    &mvcurs(0,$rows-1);
    &Tputs($TC{'al'},1,STDOUT);
    print $_[0];
    if (index($_[0],"\n") < 0) { print "\n"; }
  }
  &mvcurs($curscol,$cursrow);
}

sub scrolldown {
  if (defined($TC{'cs'})) {
    &setregion(0,$rows-1);
  }
  &mvcurs(0,0);
  &Tputs($TC{'sr'},1,STDOUT);
  print $_[0];
  &mvcurs(0,$rows-1);
  &cleartoeol;
  &mvcurs($curscol,$cursrow);
}

sub scrregup {
  &mvcurs(0,$_[0]);
  &Tputs($TC{'dl'},1,STDOUT);
  &mvcurs(0,$_[1]);
  &Tputs($TC{'al'},1,STDOUT);
  print $_[2];
}

sub scrregdown {
  &mvcurs(0,$_[1]);
  &Tputs($TC{'dl'},1,STDOUT);
  &mvcurs(0,$_[0]);
  &Tputs($TC{'al'},1,STDOUT);
  print $_[2];
}

sub setregion {
  if (! defined($TC{'cs'})) {
    return;
  }
  &Tputs(&Tgoto($TC{'cs'},$_[0],$_[1]), 0, STDOUT);
}

sub mvcurs {
  &Tputs(&Tgoto($TC{'cm'},$_[0],$_[1]), 0, STDOUT);
}

sub beep {
  &Tputs($TC{'bl'},1,STDOUT);
}


sub lineedit {
  $maxlen=$_[0];  $prompt=$_[1];  $default=$_[2];
  $pattern="\000-\177";
  local($yankbuf)=("");
  local($i);

  $ret=$default; $pos=length($ret);
  $done=0; $nc=length($ret); $chist= -1;

  print "$prompt$ret";

  while (! $done) {
    while (!(($c=getc)=~/[\n$pattern]/)) { print ""; }
    if ($c eq "" || $c eq "") {
      if ($pos == 0) { print ""; }
      else {
	print "";
	&Tputs($TC{'dc'},1,STDOUT);
	substr($ret,$pos-1) = substr($ret,$pos);
	--$nc;
	--$pos;
      }
    }
    elsif ($c eq "") {
      if ($pos == $nc) { print ""; }
      else {
	&Tputs($TC{'dc'},1,STDOUT);
	substr($ret,$pos) = substr($ret,$pos+1);
	--$nc;
      }
    }
    elsif ($c eq "") {
      for(; $pos>0; --$pos) { print ""; }
    }
    elsif ($c eq "") {
      for(; $pos<$nc; ++$pos) { &Tputs($TC{'nd'},1,STDOUT); }
    }
    elsif ($c eq "") {
      if ($pos == 0) { print ""; }
      else {
	print "";
	--$pos;
      }
    }
    elsif ($c eq "") {
      if ($pos == $nc) { print ""; }
      else {
	&Tputs($TC{'nd'},1,STDOUT);
	++$pos;
      }
    }
    elsif ($c eq "") {
      &cleartoeol;
      $yankbuf=substr($ret,$pos);
      substr($ret,$pos) = "";
      $nc=$pos;
    }
    elsif ($c eq "") {
      if ($yankbuf eq "") { &beep; }
      else {
	for ($i=0; $i<length($yankbuf); ++$i) {
	  &Tputs($TC{'ic'},1,STDOUT);
	}
	print $yankbuf;
	substr($ret,$pos) = $yankbuf . substr($ret,$pos);
	$nc+=length($yankbuf);
	$pos+=length($yankbuf);
      }
    }
    elsif ($c eq "") {
      &mvbol;
      for ($i=0; $i<int(length($prompt.$ret)/80); ++$i) { &cleartoeol; &mvup; }
      &cleartoeol;
      print "$prompt$ret";
      for($cpos=length($ret); $cpos!=$pos; --$cpos) { print ""; }
    }
    elsif ($c eq "") {
      if ($chist == $#history) { print ""; }
      else {
	if ($chist == -1) { $sret=$ret; }
	&mvbol;
	&cleartoeol;
	$ret = $history[++$chist];
	print "$prompt$ret";
	$nc=$pos=length($ret);
      }
    }
    elsif ($c eq "") {
      if ($chist == -1) { print ""; }
      else {
	&mvbol;
	&cleartoeol;
	if (--$chist == -1) { $ret=$sret; }
	else { $ret = $history[$chist]; }
	print "$prompt$ret";
	$nc=$pos=length($ret);
      }
    }
    elsif ($c eq "\n") {
      $done=1;
      if ($nc != 0) {
	unshift(@history,$ret);
	if ($#history > $maxhist) { pop(@history); }
      }
    }
    else {
      if ($maxlen != 0 && $nc == $maxlen) { print ""; }
      else {
	&Tputs($TC{'ic'},1,STDOUT);
	print $c;
	substr($ret,$pos) = $c . substr($ret,$pos);
	++$nc;
	++$pos;
      }
    }
  }
  $ret;
}

sub mvup {
  if (defined($TC{'up'})) {
    &Tputs($TC{'up'},1,STDOUT);
  }
  else {
    print "";
  }
}

sub mvbol {
  if (defined($TC{'cr'})) {
    &Tputs($TC{'cr'},1,STDOUT);
  }
  else {
    print "\r";
  }
}

sub beginunder {
  &Tputs($TC{'us'},1,STDOUT);
}

sub endunder {
  &Tputs($TC{'ue'},1,STDOUT);
}

sub beginstand {
  &Tputs($TC{'so'},1,STDOUT);
}

sub endstand {
  &Tputs($TC{'se'},1,STDOUT);
}

sub beginbold {
  &Tputs($TC{'md'},1,STDOUT);
}

sub endall {
  &Tputs($TC{'me'},1,STDOUT);
  &endunder;
  &endstand;
}


1;
