#! /usr/bin/perl
# program for interactive ld-expansion and ld-reduction of a term
# active positions are accessible by labels or numbers
# labels are preserved by expansion, i.e. are constant on threads given by the natural embedding
# actions include the application of the dilatation operator and an reduction algorithm
# structure of active positions can be visualized
# term is presented together with a scale (adjust $width to your screen if neccessary)
#
# written by Oliver Deiser, 2002


use Tk;
use strict;
# use warnings;
use FileHandle; STDOUT->autoflush(1);
require Tk::BrowseEntry;
require Tk::Dialog;

my $t;                            ## main varible:   term
my $ts = "11100";                 ## start-term
my $count = 0;
my $countexp = 0;
my $countred = 0;
my $exp;                          ## main variable:  expansion positions, labeled with letters a, b, c, ...
my $red;                          ## main variable:  reduction positions, labeled with '~'
my @letters = letters();          # letters a-z, A-Z, 0-9
my $nextletter = 0;
my @answer = "";
my ($input, $i, $k);
my $width = 115;
my $main = MainWindow->new;
my $text;
my $font = 'Roman 12';
my $act = "";
my $po = "";
$main->title("Interactive Expansions and Reductions of Terms for Left Distributivity (Program by Oliver Deiser, 2002)");
$main->geometry("1024x768+0+0");

#colors 
my $bc1 = "#bde7ff";   # button colors
my $bc2 = "#70bfef";
my $bc3 = "#3b8bdb";
my $bgc1 = "#14107f";  # background colors frames
my $bgc2 = "#5869d3";
my $posc = "#a5c1ce";  # pos: color
my $cc = "#5b97b7";    # counter color
my $scroll_c1 = $bgc2;
my $scroll_c2 = $bgc1;
my $scroll_c3 = $bgc1;

my $frame = $main->Frame(-background => $bgc1);

my $topframe = $frame->Frame(-background => $bgc1);
my $button1 = $topframe->Button(-text => "Exit",
			     -command => sub { exit; },
			     -background => $bc1,
			    )->pack(-side => 'top', -fill => 'x', padx => '5');
my $button2 = $topframe->Button(-text => "Start",
			     -command => sub { start(); },
			     -background => $bc1,
 			    )->pack(-side => 'top', -fill => 'x', padx => '5');
my $button3 = $topframe->Button(-text => "Info",
			     -command => sub { info(); },
			     -background => $bc1,
			    )->pack(-side => 'top', -fill => 'x', padx => '5');
my $button4 = $topframe->Button(-text => "Relabel",
			     -command => sub { $exp = relabel($t); repack(); display($t); },
			     -background => $bc2,
			    )->pack(-side => 'top', -fill => 'x', padx => '5');
my $button5 = $topframe->Button(-text => "Top",
			     -command => sub { $text->delete("1.0", 'end'); tags(); display($t); },
			     -background => $bc2,
			    )->pack(-side => 'top', -fill => 'x', padx => '5');
my $button6 = $topframe->Button(-text => "Structure",
			     -command => sub { my @es = extenders($t); showrange($t, \@es); },
			     -background => $bc3,
			    )->pack(-side => 'top', -fill => 'x', padx => '5');
my $button7 = $topframe->Button(-text => "Delta",
			     -command => sub { my $a = warning(); if ($a) { $t = deltaop($t); $exp = relabel($t);
					       repack(); display($t); countreset(); } },
			     -background => $bc3,
			    )->pack(-side => 'top', -fill => 'x', padx => '5');
my $button8 = $topframe->Button(-text => "Reduce",
			     -command => sub { $t = reduce_alg($t); $exp = relabel($t);
					       repack(); display($t); countreset(); },
			     -background => $bc3,
			    )->pack(-side => 'top', -fill => 'x', padx => '5');
$topframe->pack(-side => 'top', -pady => '8', -padx => '4', -fill => 'x');

