#########################################################################################################
#                                                                                                       #
# AGENA COMPATIBILITY FILE                                                                              #
#                                                                                                       #
#########################################################################################################


# Issue `readlib 'compat'` at the Agena prompt (without the backquotes) to activate these backward
# compatibility functions.


#########################################################################################################
#                                                                                                       #
# Backward compatibility to Agena 1.0.x                                                                 #
#                                                                                                       #
#########################################################################################################

os.alldirs := proc(dirname::string) is  # 0.33.1 as of June 20, 2010; modified 1.0.5 as of 26.11.2010
   return os.list(dirname, 'dirs', 'r');
end;

maptoset := proc(f::procedure, s) is
   local t := type(s);
   assume(t = table or t = sequence,
      'Error in `maptoset`: table or sequence expected as second argument');
   return toset(map(f, s))
end;

hasrotable := proc(f::procedure) is
   return rmode(f) = 'rotable'
end;

hasrtable := proc(f::procedure) is
   return rmode(f) = 'rtable'
end;

# applies to Nexenta, as well. Extended 0.31.4
os.isSolaris := proc(x) is
   if _Env.Os <> 'solaris' then return false fi;
   case x
      of 'x86', 'intel', 'i86pc' then
         return _Env.Cpu = 'x86'
      of 'sparc', 'sun4u' then
         return _Env.Cpu = 'sparc'
      of null then
         return true
      else
         error('Error, unknown option to `os.isSolaris`.')
   esac
end;

os.isLinux := << () -> _Env.OS = 'linux' >>;  # 0.13.4 patch

os.isDOS := << () -> _Env.Os = 'dos' >>;  # returns false on Windows

os.isOS2 := << () -> _Env.Os = 'os/2' >>;

os.isWin := << () -> _Env.Os = 'windows' >>;

os.isMac := proc(x) is
   if _Env.Os <> 'macosx' then return false fi;
   case x
      of 'x86', 'intel', 'i86pc' then
         return _Env.Cpu = 'x86'
      of 'ppc' then
         return _Env.Cpu = 'ppc'
      of null then
         return true
      else
         error('Error, unknown option to `os.isMac`.')
   esac
end;

os.isHaiku := << () -> _Env.Os = 'haiku' >>;


strings.seek := proc(?) is
   if nargs = 2 then
      return instr(varargs[1], varargs[2], 1, true)
   elif nargs = 3 then
      return instr(varargs[1], varargs[2], varargs[3], true)
   else
      error('Error in `strings.seek`: wrong number of arguments.')
   fi
end;


concat := proc(?) is
   if nargs = 1 then
      return join(varargs[1])  # unpack does not work
   elif nargs = 2 then
      return join(varargs[1], varargs[2])
   elif nargs = 3 then
      return join(varargs[1], varargs[2], varargs[3])
   elif nargs = 4 then
      return join(varargs[1], varargs[2], varargs[3], varargs[4])
   else
      error('Error in `concat`: wrong number of arguments.')
   fi
end;


pcall := proc(?) is
   local status, result;
   result := [protect(unpack(varargs))];
   status := result[1] <> lasterror;
   clear lasterror;
   return status, unpack(result)
end;

if type(mapm) = table then
   mapm.xtoNumber := mapm.xtonumber;
   mapm.xtoString := mapm.xtostring
fi;

loadclib := package.loadclib;
register := package.register;

rget := rtable.rget;
defaults := rtable.defaults;
rdelete := rtable.rdelete;
rinit := rtable.rinit;
roinit := rtable.roinit;
rmode := rtable.rmode;
rset := rtable.rset;
remember := rtable.remember;

# restore _Env table and former baslib system functions
local wv := environ.WithVerbose;
environ.WithVerbose := false;
with('environ');
environ.WithVerbose := wv;
clear wv;

_Env := [
   'BufferSize' ~ environ.buffersize,
   'Cpu' ~ environ.cpu,
   'MaxLong' ~ environ.maxlong,
   'MinLong' ~ environ.minlong,
   'More' ~ environ.more,
   'Os' ~  environ.os,
   'PathSep' ~ environ.pathsep,
   'Release' ~ environ.release,
   'WithProtected' ~ environ.withprotected,
   'WithVerbose' ~ environ.withverbose
];

__DOTTYPRINT := environ.__DOTTYPRINT;
__RESTART := environ.__RESTART;
homedir := environ.homedir;

# determine _VERSION
local s := _RELEASE split ' ';
delete '>>', 'Update' from s;
_VERSION := s[1] & ' ' & s[2][1 to instr(s[2], '.', 'reverse') - 1]
clear s;


