tfm.pl

	# Oh well, maybe later.
	print STDERR "Oops, ignoring determinant of ", sqrt(0+@_), "-rank matrix.\n";
	return 1;
    }
}

# Transpose a square matrix.
sub transpose {
    local($d) = int(sqrt(@_));
    local($i, $j);
    local(@T);
    for($i = 0; $i < $d; $i++) {
	for($j = 0; $j < $d; $j++) {
	    push(@T, @_[$i + $j*$d]);
	}
    }
    return @T;
}

# Print a square matrix tidily.
sub putmatrix {
    local($d) = int(sqrt(@_));
    local($i);
    while($@ > 0) {
	printf " %9.6g", shift;
	print "\n" if ++$i % $d == 0;
    }
    print "\n" if $i % $d != 0;
}

sub list {
    local($_) = join(" ", @_);
    $_ =~ tr/,(){}[]/       /s;
    return split(' ', $_);
}

# Color conversion: out of place here, but useful
sub hls2rgb {
  local($h,$l,$s) = @_;
  local($max) = $l;
  local($delta) = $max*$s;
  local(@rgb) = ($max-$delta) x 3;
  $h -= int($h);
  $h += 1 if $h < 0;
  $h *= 6;
  local($t) = &abs($h-2)-1;
  if($t<0) { $rgb[0] = $max; }
  elsif($t<1) { $rgb[0] = $max-$delta*$t; }
  $t = &abs($h-4)-1;
  if($t<0) { $rgb[1] = $max; }
  elsif($t<1) { $rgb[1] = $max-$delta*$t; }
  $t = 2 - &abs(3-$h);
  if($t<0) { $rgb[2] = $max; }
  elsif($t<1) { $rgb[2] = $max-$delta*$t; }
  return @rgb;
}

# a [-1..1, -1..1] square onto a torus or Moebius strip.

# Uses global parameter $torus:
#       $torus = -1   rectangle
#       $torus = 0    cylinder
#       $torus = 1    torus
# and $r for the hole in the center of the torus.  Torus' major radius = 1.

$surfmap = "tormap" unless $surfmap;
sub tormap {
    local($v,$u) = @_;
    if($torus > 0) {
	local($rp) = $r + (1/$torus + cos($pi*$v)) / $pi;
	return ($rp * sin($pi*$u*$torus), sin($pi*$v)/$pi,
		$rp * cos($pi*$u*$torus) - $r - (1 + 1/$torus)/$pi );
    } elsif($torus > -1) {
	local($cyl) = $torus + 1;    # $cyl = 0 for square, 1 for cylinder
	if ($cylvert) { # vertical cylinder
	  return (sin($pi*$u*$cyl)/$pi/$cyl, $v,
		  (cos($pi*$u*$cyl) - 1)/$pi/$cyl);
	} else { # horizontal cylinder
	  return ($u, sin($pi*$v*$cyl)/$pi/$cyl,
		  (cos($pi*$v*$cyl) - 1)/$pi/$cyl );
	}
    } else {
	return ($u, $v, 0);
    }
}

sub imgfit {
    local($cen, $min, $max, $scale) = @_;
    if($max eq "") {
	print STDERR "Usage: imgfit(center, min, max [, scale])
returns min', max', (max'-min') -- range in which \"cen\" is centered, scaled up by \"scale\"\n";
	return;
    }
    $scale = 1 unless $scale;
    local($r) = $cen-$min;
    $r = $max-$cen if $r < $max-$cen;
    (($cen-$r)*$scale, ($cen+$r)*$scale, 2*$r*$scale);
}

sub history {
    local($howmany) = $_[$#_];
    $howmany = 0+@HIST unless $howmany>0;
    local($numbered) = (join("",@_) =~ /n/);
    local($i);
    for($i = @HIST-$howmany; $i < @HIST; $i++) {
	if($numbered) {
	    printf "%-3d %s\n", $i, $HIST[$i];
	} else {
	    printf " %s\n", $HIST[$i];
	}
    }
}

sub h {
    &history;
}

sub tfm_interact {
  # If we were invoked as a shell command, act as a perl calculator.
  local($tty) = (-t STDIN);
  print STDERR "Type \"help\" for help\n> " if $tty;
  @prefix = ();
  while(($lastinput = <>) ne "" && $lastinput !~ /^(q|quit|exit|bye)$/i) {
    $lastinput =~ s/^[\s>]*//;
    $lastinput = "&help ", @prefix = () if $lastinput =~ /^\s*\?\s*$/;
    chomp $lastinput;
    if($lastinput =~ /(.*)\\$/) {
	push(@prefix, $1);
	print STDERR "\t" if $tty;
	next;
    }
    $wholeinput = join("\n\t", @prefix, $lastinput);
    if(($wholeinput =~ tr/{/{/) > ($wholeinput =~ tr/}/}/)) {
	push(@prefix, $lastinput);
	print STDERR "\t" if $tty;
	next;
    }
    push(@HIST, $wholeinput);
    @_ = eval($wholeinput);
    if($@ != "") {
	print $@, "\n";
    } elsif($wholeinput !~ /;$/ && $wholeinput ne "" && $wholeinput !~ /^&*help$/) {
	&put(@_);
	$_ = $_[0];
    }
    @prefix = ();
    print STDERR "> " if $tty;
  }
}

if ($0 =~ /tfm\.pl$/ || $tfm_interactive) { 
  &tfm_interact;
}

1;