my $inframe = $frame->Frame(-background => $bgc1, -borderwidth => '4');
my $inframe1 = $inframe->Frame(-background => $bgc1, -borderwidth => '0');
my $poslab = $inframe1->Label(-text => 'Pos: ', -background => $posc)->pack(-side => 'left');
my $posent = $inframe1->Entry(-textvariable => \$po, -width => '5',
			    )->pack(-side => 'left', -fill => 'x', -expand => '1');
$inframe1->pack(-pady => '0', side => 'top', fill => 'x');
my $inframe2 = $inframe->Frame(-background => $bgc1, -borderwidth => '0');
my $cb1 = $inframe2->Radiobutton(-text => "e", -background => $posc, 
				 -variable => \$act,
				 -value => 'e',
				 -command => sub { action($act, $po); },
				)->pack(-side => 'left', expand => '1');
my $cb2 = $inframe2->Radiobutton(-text => "r", -background => $posc,
				 -variable => \$act,
				 -value => 'r',
				 -command => sub { action($act, $po); },
			       )->pack(-side => 'left', expand => '1');
my $cb3 = $inframe2->Radiobutton(-text => "s", -background => $posc,
				-variable => \$act,
				-value => 's',
				-command => sub { action($act, $po); },
				)->pack(-side => 'left', expand => '1');
$inframe2->pack(-pady => '0', -side => 'top', fill => 'x', expand => '1');
$inframe->pack(-pady => '8', -padx => '2', -side => 'top', fill => 'x');

my $countframe = $frame->Frame(-background => $bgc1);
my $countframe1 = $countframe->Frame(-background => $bgc2);
my $cl1 = $countframe1->Label(-text => "Steps:", -background => $cc
			   )->pack(-side => 'left', -fill => 'x', -expand => '1');
my $cl2 = $countframe1->Label(-textvariable => \$count, -background => $cc,
			   )->pack(-side => 'left', -fill => 'x', -expand => '1');
$countframe1->pack(-side => 'top', -anchor => 'n', -fill => 'x', -padx => '4', -pady => '1');

my $countframe2 = $countframe->Frame(-background => $bgc2);
my $cl21 = $countframe2->Label(-text => "Exps: ", -background => $cc,
			   )->pack(-side => 'left', -fill => 'x', -expand => '1');
my $cl22 = $countframe2->Label(-textvariable => \$countexp, -background => $cc,
			   )->pack(-side => 'left', -fill => 'x', -expand => '1');
$countframe2->pack(-side => 'top', -anchor => 'n', -fill => 'x', -padx => '4', -pady => '1');

my $countframe3 = $countframe->Frame(-background => $bgc2);
my $cl31 = $countframe3->Label(-text => "Reds: ", -background => $cc, 
			   )->pack(-side => 'left', -fill => 'x', -expand => '1');
my $cl32 = $countframe3->Label(-textvariable => \$countred, -background => $cc,
			   )->pack(-side => 'left', -fill => 'x', -expand => '1');
$countframe3->pack(-side => 'top', -anchor => 'n', -fill => 'x', -padx => '4', -pady => '1');
$countframe->pack(-pady => '8', -padx => '2', -side => 'top', fill => 'x');

$frame->pack(-side => 'right', -anchor => 'n', -fill => 'y');

my $frame2 = $main->Frame(-background => $bgc2);
my $browse1 = $frame2->BrowseEntry(-label => "Start Term", -width => "30",
				   -choices => [
						"11100",
						"xyz00",
						"110111000",
						"111011000",
						"11010111000",
						"1110101100100",
						"1101011101000",
						"1110101110000",
						"1101010111000",
						"111010101110000",
						"110101011110000",
						"111010101110000",
						"11101010101100111010110001000",
						"11011001111010011001010101110001000"], 
				   -variable => \$ts,
				  )->pack(-side => 'left',
					  -pady => '6',
					  -padx => '5',
					  -expand => '1');

my $browse1b = $frame2->BrowseEntry(-label => "Width", -width => '10', 
				   -choices => [ '60', '80', '90', '100', '110',
						 '120', '150', '200', '300', '500', '1000' ],
				   -variable => \$width,
				  )->pack(-side => 'right',
				   -pady => '6', -padx => '5',
				   -expand => '1');