#########################################################################################################
#                                                                                                       #
# Agena 1.2 changes                                                                                     #
#                                                                                                       #
#########################################################################################################

local _chdir := os.chdir;

os.chdir := proc(x) is
   if x = null or nargs = 0 then
      return _chdir()
   else
      return unpack(subs(false:fail, [protect(_chdir, x) = lasterror]))
   fi
end;


local _remove := os.remove;

os.remove := proc(x::string) is
   return unpack(subs(false:fail, [protect(_remove, x) = lasterror]))
end;


local _move := os.move;

os.move := proc(x::string) is
   return unpack(subs(false:fail, [protect(_move, x) = lasterror]))
end;


local _mkdir := os.mkdir;

os.mkdir := proc(x::string) is
   return not(protect(_mkdir, x) = lasterror)
end;


local _rmdir := os.rmdir;

os.rmdir := proc(x::string) is
   return not(protect(_rmdir, x) = lasterror)
end;


#########################################################################################################
#                                                                                                       #
# Agena 1.3.2 deprecation of `strings.rseek`                                                            #
#                                                                                                       #
#########################################################################################################

strings.rseek := proc(?) is
   if nargs = 2 then
      return instr(varargs[1], varargs[2], 1, true, 'reverse')
   elif nargs = 3 then
      return instr(varargs[1], varargs[2], varargs[3], true, 'reverse')
   else
      error('Error in `strings.rseek`: wrong number of arguments.')
   fi
end;


#########################################################################################################
#                                                                                                       #
# Agena 1.5.0 deprecation of the `stringarray` functions                                                #
#                                                                                                       #
#########################################################################################################

environ._EnvStringArraySizes := [];  # table to hold the maximum sizes of all stringarray objects

# The metatable

utils.mtbl := [];

utils.mtbl.__tostring := proc(x) is
   return 'array(' & environ._EnvStringArraySizes[x] & ')'
end;

utils.mtbl.__index := proc(strarr::array, n::number) is
   if n < 0 or n + 1 > environ._EnvStringArraySizes[strarr] then
      error('Wrong argument #2 to `getarray`: index out of range.')
   else
      local r := rawget(strarr, int n);
      return is r = null then '' else r si
   fi
end;

utils.mtbl.__writeindex := proc(x::array, y::number, z::string) is
   if y < 0 or y+1 > environ._EnvStringArraySizes[x] then
      error('Wrong argument #2 to `setarray`: index out of range.')
   else
      rawset(x, int y, z)
   fi
end;

# The functions

utils.newarray := proc(x::number) is
   if x < 1 then
      error('Wrong argument #1 to `newarray`: invalid size.')
   fi;
   x := int x;
   create local table r(x);
   setmetatable(r, utils.mtbl);
   settype(r, 'array');
   environ._EnvStringArraySizes[r] := x;
   return r
end;


utils.setarray := proc(strarr::array, n::number, str::string) is
   strarr[n] := str
end;


utils.getarray := proc(strarr::array, n::number) is
   return strarr[n]
end;


utils.getwholearray := proc(strarr::array) is
   local len, r, val;
   len := environ._EnvStringArraySizes[strarr];
   create local table r(len);
   for i from 0 to len - 1 do
      val := rawget(strarr, i);
      if val <> null then
         r[i+1] := val
      fi
   od;
   return r
end;


utils.singlesubs := proc(str::string, t::array) is
   return join(map(<< x -> char(t[abs(x)+1]) >>, strings.tobytes(str)));
end;


##############################################################################################
# Backward compatibility to Agena 1.5.1 and earlier                                          #
##############################################################################################

environ.MinLong := environ.minlong;
environ.MaxLong := environ.maxlong;
environ.BufferSize := environ.buffersize;
environ.PathSep := environ.pathsep;
environ.More := environ.More;
environ.WithProtected := environ.withprotected;
environ.WithVerbose := environ.withverbose;
environ.Os := environ.os;
environ.Cpu := environ.cpu;
environ.Release := environ.release;
environ.GdiDefaultOptions := environ.gdidefaultoptions;

environ.PrintEncloseStrings := environ.printenclosestrings;
environ.PrintTable := environ.aux.printtable;
environ.PrintSet := environ.aux.printset;
environ.PrintSequence := environ.aux.printsequence;
environ.PrintPair := environ.aux.printpair;
environ.PrintProcedure := environ.aux.printprocedure;
environ.PrintComplex := environ.aux.printcomplex;


##############################################################################################
# Backward compatibility to Agena 1.6.3 and earlier                                          #
##############################################################################################

environ.FractScreenUpdates := environ.fractscreenupdates;
environ.FractintColorMaps := environ.fractintcolourmaps;


