################################################################
#
#	File:	  zlib.icn
#
#	Subject:  Biblioteca das minhas fun‡äes principais;
#		  deixar compilada, ela ‚ linkada quando se
#		  usa $include "zinc.icn".
#
#	Author:	  Edrx
#
#	Date:	  96 jul 19
#
################################################################
#
# Libbables: myupto, split, strictsplit, splitwpos, myopen, fname2array,
# Libbables: array2fname, fullimage...
#
################################################################

global splitpos

procedure myupto(c)
  return upto(c) | (&pos ~= *&subject + 1)
end

procedure split(s, sep)
  local a
  a := []
  sep := \sep | ' '
  s ? while {
    tab(many(sep))
    put(a, tab(myupto(sep)))
  }
  return a
end 

procedure splitwpos(s, sep)	# "split with pos"
  local a, p
  splitpos := []
  a := []
  sep := \sep | ' '
  s ? while {
    tab(many(sep))
    if p := myupto(sep) then {
      put(splitpos, &pos)
      put(a, tab(p))
    }
  }
  return a
end 

procedure strictsplit(s, cs)
  A := []
  s ? repeat {
    if put(A, tab(upto(cs))) then
      move(1)
    else
      return(put(A, tab(0)))
  }
end




procedure myopen(fname, mode)
  /mode := "r"
  return open(fname, mode) |
    stop ("Can't open ", fname, " in mode ", mode) 
end

procedure fname2array(fname)
  local a, finp
  finp := myopen(fname)
  a := []
  while put(a, read(finp))
  close(finp)
  return a
end

procedure array2fname(a, fname)		# Esse nome t  meio merda.
  local fout
  fout := myopen(fname, "w")
  every write(fout, a[1 to *a])
  close(fout)
  return
end




procedure fname2string(fname)
  local s, finp
  finp := myopen(fname)
  s := ""
  while s ||:= reads(finp, 65536)
  close(finp)
  return s
end




# procedure arrimage(a)
#   local s, sep; s := ""; sep := ""
#   every x := !a do { s ||:= sep; s ||:= fullimage(x); sep := ", " }
#   return s
# end

# procedure arrimage(a)
#   return arrtostr(a, "[", ", ", "]", fullimage, "[]")
# end

# procedure tabletoarray(t)
#   local a, k; a := []
#   every k := key(t) do
#     put(a, [k, t[k]])
#   return a
# end

procedure tabletoarray(T)
  return sort(T, 1)
end

procedure tablepairimage(a)
  return fullimage(a[1]) || "->" || fullimage(a[2])
end

procedure fullimage(x)
  local s
  if type(x) == "list" then
#   return "[" || arrimage(x) || "]"
    return arrtostr(x, "[", ", ", "]", fullimage, "[]")
  else if type(x) == "table" then
#   return "(table: " || arrimage(tabletoarray(x)) || ")"
#   return arrtostr(tabletoarray(x), "{", ", ", "}", tablepairimage, "{}")
    return arrtostr(sort(x, 1), "{", ", ", "}", tablepairimage, "{}")
  else if type(x) == "set" then
    return arrtostr(sort(x), "{", ", ", "}", fullimage, "{}")
  else if type(x) == "procedure" then
    return image(x)[11:0]
  else return image(x)
end



procedure arrtostr(a, s0, s1, s2, imager, s00)
  local s, i
  /s00 := s0 || s2
  /imager := fullimage
  if *a = 0 then
    return s00
  s := s0 || imager(a[1])
  every i := 2 to *a do
    s ||:= s1 || imager(a[i])
  return s || s2
end




procedure removechars(s, cs)
  local s1; s1 := ""
  s ? while ( tab(many(cs)) | (s1 ||:= tab(myupto(cs))) )
  return s1
end

procedure bitrim(s)
  s := trim(s)
  return s?{tab(many(' ')); tab(0)}
end



procedure mysettable(T, what[])
  every i := 1 to *what - 1 by 2 do
    insert(T, what[i], what[i + 1])
  return T
end


procedure min(a, b)
  return if a <= b then a else b
end

procedure max(a, b)
  return if a >= b then a else b
end



#
# Essas rotinas sao um filtro para o output do "ls -lA".
#
# O resultado do fsplit e' um array de strings:
# a[1] : tipo e permissoes do arquivo 
# a[2] : numero de links (acho)
# a[3] : owner name (ou e' chamado de "user name"?)
# a[4] : group name
# a[5] : tamanho, em string (para certos devices sera' um string tipo "1,  42")
# a[6] : data e hora, ou data completa
# a[7] : nome
# a[8] : (so' em slinks) "->"
# a[9] : (so' em slinks) destino do slinks (i.e., arquivo real)
#
# procedure flsplit(s)		# File Line Split
#   return split(s[1:34]) ||| [bitrim(s[34:42]), s[43:55]] ||| split(s[56:0])
# end
#
# procedure spto0(s); return map(s, " ", "0"); end
# procedure right0(n, len); return right(n, len, "0"); end
# procedure yymmddton(s); return map("YyMmDd", "Yy Mm Dd", s); end