my $browse1c = $frame2->BrowseEntry(-label => "Font", -width => '10', 
				    -choices => [ 'Roman 8', 'Roman 9', 'Roman 10',
						  'Roman 12', 'Roman 14',
						  'Courier 5',
						  'Courier 8',
						  'Courier 10',
						  'Courier 12',
						  'Courier 12 bold',
						  'Helvetika 10',
						],
				   -variable => \$font,
				  )->pack(-side => 'right',
				   -pady => '6', -padx => '5',
				   -expand => '1');



$frame2->pack(-side => 'top', -fill => 'x');

my @expbut;


my $frame_expred = $main->Frame(-background => $bgc2, -borderwidth => '6');
$frame_expred->pack(-side => 'bottom', -anchor => 'w', -fill => 'x');

my $frame3 = $frame_expred->Frame(-background => $bgc2);            # frame for expansions
$frame3->pack(-side => 'bottom', -anchor => 'w', -fill => 'x');

my $frame4 = $frame_expred->Frame(-background => $bgc2);            # frame for reductions
$frame4->pack(-side => 'bottom', -anchor => 'w', -fill => 'x');

my $frametext = $main->Frame(-background => $bgc2);
my $y_scroll = $frametext->Scrollbar(-troughcolor => $scroll_c1,
				     -background => $scroll_c2,
				     -activebackground => $scroll_c3,	
				     -highlightthickness => '0',
                                     -elementborderwidth => '0',
				     -borderwidth => '0',
				    );
my $x_scroll = $frametext->Scrollbar(-orient => 'horizontal',
				     -troughcolor => $scroll_c1,
				     -background => $scroll_c2,
				     -activebackground => $scroll_c3,
				     -highlightthickness => '0',
                                     -elementborderwidth => '0',
				     -borderwidth => '0',
				    );
$text = $frametext->Text(-borderwidth => 2,
			    -foreground => 'black',
			    -background => 'white',
			    -font => $font,
			    -padx => '18',
			    -pady => '2', 
			    -yscrollcommand => ['set' => $y_scroll],	
			    -xscrollcommand => ['set' => $x_scroll],
			    -wrap => 'none',
			    -spacing3 => '3',
			   );
$y_scroll->configure(-command => ['yview' => $text]);
$x_scroll->configure(-command => ['xview' => $text]);
$y_scroll->pack(-side => 'left', -fill => 'both');
$x_scroll->pack(-side => 'bottom', -fill => 'both');
$text->pack(-side => 'left',
	    -anchor => 'c',
	    -padx => '6', -pady => '3',
	    -fill => 'both',
	    -expand => '1',
	   );
$frametext->pack(-fill => 'both', -expand => '1');

tags();
MainLoop;

#######################

sub tags { 
  $text->tagConfigure('c1', -foreground => "#af8624", -font => $font);
  $text->tagConfigure('c2', -foreground => "#0b0c0b", -font => $font);  
  $text->tagConfigure('c3', -foreground => "#1313c6", -font => $font . " bold");
  $text->tagConfigure('c4', -foreground => "#299e2d", -font => $font . " bold");
  $text->tagConfigure('c5', -foreground => "#d6374c", -font => $font . " bold");
}

sub repack {
  packexp();
  packred();
  $po = length($t) - 1;
}


sub packexp {
  my $i;
  my @w = $frame3->packSlaves;
  my %h = %{letters_to_pos()};

  foreach (@w) { $_->packForget; }
  @expbut = 0;
  my $n = 0;   # number of entries 
  for($i = 0; $i < $nextletter and $n < 26; $i++) {
    my $c = $letters[$i];
 #   if ($i <= 25) { $c = chr(97 + $i); }
 #   else { $c = chr(65 + $i - 26); }

    if (defined($h{$c}) and substr($exp, $h{$c}, 1) ne ' ') {
      $expbut[$i] = $frame3->Button(-text => "$c",
				    -width => 1.5, -height => 1.5, 
				    -font => "r14",
				    -background => "#28c430",
				    -foreground => "black",
				    -command => sub { $t = expand_at($t, $h{$c});
						      repack(); display($t); },
				   )->pack(-side => 'left', pady => '0');
      $n++;
    }
  }
  $frame3->pack(-side => 'bottom', -anchor => 'w');

}

