/* ----------------------------------------------------------------------------- This source file is part of OpenSpace3D For the latest info, see http://www.openspace3d.com Copyright (c) 2012 I-maginer This program is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA, or go to http://www.gnu.org/copyleft/lesser.txt ----------------------------------------------------------------------------- */ /*! @defgroup toolslib OpenSpace3D high level Tools * OpenSpace3D high level Tools * @{re-position all tabs on tab bar */ /** @} */ /*! @ingroup toolslib * \brief Concat two list to one * * Prototype: fun [[u0 r1] [u0 r1]] [u0 r1] * * \param [u0 r1] : first list to concat * \param [u0 r1] : second list to concat * * \return [u0 r1] : concatened list **/ fun lcat(p, q)= if p==nil then q else (hd p)::lcat (tl p) q;; /*! @ingroup toolslib * \brief Split a list in two list at given position * * Prototype: fun [[u0 r1] I] [[u0 r1] [u0 r1]] * * \param [u0 r1] : list to split * \param I : position (start at 0), use a negative value for a position from the list end * * \return [[u0 r1] [u0 r1]] : splited list **/ fun splitList(l, pos)= let if pos < 0 then ((sizelist l) + (pos + 1)) else pos -> pos in if (((pos + 1) > (sizelist l)) || (pos == 0)) then [nil l] else let nil -> l1 in let nil -> l2 in ( let sizelist l -> size in let size - 1 -> i in while (i >= 0) do ( let nth_list l i -> elt in if (i < pos) then set l1 = elt::l1 else set l2 = elt::l2; set i = i - 1; ); [l1 l2]; );; /*! @ingroup toolslib * \brief move an elements in a list * * Prototype: fun [[u0 r1] I I] [u0 r1] * * \param [u0 r1] : list to split * \param I : position to get the element * \param I : position to move the element * * \return [u0 r1] : new list **/ fun moveListElement(l, pos, to)= if (to < 0) || (to >= (sizelist l)) || (pos < 0) || (pos >= (sizelist l)) then l else let nil -> newlist in ( let (sizelist l) - 1 -> i in while i >= 0 do ( let nth_list l i -> elt in if (i == pos) then set newlist = (nth_list l to)::newlist else if (i == to) then set newlist = (nth_list l pos)::newlist else set newlist = elt::newlist; set i = i - 1; ); newlist; );; /*! \brief Divide list * * Prototype: fun [u0 [u0 r1] [u0 r1] [u0 r1] fun [u0 u0] I] [u0 r1] * * Private * * \return [[u0 r1] [u0 r1]] **/ fun divideList(x,p,r1,r2,f)= if p==nil then [r1 r2] else let p->[a n] in let exec f with [a x] -> r in if r==0 then divideList x n r1 r2 f else if r<0 then divideList x n a::r1 r2 f else divideList x n r1 a::r2 f;; /*! \brief Divide string list * * Prototype: fun [[S r1] [[S r1] r1] [[S r1] r1] [[S r1] r1] fun [[S r1] [S r1]] I] [[S r1] r1] * * Private * * \return [[[S r1] r1] [[S r1] r1]] **/ fun divideListString(x,p,r1,r2,f)= if p==nil then [r1 r2] else let p->[a n] in let exec f with [strcatn a strcatn x] -> r in if r==0 then divideListString x n r1 r2 f else if r<0 then divideListString x n a::r1 r2 f else divideListString x n r1 a::r2 f;; /*! \brief Divide list by position * * Prototype: fun [[u0 r1] [[u0 r1] r1] [[u0 r1] r1] [[u0 r1] r1] I fun [[u0 r1] [u0 r1]] I] [[u0 r1] r1] * * Private * * \return [[[u0 r1] r1] [[u0 r1] r1]] **/ fun divideListPos(x,p,r1,r2,pos,f)= if p==nil then [r1 r2] else let p->[a n] in let exec f with [(nth_list a pos) (nth_list x pos)] -> r in if r==0 then divideListPos x n r1 r2 pos f else if r<0 then divideListPos x n a::r1 r2 pos f else divideListPos x n r1 a::r2 pos f;; /*! \brief Divide list by position * * Prototype: fun [[[S u0] r1] [[[S u0] r1] r1] [[[S u0] r1] r1] [[[S u0] r1] r1] I fun [[[S u0] r1] [[S u0] r1]] I] [[[S u0] r1] r1] * * Private * * \return [[[[S u0] r1] r1] [[[S u0] r1] r1]] **/ fun divideList3(x,p,r1,r2,f)= if p==nil then [r1 r2] else let p->[a n] in let a->[aa _] in let x->[xx _] in let exec f with [aa xx] -> r in if r==0 then divideList3 x n r1 r2 f else if r<0 then divideList3 x n a::r1 r2 f else divideList3 x n r1 a::r2 f;; /*! \brief Extract list * * Prototype: fun [[u0 r1] u0 fun [u0 u0] I] [u0 r1] * * Private * * \return [[u0 r1] [u0 r1]] **/ fun extractList(l, e, f) = if l == nil then [nil nil] else let l -> [head tail] in let extractList tail e f -> [left right] in if exec f with [head e] then [head::left right] else [left head::right];; /*! @ingroup toolslib * \brief Test if a string is smaller than an another string * * Use with quicksort function * * Prototype: fun [S S] I * * \param S : first string to test * \param S : second string to test * * \return I : 1 if smaller 0 otherwise **/ fun isSmaller(s, t)= ((strcmp s t) < 0);; /*! @ingroup toolslib * \brief Test if a string is larger than an another string * * Use with quicksort function 0 * Prototype: fun [S S] I * * \param S : first string to test * \param S : second string to test * * \return I : superior to 0 if larger **/ fun isLarger(s, t)= ((strcmp s t) > 0);; /*! @ingroup toolslib * \brief Test if a string is equal to an another string * * Use with quicksort function * * Prototype: fun [S S] I * * \param S : first string to test * \param S : second string to test * * \return I : different to 0 if not equal **/ fun suppDoublon(s1,s2)= strcmpi s1 s2;; /*! @ingroup toolslib * \brief Test if a value is equal to an another value * * Use with quicksort function * * Prototype: fun [u0 u0] I * * \param u0 : first value to test * \param u0 : second value to test * * \return I : 1 if not equal 0 otherwise **/ fun suppDoublon2(s1,s2)= s1!=s2;; /*! @ingroup toolslib * \brief Test if a string is equal to an another string case sensivity * * Use with quicksort function * * Prototype: fun [S S] I * * \param S : first string to test * \param S : second string to test * * \return I : different to 0 if not equal **/ fun suppDoublonCaseSenvivity(s1,s2)= strcmp s1 s2;; /*! @ingroup toolslib * \brief Sort a list * * Prototype: fun [[u0 r1] fun [u0 u0] I] [u0 r1] * * \param [u0 r1] : list to sort * \param fun [u0 u0] I : function for sort test (suppDoublon for example) * * \return [u0 r1] : sorted list **/ fun quicksort(l,f)= if l==nil then nil else let l->[vl nl] in let divideList vl nl nil nil f->[va na] in lcat quicksort va f vl::quicksort na f;; /*! @ingroup toolslib * \brief Sort a list by position * * Prototype: fun [[[u0 r1] r1] I fun [u0 u0] I] [[u0 r1] r1] * * \param [u0 r1] : list to sort * \param fun [u0 u0] I : function for sort test (suppDoublon for example) * * \return [[u0 r1] r1] : sorted list **/ fun quicksortByPos(l,pos,f)= if l==nil then nil else let l->[vl nl] in let divideListPos vl nl nil nil pos f->[va na] in lcat quicksortByPos va pos f vl::quicksortByPos na pos f;; /*! @ingroup toolslib * \brief Sort a string list * * Prototype: fun [[S r1] fun [S S] I] [S r1] * * \param [S r1] : list to sort * \param fun [S S] I : function for sort test (suppDoublon for example) * * \return [S r1] : sorted list **/ fun quicksortList(l,f)= if l==nil then nil else let l->[vl nl] in let divideListString vl nl nil nil f->[va na] in lcat quicksortList va f vl::quicksortList na f;; /*! @ingroup toolslib * \brief Sort a string list * * Prototype: fun [[[[S u0] r1] r1]] fun [S S] I] [[[S u0] r1] r1]] * * \param [S r1] : list to sort * \param fun [S S] I : function for sort test (suppDoublon for example) * * \return [[[S u0] r1] r1]] : sorted list **/ fun quicksort3(l,f)= if l==nil then nil else let l->[vl nl] in let divideList3 vl nl nil nil f->[va na] in lcat quicksort3 va f vl::quicksort3 na f;; /*! @ingroup toolslib * \brief Sort a list * * Prototype: fun [[u0 r1] fun [u0 u0] I] [u0 r1] * * \param [u0 r1] : list to sort * \param fun [u0 u0] I : function for sort test (suppDoublon for example) * * \return [u0 r1] : sorted list **/ fun sortlist(l,f)= if l == nil then nil else let l -> [head tail] in let extractList tail head f -> [left right] in lcat (sortlist left f) head::(sortlist right f);; /*! @ingroup toolslib * \brief Reverse a list * * Prototype: fun [[u0 r1]] I * * \param [u0 r1] : list to revert * * \return [u0 r1] : reversed list **/ fun revertlist(list)= if list==nil then nil else let list -> [first next] in lcat revertlist next first::nil;; /*! @ingroup toolslib * \brief Test if a string exist in a list * * Prototype: fun [[S r1] S] I * * \param [S r1] : list * \param S : string to search * * \return I : 1 if the string exist in the list 0 otherwise **/ fun isStringInList(l, string)= (l!=nil)&&((!strcmp string hd l)||(isStringInList tl l string));; /*! @ingroup toolslib * \brief Test if a string exist in a list case insensitivity * * Prototype: fun [[S r1] S] I * * \param [S r1] : list * \param S : string to search * * \return I : 1 if the string exist in the list 0 otherwise **/ fun isStringInListi(l, string)= (l!=nil)&&((!strcmpi string hd l)||(isStringInListi tl l string));; /*! @ingroup toolslib * \brief Add a string element as unique * * Prototype: fun [[S r1] S] [S r1] * * \param [S r1] : list * \param S : unique element * * \return [S r1] : new list **/ fun addUniqueStr(l, str)= if (isStringInList l str) then l else str::l;; /*! @ingroup toolslib * \brief Add a string element as unique, case insensitivity * * Prototype: fun [[S r1] S] [S r1] * * \param [S r1] : list * \param S : unique element * * \return [S r1] : new list **/ fun addUniqueStri(l, str)= if (isStringInListi l str) then l else str::l;; /*! @ingroup toolslib * \brief get a string position in a list * * Prototype: fun [[S r1] S] I * * \param [S r1] : list * \param S : string to search * * \return I : string position or nil if not found **/ fun getStringPosInList(l, string)= if !(isStringInList l string) then nil else let 0 -> i in ( while ((l != nil) && (strcmp string hd l)) do ( set i = i + 1; set l = tl l; ); i; );; /*! @ingroup toolslib * \brief get a string position in a list case insensitivity * * Prototype: fun [[S r1] S] I * * \param [S r1] : list * \param S : string to search * * \return I : string position or nil if not found **/ fun getStringPosInListi(l, string)= if !(isStringInListi l string) then nil else let 0 -> i in ( while ((l != nil) && (strcmpi string hd l)) do ( set i = i + 1; set l = tl l; ); i; );; /*! @ingroup toolslib * \brief Test if a string exist in a list as the first word of the string * * Prototype: fun [[S r1] S] I * * \param [S r1] : list * \param S : string to search * * \return I : 1 if the string exist in the list 0 otherwise **/ fun isFirstWordInList(l, string)= (l!=nil)&&((!strcmp (hd hd (strextr string)) (hd l))||(isFirstWordInList tl l string));; /*! @ingroup toolslib * \brief Test if a string exist in a list as the first word of the string case insensitivity * * Prototype: fun [[S r1] S] I * * \param [S r1] : list * \param S : string to search * * \return I : 1 if the string exist in the list 0 otherwise **/ fun isFirstWordInListi(l, string)= (l!=nil)&&((!strcmpi (hd hd (strextr string)) (hd l))||(isFirstWordInListi tl l string));; /*! @ingroup toolslib * \brief Test if the first string of a list match to a word * * Prototype: fun [[[S r1] r1] S] I * * \param [[S r1] r1] : list * \param S : string to compare * * \return I : 1 if the string exist in the list 0 otherwise **/ fun isFirstStringInList(l, string)= let hd hd l -> tstr in (l!=nil)&&((!strcmp string tstr)||(isFirstStringInList tl l string));; /*! @ingroup toolslib * \brief Test if the first tuple value in list is present * * Prototype: fun [[[u0 u1] r1] u0] I * * \param [[I u0] r1] : list * \param u0 : value to compare * * \return I : 1 if the value exist in the list 0 otherwise **/ fun isT1InList(l, val)= let hd l -> [cval _] in (l!=nil)&&((cval == val)||(isT1InList tl l val));; /*! @ingroup toolslib * \brief Test if the second tuple value in list is present * * Prototype: fun [[[u0 u1] r1] u1] I * * \param [[I u0] r1] : list * \param u1 : value to compare * * \return I : 1 if the value exist in the list 0 otherwise **/ fun isT2InList(l, val)= let hd l -> [_ cval] in (l!=nil)&&((cval == val)||(isT2InList tl l val));; fun getPathFile(longfile, file)= if (longfile==nil) || (strlen longfile)==0 || (nth_char longfile ((strlen longfile)-1)) == '/ then ( if (strfind "." file 0) != nil then [longfile file] else if file != nil then [strcatn longfile::file::"/"::nil nil] else [longfile nil]; ) else getPathFile substr longfile 0 (strlen longfile)-1 strcat substr longfile ((strlen longfile)-1) 1 file;; fun getlastPathDir(path)= while ((strfind "/" path 0) != nil) do set path = substr path ((strfind "/" path 0) + 1) 2048; path;; fun getFileExt(file)= let getPathFile file "" -> [_ file2] in let 0 -> pos in ( while (strfind "." file2 pos + 1) != nil do ( set pos = strfind "." file2 pos + 1; ); if pos == 0 then nil else substr file2 (pos + 1) 1024; );; fun getFilePathWithoutExt(file)= substr file 0 (strfind "." file 0);; fun getFileDirectory(file)= let getPathFile file "" -> [dir _] in dir;; // return the fileName without Path and Extension fun getFileNameWithoutExt(file)= let getPathFile file "" -> [_ file2] in substr file2 0 (strfind "." file2 0);; /* manage relativ paths (relativ files should start with ./ */ fun getRelativePath(path, file)= if !strcmp substr file 0 2 "./" then strcatn path::"/"::(substr file 2 strlen file)::nil else file;; fun cutDotName(name)= [(substr name 0 (strfind "." name 0)) (substr name ((strfind "." name 0) + 1) 1024)];; fun makeDotName(id, name)= strcatn id::"."::name::nil;; fun getFilesFromDir(dir, mask)= let _listoffiles dir -> files in let nil -> lfiles in let sizelist files -> size in let 0 -> i in ( while i < size do ( let nth_list files i -> file in let getFileExt file -> ext in if (mask != nil) && !(isStringInListi mask ext) then nil else set lfiles = lcat lfiles file::nil; set i = i + 1; ); lfiles; );; fun getBooleanFromString(str)= if (!strcmpi strtrim str "enable") || (!strcmpi strtrim str "ON") || (!strcmpi strtrim str "true") || (!strcmpi strtrim str "yes") || ((atoi str) == 1) then 1 else 0;; fun isLastWordfromString(word, string)= !strcmpi word (substr string ((strlen string) - (strlen word)) (strlen word));; fun isFirstWordfromString(word, string)= !strcmpi word (substr string 0 (strlen word));; fun listLowercase(l)= let sizelist l -> size in let nil -> ndata in let 0 -> i in ( while i < size do ( let nth_list l i -> elem in set ndata = lcat ndata (strlowercase elem)::nil; set i = i + 1; ); ndata; );; fun getDirListFromPath(path)= let nil -> lpaths in ( let _listofsubdir path -> ldirs in let sizelist ldirs -> size in let 0 -> i in while i < size do ( let nth_list ldirs i -> dir in set lpaths = lcat lpaths dir::(getDirListFromPath dir); set i = i + 1; ); lpaths );; fun getFilesFromDirRecursive(dir)= if (isLastWordfromString ".svn" dir) then nil else let _listoffiles dir -> lfiles in let _listofsubdir dir -> lsubdirs in ( let sizelist lsubdirs -> size in let 0 -> i in while i < size do ( let nth_list lsubdirs i -> elem in set lfiles = lcat lfiles (getFilesFromDirRecursive elem); set i = i + 1; ); lfiles; );; fun cleanDirectory(dir)= let _listoffiles dir -> lfiles in let _listofsubdir dir -> lsubdirs in ( let sizelist lsubdirs -> size in let 0 -> i in while i < size do ( let nth_list lsubdirs i -> elem in cleanDirectory elem; set i = i + 1; ); let sizelist lfiles -> size in let 0 -> i in while i < size do ( let nth_list lfiles i -> elem in _deletepack _checkpack elem; set i = i + 1; ); ); 0;; fun getDirectoryWithoutLastSlash(dir)= if isLastWordfromString "/" dir then substr dir 0 ((strlen dir) - 1) else dir;; fun getDirectoryWithoutFirstSlash(dir)= if isFirstWordfromString "/" dir then substr dir 1 ((strlen dir) - 1) else dir;; fun apply_on_list(l,f,x)= if l==nil then 0 else let l -> [a nxt] in (exec f with [a x]; apply_on_list nxt f x);; fun rev_apply_on_list(l,f,x)= if l==nil then 0 else let l -> [a nxt] in (rev_apply_on_list nxt f x; exec f with [a x];0);; fun search_in_list(l,f,x)= if l==nil then nil else let l -> [a nxt] in if exec f with [a x] then a else search_in_list nxt f x;; fun remove_from_list(l,p)= if l==nil then nil else let l -> [a nxt] in if a==p then nxt else a::remove_from_list nxt p;; fun tlr2(l, n)= let sizelist l -> size in let 0 -> i in let 0 -> nn in let nil -> nl in ( while i < size do ( let nth_list l i -> lelt in ( while (nn < n) do ( set lelt = tl lelt; set nn = nn + 1; ); set nl = lcat nl lelt::nil; ); set i = i + 1; ); nl; );; fun remove_string_from_list(l, elt)= if l==nil then nil else let hd l -> elm in if !strcmpi elm elt then tl l else (hd l)::remove_string_from_list tl l elt;; fun remove_idx_from_list(l, idx)= if l==nil then nil else let hd l -> [id _] in if id == idx then tl l else (hd l)::remove_idx_from_list tl l idx;; fun remove_sid_from_list(l, sid)= if l==nil then nil else let hd l -> [id _] in if (!strcmp id sid) then tl l else (hd l)::remove_sid_from_list tl l sid;; fun remove_first_string_from_list(l, elt)= if l==nil then nil else let hd hd l -> elm in if !strcmpi elm elt then tl l else (hd l)::remove_first_string_from_list tl l elt;; fun remove_all_first_string_from_list(l, elt)= if l==nil then nil else let hd hd l -> elm in if !strcmpi elm elt then remove_all_first_string_from_list tl l elt else (hd l)::remove_all_first_string_from_list tl l elt;; fun remove_first_and_second_string_from_list(l, elt1, elt2)= if l==nil then nil else let hd hd l -> elm1 in let hd tl hd l -> elm2 in if (!strcmpi elm1 elt1) && (!strcmpi elm2 elt2) then tl l else (hd l)::remove_first_and_second_string_from_list tl l elt1 elt2;; fun remove_first_string_from_list_start_with(l, elt)= if l==nil then nil else let hd hd l -> elm in if !strcmpi (substr elm 0 (strlen elt)) elt then remove_first_string_from_list_start_with tl l elt else (hd l)::remove_first_string_from_list_start_with tl l elt;; fun pos_in_list(l,p,n)= if l==nil then nil else let l -> [a nxt] in if a==p then n else pos_in_list nxt p n+1;; fun create_tab(n,f,x)= let mktab n nil -> t in (let 0->i in while i l in if f==nil then [l l] else let f->[a b] in (mutate b<-[_ l]; [a l]);; fun getFifo(f)= if f==nil then [nil nil] else let f->[a b] in if a==b then [hd a nil] else [hd a [tl a b]];; fun sizeFifo(f)= if f==nil then 0 else let f->[a _] in sizelist a;; fun concFifo(f,g)= if f==nil then g else if g==nil then f else let f->[a b] in let g->[c d] in (mutate b<-[_ c]; [a d]);; fun hexListToBignumList(l)= let sizelist l -> size in let nil -> ndata in let 0 -> i in ( while i < size do ( let nth_list l i -> elt in set ndata = lcat ndata (BigFromAsc elt)::nil; set i = i + 1; ); ndata; );; fun strcatnSep(l, sep)= let sizelist l -> size in let nil -> ndata in let 0 -> i in ( while i < size do ( let nth_list l i -> elem in if i == 0 then set ndata = elem else set ndata = strcatn ndata::sep::elem::nil; set i = i + 1; ); ndata; );; fun strcatnlSep(l, sep)= if l == nil then nil else let sizelist l -> size in let nil -> ndata in let 0 -> i in ( while i < size do ( let nth_list l i -> elem in if i == 0 then set ndata = (strcatnSep elem sep) else set ndata = strcatn ndata::"\n"::(strcatnSep elem sep)::nil; set i = i + 1; ); ndata; );; fun strreplace(s, from, to)= let 0 -> pos in let strlen from -> fsize in let strlen to -> tsize in if ((fsize <= 0) || (tsize <= 0)) then nil else while ((set pos = strfind from s pos) != nil) do ( set s = strcatn (substr s 0 pos)::to::(substr s (pos + fsize) ((strlen s) - pos))::nil; set pos = pos + tsize; ); s;; fun strreplacei(s, from, to)= let 0 -> pos in let strlen from -> fsize in let strlen to -> tsize in if ((fsize <= 0) || (tsize <= 0)) then s else while ((set pos = strfindi from s pos) != nil) do set s = strcatn (substr s 0 pos)::to::(substr s (pos + fsize) ((strlen s) - pos))::nil; s;; fun strfindiList(l, s)= let nil -> found in ( let sizelist l -> size in let 0 -> i in while ((i < size) && (found == nil)) do ( let nth_list l i -> elt in let strfindi elt s 0 -> pos in if (pos == nil) then nil else set found = [i pos]; set i = i + 1; ); found; );; fun addSlashes(s)= let "" -> ret in ( let strlen s -> size in let 0 -> i in while (i < size) do ( let nth_char s i -> char in if (char == 34) || (char == 39) || (char == 92) then set ret = strcatn ret::(ctoa 92)::(ctoa char)::nil else set ret = strcat ret (ctoa char); set i = i + 1; ); ret; );; fun strTruncate(s, maxlen, rp)= if (strlen s) > maxlen then strcat substr s 0 (maxlen - (strlen rp)) rp else s;; fun strQuote(s, q)= strcatn q::(strtrim s)::q::nil;; fun listQuote(l, q)= let nil -> nl in ( let sizelist l -> size in let 0 -> i in while i < size do ( let nth_list l i -> elt in set nl = lcat nl (strQuote elt q)::nil; set i = i + 1; ); nl; );; fun strToList(s)= let nil -> ret in let strextr s -> l in ( let sizelist l -> size in let 0 -> i in while (i < size) do ( let nth_list l i -> line in set ret = lcat ret (strcatnSep line " ")::nil; set i = i + 1; ); ret; );; fun oneLineTransform(s, sep)= strcatnSep (strToList s) sep;; fun strToListSep(s, sep)= let nil -> ret in let 0 -> spos in ( while (strfindi sep s spos) != nil do ( let strfindi sep s spos -> fpos in let substr s spos (fpos - spos) -> value in ( set ret = lcat value::nil ret; set spos = fpos + strlen sep; ); ); if (spos >= strlen s) then nil else set ret = lcat (substr s spos ((strlen s) - spos))::nil ret; ret; );; fun strbuildn(l)= let nil -> ret in ( let sizelist l -> size in let 0 -> i in while (i < size) do ( let nth_list l i -> line in set ret = lcat ret (strcatnSep line " ")::nil; set i = i + 1; ); if ret == nil then nil else strcatnSep ret "\n"; );; fun listToString(l)= let nil -> ret in ( let sizelist l -> size in let 0 -> i in while (i < size) do ( let nth_list l i -> line in let strextr line -> lp in set ret = lcat ret (strcatnSep (hd lp) " ")::nil; set i = i + 1; ); if ret == nil then nil else strcatnSep ret "\n"; );; /*! @ingroup toolslib * \brief get the line after a keyword, for example "KEYWORD value" * * Prototype: fun [S S] S * * \param S : string * \param S : keyword * * \return S : the value if the keyword exist nil otherwise **/ fun getNextToValue(cont, keyword)= let strextr cont -> lcont in let sizelist lcont -> size in let 0 -> i in let nil -> ret in ( while ((i < size) && (ret == nil)) do ( let nth_list lcont i -> [word next] in if strcmpi keyword (strtrim word) then nil else set ret = strcatnSep next " "; set i = i + 1; ); ret; );; /* ********************************************************************************************* / HTTP DOWNLOAD / ********************************************************************************************* */ typeof lHTTP_COOKIES = [[S S] r1];; typeof lHTTP_REQUEST = [INET r1];; fun strIsUrl(url)= if ((!strcmp (substr url 0 8) "https://") || (!strcmp (substr url 0 7) "http://") || (!strcmp (substr url 0 7) "file://") || (!strcmp (substr url 0 6) "ftp://") || (!strcmp (substr url 0 7) "scol://")) && ((strlen url) > 10) then 1 else 0;; fun clearHttpRequest()= let lHTTP_REQUEST -> l in while (l != nil) do ( INETStopURL hd l; set l = tl l; ); set lHTTP_REQUEST = nil; 0;; fun killHttpRequest(req)= if (req == nil) then nil else ( INETStopURL req; set lHTTP_REQUEST = remove_from_list lHTTP_REQUEST req; ); 0;; fun clearHttpCookies()= set lHTTP_COOKIES = nil; 0;; fun getHttpDomain(url)= let if (!strcmp (substr url 0 8) "https://") then substr url 8 ((strlen url) - 8) else if (!strcmp (substr url 0 7) "http://") then substr url 7 ((strlen url) - 7) else if (!strcmp (substr url 0 7) "file://") then substr url 7 ((strlen url) - 7) else if (!strcmp (substr url 0 6) "ftp://") then substr url 6 ((strlen url) - 6) else url -> baseurl in substr baseurl 0 (strfind "/" baseurl 0);; fun getHtmlHeader(cont)= let strextr cont -> lcont in let sizelist lcont -> size in let 0 -> i in let 0 -> pos in ( while ((i < size) && (pos <= 0)) do ( let hd nth_list lcont i -> word in if word != nil then nil else set pos = i; set i = i + 1; ); let splitList lcont pos -> [l1 l2] in [(strbuildn l1) (strbuildn tl l2)]; );; fun decompHtmlCookie(cookie)= let strToListSep cookie ";" -> l in let [nil nil nil 0 0] -> pout in ( let sizelist l -> size in let 0 -> i in while i < size do ( let nth_list l i -> elt in if (!strcmpi "Domain=" (substr elt 0 7)) then mutate pout <- [_ (substr elt 7 ((strlen elt) - 7)) _ _ _] else if (!strcmpi "Path=" (substr elt 0 5)) then mutate pout <- [_ _ (substr elt 5 ((strlen elt) - 5)) _ _] else if (!strcmpi "Secure" (substr elt 0 6)) then mutate pout <- [_ _ _ 1 _] else if (!strcmpi "HttpOnly" (substr elt 0 8)) then mutate pout <- [_ _ _ _ 1] else mutate pout <- [elt _ _ _ _]; set i = i + 1; ); pout; );; fun getHtmlStatus(header)= let getNextToValue header "status:" -> status in let atoi (hd lineextr status) -> code in ( if (code != nil) then nil else let getNextToValue header "HTTP/1.1" -> status in set code = atoi (hd lineextr status); if (code != nil) then nil else let getNextToValue header "HTTP/1.0" -> status in set code = atoi (hd lineextr status); code; );; fun setHtmlCookie(url, header)= let getHttpDomain url -> baseurl in let getNextToValue header "Set-Cookie:" -> cookie in if (cookie == nil) then nil else ( //_fooS strcatn ">>>>>>>>> add cookie : "::cookie::" on "::baseurl::nil; set lHTTP_COOKIES = remove_sid_from_list lHTTP_COOKIES baseurl; set lHTTP_COOKIES = [baseurl cookie]::lHTTP_COOKIES; ); 0;; fun makeHtmlCookie(url)= let getHttpDomain url -> baseurl in let switchstri lHTTP_COOKIES baseurl -> cookie in if (cookie == nil) then nil else strcatn "Cookie: "::cookie::(ctoa 13)::(ctoa 10)::nil;; fun getHtmlCookie(url)= let getHttpDomain url -> baseurl in switchstri lHTTP_COOKIES baseurl;; fun cbDownloadFile(req, p, data, code)= let p -> [str url cbfun] in if (code == 0) then ( mutate p <- [(strcat str data) _ _]; 0; ) // download finished else if (code == 1) then ( set lHTTP_REQUEST = remove_from_list lHTTP_REQUEST req; exec cbfun with [url (strcat str data)]; ) else ( _fooS strcat ">>>>>>>>> Http download failed : " url; set lHTTP_REQUEST = remove_from_list lHTTP_REQUEST req; exec cbfun with [url nil]; 0; ); 0;; fun downloadFile (file, cbfun)= if strIsUrl file then let makeHtmlCookie file -> cookie in ( set lHTTP_REQUEST = (INETGetURLex2 _channel "GET" file cookie nil 0 @cbDownloadFile ["" file cbfun])::lHTTP_REQUEST; hd lHTTP_REQUEST; ) else ( exec cbfun with [file nil]; nil; );; fun cbGetUrlContent(req, p, data, code)= let p -> [str url cbfun fullres] in if (code == 0) then ( mutate p <- [(strcat str data) _ _ _]; 0; ) // download finished else if (code == 1) then ( set lHTTP_REQUEST = remove_from_list lHTTP_REQUEST req; set data = strcat str data; let getHtmlHeader data -> [header cont] in ( setHtmlCookie url header; exec cbfun with [url (if fullres then data else cont)]; ); ) else ( _fooS strcat ">>>>>>>>> Http download failed : " url; set lHTTP_REQUEST = remove_from_list lHTTP_REQUEST req; exec cbfun with [url nil]; 0; ); 0;; fun deleteUrlEx(url, params, cbfun, headeradd, fullres)= let if (headeradd != nil) && (strcmp (strtrim headeradd) "") then strcatn headeradd::(ctoa 13)::(ctoa 10)::"content-type: application/x-www-form-urlencoded;"::nil else "content-type: application/x-www-form-urlencoded;" -> header in let makeHtmlCookie url -> cookie in let if (cookie == nil) then header else strcat cookie header -> header in if strIsUrl url then ( INETGetURLex2 _channel "DELETE" url header params (if fullres then INET_HEADER else 0) @cbGetUrlContent ["" url cbfun fullres]; hd lHTTP_REQUEST; ) else ( exec cbfun with [url nil]; nil; );; fun postUrlEx(url, params, cbfun, headeradd, fullres)= let if (headeradd != nil) && (strcmp (strtrim headeradd) "") then strcatn headeradd::(ctoa 13)::(ctoa 10)::"content-type: application/x-www-form-urlencoded;"::nil else "content-type: application/x-www-form-urlencoded;" -> header in let makeHtmlCookie url -> cookie in let if (cookie == nil) then header else strcat cookie header -> header in if strIsUrl url then ( set lHTTP_REQUEST = (INETGetURLex2 _channel "POST" url header params INET_HEADER @cbGetUrlContent ["" url cbfun fullres])::lHTTP_REQUEST; hd lHTTP_REQUEST; ) else ( exec cbfun with [url nil]; nil; );; fun getUrlEx(url, params, cbfun, headeradd, fullres)= let if (headeradd != nil) && (strcmp (strtrim headeradd) "") then strcatn headeradd::(ctoa 13)::(ctoa 10)::"content-type: application/x-www-form-urlencoded;"::nil else "content-type: application/x-www-form-urlencoded;" -> header in let makeHtmlCookie url -> cookie in let if (cookie == nil) then header else strcat cookie header -> header in if strIsUrl url then ( set lHTTP_REQUEST = (INETGetURLex2 _channel "GET" url header params INET_HEADER @cbGetUrlContent ["" url cbfun fullres])::lHTTP_REQUEST; hd lHTTP_REQUEST; ) else ( exec cbfun with [url nil]; nil; );; fun postUrlMultiPartEx(url, lparams, cbfun, headeradd, fullres)= if strIsUrl url then let if (headeradd != nil) && (strcmp (strtrim headeradd) "") then strcatn headeradd::(ctoa 13)::(ctoa 10)::nil else "" -> header in let makeHtmlCookie url -> cookie in let if (cookie == nil) then header else strcat cookie header -> header in let "----ScolHttpBoundary" -> boundary in let strcatn header::"Content-Type:multipart/form-data; boundary="::boundary::nil -> contenttype in let strcat "--" boundary -> postdata in ( let sizelist lparams -> size in let 0 -> i in while i < size do ( let nth_list lparams i -> [name value file] in ( if(file == nil) then ( set postdata = strcatn postdata::(ctoa 13)::(ctoa 10)::"Content-Disposition: form-data; name=\""::name::"\""::(ctoa 13)::(ctoa 10)::(ctoa 13)::(ctoa 10)::nil; ) else ( set postdata = strcatn postdata::(ctoa 13)::(ctoa 10)::"Content-Disposition: form-data; name=\""::name::"\";"::" filename=\""::file::"\""::(ctoa 13)::(ctoa 10)::nil; set postdata = strcatn postdata::"Content-Type: text/plain"::(ctoa 13)::(ctoa 10)::(ctoa 13)::(ctoa 10)::nil; ); set postdata = strcat postdata value; set postdata = strcatn postdata::(ctoa 13)::(ctoa 10)::"--"::boundary::nil; ); set i = i + 1; ); set postdata = strcat postdata "--"; set lHTTP_REQUEST = (INETGetURLex2 _channel "POST" url contenttype postdata INET_HEADER @cbGetUrlContent ["" url cbfun fullres])::lHTTP_REQUEST; hd lHTTP_REQUEST; ) else ( exec cbfun with [url nil]; nil; );; fun getUrl(url, params, cbfun)= getUrlEx url params cbfun nil 0;; fun postUrl(url, params, cbfun)= postUrlEx url params cbfun nil 0;; fun postUrlMultiPart(url, lparams, cbfun)= postUrlMultiPartEx url lparams cbfun nil 0;; fun deleteUrl(url, params, cbfun)= deleteUrlEx url params cbfun nil 0;; /* ********************************************************************************************* / Vector / ********************************************************************************************* */ fun minf(a, b)= if a <. b then a else b;; fun zeroVector(vec)= let vec -> [x y z] in if (x || y || z) then 0 else 1;; fun zeroVectorF(vec)= let vec -> [x y z] in if (((x != 0.0) && (x != nil)) || ((y != 0.0) && (y != nil)) || ((z != 0.0) && (z != nil))) then 0 else 1;; fun vectorIsZero(vec)= let vec -> [x y z] in x == 0 && y == 0 && z == 0;; fun vectorIsZeroF(vec)= let vec -> [x y z] in x == 0.0 && y == 0.0 && z == 0.0;; fun vectorEqual(vec1, vec2)= let vec1 -> [x1 y1 z1] in let vec2 -> [x2 y2 z2] in x1 == x2 && y1 == y2 && z1 == z2;; fun normalizeVectorF(vec)= let vec -> [x y z] in let (absf x) +. (absf y) +. (absf z) -> sum in let if (sum == 0.0) then 1.0 else 1.0 /. sum -> coef in [(x *. coef) (y *. coef) (z *. coef)];; fun vectorAverageF(vec)= let vec -> [x y z] in x +. y +. z /. 3.0;; fun vectorCubeF(vec)= let vec -> [x y z] in x *. y *. z;; fun subVector(vec1, vec2)= let vec1 -> [x1 y1 z1] in let vec2 -> [x2 y2 z2] in [(x1 - x2) (y1 - y2) (z1 - z2)];; fun subVectorF(vec1, vec2)= let vec1 -> [x1 y1 z1] in let vec2 -> [x2 y2 z2] in [(x1 -. x2) (y1 -. y2) (z1 -. z2)];; fun addVector(vec1, vec2)= let vec1 -> [x1 y1 z1] in let vec2 -> [x2 y2 z2] in [(x1 + x2) (y1 + y2) (z1 + z2)];; fun addVectorF(vec1, vec2)= let vec1 -> [x1 y1 z1] in let vec2 -> [x2 y2 z2] in [(x1 +. x2) (y1 +. y2) (z1 +. z2)];; fun divideVector(vec1, vec2)= if vectorIsZero vec2 then nil else let vec1 -> [x1 y1 z1] in let vec2 -> [x2 y2 z2] in [(x1 / x2) (y1 / y2) (z1 / z2)];; fun divideVectorF(vec1, vec2)= if vectorIsZeroF vec2 then nil else let vec1 -> [x1 y1 z1] in let vec2 -> [x2 y2 z2] in [(x1 /. x2) (y1 /. y2) (z1 /. z2)];; fun multiplyVector(vec1, vec2)= let vec1 -> [x1 y1 z1] in let vec2 -> [x2 y2 z2] in [(x1 * x2) (y1 * y2) (z1 * z2)];; fun multiplyVectorF(vec1, vec2)= let vec1 -> [x1 y1 z1] in let vec2 -> [x2 y2 z2] in [(x1 *. x2) (y1 *. y2) (z1 *. z2)];; fun getShortestAngle(p, q) = let (absf (q -. p)) -> path1 in let (absf (q +. 360.0 -. p)) -> path2 in let (absf (q -. 360.0 -. p)) -> path3 in let minf path1 minf path2 path3 -> minpath in if (minpath == path1) then q else if (minpath == path2) then (q +. 360.0) else (q -. 360.0);; /* ********************************************************************************************* / Date / ********************************************************************************************* */ /*! @ingroup toolslib * \brief get the number of day for a month depending of the year * * Prototype: fun [I I] I * * \param I : the month * \param I : the year * * \return I : the number of days **/ fun getMonthDays(month, year)= if (month <= 0) then nil else let if ((mod year 4)==0 && (mod year 100) != 0) || (mod year 400)==0 then 29 else 28 -> feb in let 0::31::feb::31::30::31::30::31::31::30::31::30::31::nil -> nbdays in nth_list nbdays month;; /*! @ingroup toolslib * \brief test if a date string is valid * * Prototype: fun [S] I * * \param S : the date in string format ("Tue Jan 21 11:24:53 1997") * * \return I : 1 if valid, 0 otherwise **/ fun isDateString(date)= let hd strextr date -> [dayname [monthname [day [hour [year _]]]]] in ((strfind dayname "SunMonTueWedThuFriSat" 0) != nil) && ((strfind monthname "JanFebMarAprMayJunJulAugSepOctNovDec" 0) != nil) && ((atoi day) != 0) && ((strlen hour) == 8) && (!strcmp (substr hour 2 1) ":") && (!strcmp (substr hour 5 1) ":") && (let (atoi (substr hour 0 2)) -> H in (H>=0) && (H<24)) && (let (atoi (substr hour 3 2)) -> M in (M>=0) && (M<60)) && (let (atoi (substr hour 6 2)) -> Sc in (Sc>=0) && (Sc<60)) && ((strlen year) == 4) && ((atoi year) != 0);; /*! @ingroup toolslib * \brief get the number of seconds from a complete date time * * Prototype: fun [I I I I I I] I * * \param I : the day * \param I : the month * \param I : the year * \param I : the hours * \param I : the minutes * \param I : the seconds * * \return I : the number of seconds from 1970 **/ fun getSecondsFromDateTime(day, month, year, hours, minutes, seconds)= (((((((year-1969) / 4) + 365 * (year - 1970) + (getMonthDays month year) + day - 1) * 24 + hours - 2) * 60) + minutes) * 60) + seconds;; /*! @ingroup toolslib * \brief get the decomposed date time from a string date * * Prototype: fun [S] [I I I I I I] * * \param S : the date in string format ("Tue Jan 21 11:24:53 1997") * * \return [I I I I I I] : return nil is the input string is not a valid date * \I : the day * \I : the month * \I : the year * \I : the hours * \I : the minutes * \I : the seconds **/ fun getDateTimeFromString(date)= if (!isDateString date) then nil else // let ["Mon" 1]::["Tue" 2]::["Wed" 3]::["Thu" 4]::["Fri" 5]::["Sat" 6]::["Sun" 7]::nil -> ldays in let ["Jan" 1]::["Feb" 2]::["Mar" 3]::["Apr" 4]::["May" 5]::["Jun" 6]::["Jul" 7]::["Aug" 8]::["Sep" 9]::["Oct" 10]::["Nov" 11]::["Dec" 12]::nil -> lmonths in let hd strextr date -> [dayname [monthname [day [hour [year _]]]]] in let atoi (substr hour 0 2) -> hours in let atoi (substr hour 3 2) -> minutes in let atoi (substr hour 6 2) -> seconds in [(atoi day) (switchstr lmonths monthname) (atoi year) hours minutes seconds];; /*! @ingroup toolslib * \brief get the current date time * * Prototype: fun [I] [I I I I I I] * * \param I : 0 or nil for local time, 1 for GMT * * \return [I I I I I I] : * \I : the day * \I : the month * \I : the year * \I : the hours * \I : the minutes * \I : the seconds **/ fun getCurrentDateTime(mode)= let if (mode >= 1) then (gmtime time) else (localtime time) -> [seconds minutes hours day month year _ _] in [day month year hours minutes seconds] ;; /*! @ingroup toolslib * \brief get the current time * * Prototype: fun [I] [I I I] * * \param I : 0 or nil for local time, 1 for GMT * * \return [I I I] : * \I : the hours * \I : the minutes * \I : the seconds **/ fun getCurrentTime(mode)= let if (mode >= 1) then (gmtime time) else (localtime time) -> [seconds minutes hours day month year _ _] in [hours minutes seconds] ;;