//
// lib with useful ? procs
//
proc prideal (ideal id)
{
  "// ideal";
  for (int @i=1; @i<=nrows(id); @i=@i+1)
  {
    "//id[" +  string(@i) + "] : "+  string(id[@i]);
  }
  "// dim  :", dim(id);
  "// mult :", multiplicity(id);
  return();
}

proc formmat (matrix m)
{
  int @elems = 0;
  int @mlen  = 0;
  int @slen  = 0;
  int @c;
  for (int @r=1; @r<=nrows(m); @r=@r+1)
  {
    for (@c=1; @c<=ncols(m); @c=@c+1)
    {
      @elems = @elems + 1;
      string @s(@elems) = string(m[@r,@c]);
      @slen = size(@s(@elems));
      if (@slen > @mlen)
      {
        @mlen = @slen;
      }
    }
  }
  @elems = 0;
  string @aus = "";
  string @sep = " ";
  if (@mlen * ncols(m) >= pagewidth)
  {
    @sep = newline;
  }
  for (@r=1; @r<=nrows(m); @r=@r+1)
  {
    for (@c=1; @c<=ncols(m); @c=@c+1)
    {
      @elems = @elems + 1;
      @slen = size(@s(@elems));
      @aus = @aus + @s(@elems)[1,@mlen] + @sep;
    }
    @aus = @aus + newline;
//    @aus = "";
  }
  return(@aus);
}
proc fixmat (matrix m,int l)
{
  string @aus;
  string @tmp;
  int @ll;
  int @c;
  for (int @r=1; @r<=nrows(m); @r=@r+1)
  {
    @aus = "";
    for (@c=1; @c<=ncols(m); @c=@c+1)
    {
      @tmp = string(m[@r,@c]);
      @aus = @aus + @tmp[1,l] + " ";
    }
    @aus;
  }
}
proc stransp (int r, int c, list #)
{
  // transpose a submatrix
  matrix @m[r][c];
  int @ii = 1;
  int @j;
  for (int @i = 1; @i<=r; @i=@i+1)
  {
    for (@j = 1; @j<=c; @j=@j+1)
    {
      @m[@i,@j] = #[@ii];
      @ii=@ii+1;
    }
  }
  return(transpose(@m));
}
proc unitmat (int r, list #)
{
  // create an unit matrix, # is optional
  poly @p = 1;
  if (size(#) == 1)
  {
    @p = #[1];
  }
  matrix @m[r][r];
  return (@m + @p);
}
//
// declare a ring with a different dialog
// using defaults etc;
//

proc permute (int n, list #)
{
  //if (#ARGS == 2)
  //{
  //  string @actionstring = #action +"();";
  //}
  if (defined(PERMUTE_DATA) or defined(PERMUTE_WORK))
  {
    "permute: PERMUTE_WORK/DATA already defined, please kill them!";
    return();
  }
  //
  // initialize global data
  //
  intvec PERMUTE_DATA = n;  // must be global
  intvec PERMUTE_WORK = 1;   // must be global
  export PERMUTE_DATA, PERMUTE_WORK;
  for (int @i=#n-1; @i>0; @i=@i-1)
  {
    PERMUTE_DATA = PERMUTE_DATA, @i;
    PERMUTE_WORK = PERMUTE_WORK, 1;
  }
  int @done = 0;
  while (@done == 0)
  {
    "permute", PERMUTE_DATA;  // this could be an action call
    //if (#ARGS == 2)
    //{
    //  execute @actionstring;
    //}
    @done = next_permute(n);
  }
  kill PERMUTE_DATA, PERMUTE_WORK;
  return ("-----------");
}

proc next_permute (int n)
{
  int @rc = 1;
  if (n > 1)
  {
    if(PERMUTE_WORK[n] < n)
    {
      PERMUTE_DATA[PERMUTE_WORK[n]] = PERMUTE_DATA[PERMUTE_WORK[n] + 1];
      PERMUTE_DATA[PERMUTE_WORK[n] + 1] = n;
      PERMUTE_WORK[n] = PERMUTE_WORK[n] + 1;
      return(0);
    }
    @rc = next_permute(n-1);
    for(int @i=n-1; @i>=1; @i=@i-1)
    {
      PERMUTE_DATA[@i+1] = PERMUTE_DATA[@i];
    }
    PERMUTE_DATA[1] = n;
    PERMUTE_WORK[n] = 1;
    return(@rc);
  }
  return (@rc);
}
//
// permutations as described in:
//   data structures, algorithms, and program style using c
//   james f. korsh
//   leonard j. garrett
//   pp. 162
//
proc permute1 (int n)
{
  int @done = 0;
  while (@done == 0)
  {
    "permute", all;  // this could be an action call
    @done = next(n);
  }
  return ("-----------");
}
proc next (int n)
{
  int @rc = 1;
  if (n > 1)
  {
    if(l[n] < n)
    {
      all[l[n]] = all[l[n] + 1];
      all[l[n] + 1] = n;
      l[n] = l[n] + 1;
      return(0);
    }
    @rc = next(n-1);
    for(int @i=n-1; @i>=1; @i=@i-1)
    {
      all[@i+1] = all[@i];
    }
    all[1] = n;
    l[n] = 1;
    return(@rc);
  }
  return (@rc);
}