sub packred {
  my $i;
  my @w = $frame4->packSlaves;
  my %h = %{letters_to_pos()};
  $red = reductions($t);
  foreach (@w) { $_->packForget; }
  @expbut = 0;
  my $n = 0;   # number of entries 
  for($i = 0; $i < $nextletter and $n < 26; $i++) {
    my $c = $letters[$i];
 #   if ($i <= 25) { $c = chr(97 + $i); }
 #   else { $c = chr(65 + $i - 26); }
    if (defined($h{$c}) and substr($red, $h{$c}, 1) eq '~') {
      $expbut[$i] = $frame4->Button(-text => "$c",
				    -width => 1.5, -height => 1.5, 
				    -font => "r14",
				    -background => "#d6374c",
				    -foreground => "black",
				    -command => sub { $t = reduce_at($t, $h{$c});
						      repack(); display($t); },
				   )->pack(-side => 'left', pady => '0');
      $n++;
    }
  }
  $frame4->pack(-side => 'bottom', -anchor => 'w');
}


sub start {
  $t = $ts;
  if (termtest($t) == 0) {
    $text->delete("1.0", 'end');
    $text->insert("end", "\n\nThis is no term!\n\n", 'c4');
    return;
  }
  $po = length($t) - 1;
  $nextletter = 0;
  $count = 0;
  $countexp = 0;
  $countred = 0;
  $exp = label($t);
  $red = reductions($t);
  repack();
  $text->delete("1.0", 'end');
  $text->insert('1.0', "");
  tags();
  display($t);
}

sub countreset {
  $count = 0;
  $countexp = 0;
  $countred = 0;
}

sub action {
  my $act = $_[0];
  my $pos = $_[1];
  if ($act eq 'e' and substr($t, $pos - 1, 2) eq "00") {
    $t = expand_at($t, $pos);
    repack();
    display($t);
  }
  elsif ($act eq 'r' and substr($t, $pos - 1, 2) eq "00") {
    $red = reductions($t);
    if (substr($red, $pos, 1) eq "~") {
      $t = reduce_at($t, $pos);
      repack();
      display($t);
    }
  }
  elsif ($act eq 's' and substr($t, $pos - 1, 2) eq "00") {
    my @es = ($pos);
    showrange($t, \@es);
  }
}





sub scale {              # print a scale for the term according to $width
  my $st = $_[0];
  my ($i, $j);
  for ($i = 0; $i < $width/5; $i++) {
    $j = $i * 5 + $st;
    my $str =  "$j" . " " x (5 - length($j));
    $text->insert('end', $str, 'c1'); 
  }
  $text->insert('end', "\n");
  for ($i = 0; $i < $width/5; $i++) {
    $text->insert('end', "|    ", 'c1'); 
  }
  $text->insert('end', "\n", 'c1');
}

sub display {            # display term, labels of expansion pos., labels of reduction pos.
  my $t = $_[0];         # format this according to $width
  my $l = length($t);
  my $lines = int($l/$width) + 1;
  my ($i, $k);
  my @parts_t;
  my @parts_exp;
  my @parts_red;
  $red = reductions($t);  # get reduction positions
  for ($i = 0; $i < $lines; $i++) {
    $parts_t[$i] = substr($t, $width * $i, $width);
    $parts_exp[$i] = substr($exp, $width * $i, $width);
    $parts_red[$i] = substr($red, $width * $i, $width);
  }
  for ($i = 0; $i < $lines; $i++) {
    $text->insert('end', "\n");
    scale($i * $width);
    $text->insert('end', "$parts_t[$i]\n", 'c2');
    $text->insert('end', "$parts_exp[$i]\n", 'c4');
    $text->insert('end', "$parts_red[$i]\n", 'c5');
  }
  $text->yviewMoveto(1);
}

