#
# utilities.icn - various helper procedures
#
# Design commentary: this module was started as a "class" for no reason.
# Its methods were first pulled out as procedures, and then eventually the
# class was deleted. Afterward, the formNStr procedure was found to be an
# inefficient variant of the built-in map() procedure.
#

#
# Formats the network messages for us by replacing each character in
# the string that occurs in Ls with the corresponding value in Lr
#
$include "defaults.icn"

#
# getserver - given a server name, go find that server using the public
# (HTML-based) server directory.  Not to be confused with built-in getserv().
#
procedure getserver(servername)
local fservers, line, line2, alias, s
   if fservers := open(SERVER_DIRECTORY,"m") then {
	 if *select(fservers, 5000) = 0 then
	    write("servers.html:Connection timed out.")
	 else{
	    while (line := read(fservers)) & (line ~== "<dl>")
	    while (line := read(fservers)) &
		    (alias := line ?:= (="<dt> " & tab(0))) do {
	       if (line2 := read(fservers)) &
		    ( s := line2 ?:= (="<dd> " & tab(0))) then {
	          if alias == (servername | ("U"||servername)) then {
		     servername := s
		     break
		     }
	          else next
	          }
	       }
	    }
         }
   close(fservers)
   return \servername
end    

#
# Truncate Reals to only places to the right of decimal point
# eg. 45.6896 -> 45.6 (places = 1)
#
procedure trncReal(r,places:integer:2)
   local s := string(r)
   if not numeric(r) then return string(r)
   if s[-2:0] = "99" then s +:= 0.001
   s ?:= tab(find(".")+places+1)
   return numeric(s)
end

#
# vgamem.icn - determine video memory
#
# Included in CVE sources until later Unicon binaries roll out with
# this in the standard libraries.
#

$ifdef MAIN
procedure main()
   every write(vgamem(), " bytes")
end
$endif

procedure vgamem()
local fn, line, mem, pin, fin, results := []
static hexdigits, memdigits
initial {
   hexdigits := &digits ++ 'abcdefABCDEF'
   memdigits := &digits ++ 'KM'
   }
$ifdef _UNIX
   stat("/sbin/lspci") | fail
   pin := open("/sbin/lspci -v", "p") | fail
   while line := read(pin) do {
      line ? {
	 if any(&digits) & find("VGA") then {
	    mem := 0
	    while line := read(pin) do {
	       if line == "" then break
	       line ? {
		  tab(many(' \t'))
		  if ="Memory at" then {
		     tab(many(' \t')) | next
		     tab(many(hexdigits)) | next
		     tab(many(' \t')) | next
		     ="(" | next
		     tab(many(&digits)) | next
		     ="-bit," | next
		     tab(many(' \t')) | next
		     ="prefetchable" | next
		     =")" | next
		     tab(many(' \t')) | next
		     ="[" | next
		     ="size=" | next
		     mem <:= KMsize(tab(many(memdigits)))
		     }
	          }
	       }
	    put(results, 0 < mem)
	    }
         }
      }
   close(pin)
   suspend !results
$endif
$ifdef _MS_WINDOWS_NT

   #
   # This code worked acceptably well for Windows XP but is too slow
   # under Vista and Win7, so it is disabled.
   #
   fail

   # try for a TEMP directory, settle for current directory if no TEMP
   fn := ((getenv("TEMP") || "\\")|"") || "foo.txt"

   system("\"\\Program Files\\Common Files\\Microsoft Shared\\MSInfo\\" ||
          "msinfo32\" /report " || fn ||" /categories +componentsdisplay")

   if not (fin := open(fn)) then {
      write("can't get display memory")
      fail
      }
   while line := read(fin) do {
      line ? {
	 # Look for "Adapter RAM" - in MSinfo32's Unicode output
         if tab(find("A\0d\0a\0p\0t\0e\0r\0 \0R\0A\0M\0")) then {
	    tab(find("(")+2) | fail
	    mem := 0
	    while c := move(1) do { mem := mem * 10 + integer(c); move(1) }
	    close(fin)
	    remove(fn)
	    return mem
            }
         }
      }
   close(fin)
$endif
end

#
# KMsize - convert a string like 64M (64 Megs) into an integer
#
procedure KMsize(s)
   case s[-1] of {
      "M": return integer(s[1:-1]) * 1024 * 1024
      "K": return integer(s[1:-1]) * 1024
      default: return s
   }
end


procedure joinsep(arg, sep)
   local rv := string(arg[1])
   every rv ||:= sep || arg[2 to *arg]
   return rv
end

procedure make_path(path[])
   return joinsep(path, PS)
end

procedure hashc(ch,i)
     return char(ord(ch) + 62)
end

procedure dehashc(ch,i)
     return  char(ord(ch) - 62)
end

procedure cypher(word)
   static ltr
   local word2, i, ch, ch2
   \word | fail
  
   word2:=""
   i:=1
   every ch := !word do{
      ch2 := hashc(ch,i)
      word2 ||:= ch2 || char(?(140)+93)
      i+:=1
      }

  # write("word:", word,  "    word2:", word2 )
    
   return word2
end

procedure decypher(word)
   local word2, i

   \word | fail
   word2:=""
   every i:=1 to *word by 2 do{
     word2||:= dehashc(word[i],i/2+1)
     }

  #write("word:", word,  "    word2:", word2 )
   return word2
end