sub displaystructure {            # display strucutre
  my @rr = @_;         # format this according to $width
  my $l = length($t);
  my $lines = int($l/$width) + 1;
  my ($i, $k);
  my @parts_r;
  for ($i = 0; $i < $lines; $i++) {
      for ($k = 0; $k < scalar(@rr); $k++) { $parts_r[$i][$k] = substr($rr[$k], $width * $i, $width); }
  }
  for ($i = 0; $i < $lines; $i++) {
    for ($k = 0; $k < scalar(@rr); $k++) { $text->insert('end', "$parts_r[$i][$k]\n", 'c3') }
  }
  $text->yviewMoveto(1);
}

sub letters {           # define letter sequence to used
 my @letters;
 my $i;
 for ($i = 0; $i < 26; $i++) { $letters[$i] = chr(97 + $i); }             # a..z
 for ($i = 0; $i < 26; $i++) { $letters[$i + 26] = chr(65 + $i); }        # A..Z
 for ($i = 0; $i < 10; $i++) { $letters[$i + 52] = chr(48 + $i); }        # 0..9
 return @letters;
}

sub lefttermsearch {  # return subterm of $_[0] (and its length) left to position $_[1]
  my $t = $_[0];
  my $p = $_[1];
  my $i;
  my $d = 0;
  for ($i = 1; ; $i++) {
    if (substr($t, $p - $i, 1) eq "0") { $d--; }
    else { $d++; };
    last if ($d == 1);
  }
  return (substr($t, $p - $i, $i), $i);
}


sub expand_at {          # expand $_[0] at position $_[1]; keep labels in a natural way
  my $t = $_[0];
  my $p = $_[1];
  my ($beg, $ins, $res);
  my ($u0, $u1, $u2);
  my ($i0, $i1, $i2, $l2);
  my $e_ins;
  $p = $p - 1;
  $res = substr($t, $p);
  ($u2, $i2) = lefttermsearch($t, $p);
  ($u1, $i1) = lefttermsearch($t, $p - $i2);
  ($u0, $i0) = lefttermsearch($t, $p - $i2 - $i1);
  $beg = substr($t, 0, $p - $i2 - $i1 - $i0);
  $ins = $u0 . $u1 . "0" . $u0 . $u2;
  $t = $beg . $ins . $res;
  $l2 = length($u2);
  $e_ins = label(substr($u1, length($u1) - 1, 1) . "0" . $u0);
  $e_ins = substr($e_ins, 1);
  substr($exp, $p - $l2, 0) = $e_ins;
  $count++;
  $countexp++;
  return($t);
}

sub reduce_at {      # reduce $_[0] at position $_[1]
  my $t = $_[0];
  my $p = $_[1] - 1;
  my ($u0, $u1, $u2);
  my ($i0, $i1, $i2);
  my ($t1, $t2);
  my $l;
  ($u2, $i2) = lefttermsearch($t, $p);
  ($u1, $i1) = lefttermsearch($t, $p - $i2);
  ($u0, $i0) = lefttermsearch($t, $p - $i2 - $i1);
  ($t1, $t2) = t1t2($u0);
  $l = $i0 + $i1 + $i2;
  substr($t, $p - $l, $l + 2) = $u1 . $t2 . $u2 . "00";
  substr($exp, $p - ($i1 + $i2 + 1), $i1 + 1) = "";
  $count++;
  $countred++;
  return($t);
}


sub label {      # initial (or new) labels for term
 my $s = $_[0];
 my $l = length($_[0]);
 my $i;
 my $e = " ";

 for ($i = 1; $i < $l; $i++) {
   if (substr($s, $i - 1, 2) eq "00") {
     if (defined($letters[$nextletter])) {
       $e = $e . $letters[$nextletter];
       $nextletter++;
     }
     else { $e = $e . "&"; }
   }
   else { $e = $e . " "; }
 }
 return($e);
}

sub relabel {
  $nextletter = 0;
  $exp = label($t);
}


sub showrange {           # compute active triplets (single one or sequence
  my $t = $_[0];
  my @ps = @{$_[1]};
  my ($u0, $u1, $u2, $i0, $i1, $i2);
  my ($r, $f0, $f1, $f2);
  my @rr;
  my $k;
  for ($k = 0; $k < scalar(@ps); $k++) {
    my $p = $ps[$k] - 1;
    ($u2, $i2) = lefttermsearch($t, $p);
    ($u1, $i1) = lefttermsearch($t, $p - $i2);
    ($u0, $i0) = lefttermsearch($t, $p - $i2 - $i1);
    $r = " " x ($p - $i2 - $i1 - $i0);
    if ($i0 == 1) { $f0 = "x" } else { $f0 = ">" . "-" x ($i0 - 2) . "<"; }
    if ($i1 == 1) { $f1 = "x" } else { $f1 = ">" . "-" x ($i1 - 2) . "<"; }
    if ($i2 == 1) { $f2 = "x" } else { $f2 = ">" . "-" x ($i2 - 2) . "<"; }
    $r .= $f0 . $f1 . $f2;
    my $f = length($t) - length($r);
    $r .= " " x $f . " " . substr($exp, $ps[$k], 1);
    $rr[$k] = $r;
  }
  displaystructure(@rr);
}


sub extenders {              # compute "the $k-th expansion position is located at position $i in the term"
  my $t = $_[0];
  my $i;
  my $k = 0;
  my @es;
  for ($i = 1; $i < length($t); $i++) {
    if(substr($t, $i - 1, 2) eq "00") {
      $es[$k] = $i;
      $k++;
    }
  }
  return(@es);
}

sub reductions {        # compute a string of ' ' and '~'. All reduction positins get '~'.
  my $t = $_[0];
  my $i;
  my $k = 0;
  my $redu = " ";
  my ($u0, $u1, $u2, $i0, $i1, $i2);
  for ($i = 1; $i < length($t); $i++) {
    if(substr($t, $i - 1, 2) eq "00") {
      my $p = $i - 1;
      ($u2, $i2) = lefttermsearch($t, $p);
      ($u1, $i1) = lefttermsearch($t, $p - $i2);
      ($u0, $i0) = lefttermsearch($t, $p - $i2 - $i1);
      my ($t1, $t2) = t1t2($u0);
      if ($t2 ne "0" and $t1 eq $u1) { $redu .= "~"; }
      else { $redu .= " "; }
    }
    else { $redu .= " "; }
  }
  $red = $redu;
  return $redu;
}



sub termtest {                  # termtest, returns 1 if $_[0] is a term, 0 otherwise
  my $term = $_[0];
  my $lh = length($term);
  my $i;
  my $d = 0;

  for ($i = 0; $i < $lh; $i++) {
    if (substr($term, $i, 1) eq 0) { $d--; }
    else { $d++; }
    return 0 if ($d <= 0);
  }
  if ($d == 1) { return 1; }
  else { return 0; }
}


sub t1t2 {           # if $_[0] = Term1Term2*, return (Term1, Term2). return ($t, 0) otherwise
  my $t = $_[0];
  my $l = length($t);
  my ($t1, $t2, $i);
  if ($l == 1) { return($t, 0); }
  else { ($t2, $i) = lefttermsearch($t, $l - 1); }
  $t1 = substr($t, 0, $l - $i - 1);
  return($t1, $t2);
}

sub sternop {            # star operation (uniformly distributing a term)
  my $t0 = $_[0];
  my $t = $_[1];
  my ($t1, $t2);
  ($t1, $t2) = t1t2($t);
  if ($t2 eq "0") { return($t0 . $t . "0"); }
  else { return(sternop($t0, $t1) . sternop($t0, $t2) . "0"); }
}

sub deltaop {           # delta operation
  my $t = $_[0];
  my $l = length($t);
  return($t) if ($l == 1);
  my ($t1, $t2, $a, $b, $c);
  ($t1, $t2) = t1t2($t);
  $a = deltaop($t1);
  $b = deltaop($t2);
  $c = sternop($a, $b);
  return($c);
}

sub reduce_alg {            # iterated reduction, until stable term is reached
  my $te = $_[0];
  my $s;
  my $i;
  for($i = 0; ; $i++) {
    $s = reduce_step($te);
    if($s eq $te) { return($te); }
    else { $te = $s; }
  }
}

sub reduce_step {             # reduce term
  my $te = $_[0];
  my ($t1, $t2, $t11, $t12, $t21, $t22);
  ($t1, $t2) = t1t2($te);
  return($te) if ($t2 eq "0");
  ($t11, $t12) = t1t2($t1);
  ($t21, $t22) = t1t2($t2);
  if ($t12 ne "0" and $t22 ne "0" and $t11 eq $t21) {
    return (reduce_step($t11) . reduce_step($t12) . reduce_step($t22) . "00");
  }
  else {
    return (reduce_step($t1) . reduce_step($t2) . "0");
  }
}

sub letters_to_pos {
  my $i;
  my %l_to_p;
   for ($i = 0; $i < length($exp); $i++) {
      if (substr($exp, $i, 1) ne "") { $l_to_p{substr($exp, $i, 1)} = $i; }
    }
  return \%l_to_p;
}


sub warning {
  my $le = length($t);
  my $a = 1;
  my ($wr, $wr2);
  if ($le >= 40) {
    my $answer = $main->Dialog(-title => 'Warning: Long Term',
			       -text => "The current term is very long (for Delta).\n\nApply Delta anyway?\n",
			       -buttons => [ 'yes', 'no' ],
			       -default_button => 'no',
			       -font => 'r 12 bold',
			       -width => '40',
			      )->Show();
    if ($answer eq 'yes') { return 1; }
    else { return 0; }
  }
  return 1;
}


sub info {                 # info on this program and its options
  my $str1 = "\nThis is a program for interactive expansions and reductions for terms\nsatisfying the left distributive law a(bc) = (ab)(ac). Terms are in right Polish notation.\n" .
    "(The author of this program made to many mistakes in computing these things by hand...)\n\n\n";

  my $str11 =  "1. Use the 'Start Term' widget to select or type the term you want to analyze.\n" .
    "   The letter '0' is the multiplication sign. You can use all other letters\n" .
    "   for variables, e.g., 1, a, b, b, x, y, z, ...\n\n" .
      "2. Press the 'Start' button.\n\n" .
	"3. Use the letter-labeled buttons on the bottom of the window to expand or reduce the term.\n" .
        "   Alternatively, you can enter a numeric position 'n' in the 'Pos:' widget,\n" .
	"   and then expand ('e') or reduce ('r') the term at 'n'" .
        " (the default entry is the actual length of the term).\n" .
	"   The 's' option displays the three terms associated to 'n' (cf. 'Structure' below).\n\n\n";

  my $str12 = "Use the 'Width' widget to adjust the scale of the output to the geometry of your window.\n" .
    "Width should be a multiple of 5.\n" .
    "You can restart the program (with a new entry in 'Start Term') at any time.\n\n\n";
  my $str2 = "Other options:\n\n" .
    " a) Hitting the 'Delta' button applies the delta-operation to the term.\n" .
      "    Use this for very small terms only!!!\n\n" .
      " b) Hitting the 'Reduce' button applies a built-in reduction algorithm to the term.\n" .
      "    In many (but not all) cases this brings you back to the term you started with,\n" . 
      "    or even to a smaller term.\n\n" .
      " c) Hitting the 'Top' button displays the actual term on the top of the text window.\n" .
      "    Also, the actual entries in 'Font' and 'Width' are used to display the term.\n\n" .  
      " d) Hitting the 'Relabel' button renames the letters asigned to the term in alphabetical order.\n\n" .
      " e) Hitting the 'Structure' button displays the complete structure of the term:\n" .
      "    Each letter acts on three subterms, and all those triples are displayed.\n" .
      "    Use small fonts and large widths for long terms (change 'Font', 'Width', press 'Top', press 'Structure')\n\n";

  my $str3 = "This program is written in perl/Tk. Oliver Deiser, Berkeley, June 2002.\n\n\n";

  $text->delete("1.0", 'end');
  $text->insert("end", $str1, "c3");
  $text->insert("end", $str11, "c4");
  $text->insert("end", $str12, "c3");
  $text->insert("end", $str2, "c5");
  $text->insert("end", $str3, "c2");

}