/*
-----------------------------------------------------------------------------
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
-----------------------------------------------------------------------------
*/
/*! \mainpage OpenSpace3D high level libraries API
*
* \section intro_sec Introduction
* This API provide an high level method to easily develop OpenSpace3D applications and PlugITs
*
*/
/*! @defgroup toolslib OpenSpace3D high level Tools
* OpenSpace3D high level Tools
* @{
*/
/*! @defgroup toolslist List tools
* List tools
* @{
*/
/** @} */
/*! @defgroup toolsstr String tools
* String tools
* @{
*/
/** @} */
/*! @defgroup toolscommon Common tools
* Common tools
* @{
*/
/** @} */
/*! @defgroup toolsfile File tools
* File tools
* @{
*/
/** @} */
/*! @defgroup toolsdl Network requests and download tools
* Network requests and download tools
* @{
*/
/** @} */
/*! @defgroup toolsvec Vector tools
* Vector tools
* @{
*/
/** @} */
/*! @defgroup toolsdate Date tools
* Date tools
* @{
*/
/** @} */
/*! @defgroup csvtools CSV parser / writer
* CSV tools
* @{
*/
/** @} */
/** @} */
/*! @ingroup plugITApi
* \brief Add a log message in the OS3D log window
*
* Prototype: fun [S] S
*
* \param S : the message to print in the log window
*
* \return S : the same message
**/
proto addLogMessage = fun [S] S;;
/*! @ingroup plugITApi
* \brief Add a log message in the OS3D log window from a list
*
* Prototype: fun [S [S r1]] I
*
* \param S : the message prefix
* \param [S r1] : a list of messages to print in the log window
*
* \return 0
**/
proto addLogMessageMulti = fun [S [S r1]] I;;
proto strreplace = fun [S S S] S;;
fun isSpace(c)=
(c == 32) || (c == 12) || (c == 10) || (c == 13) || (c == 9) || (c == 11);;
fun isDigit(c)=
(c >= 48) && (c <= 57);;
fun isAlpha(c)=
((c >= 65) && (c <= 90)) || ((c >= 97) && (c <= 122));;
fun getInfo(l,a)=
if l==nil then nil else
let l->[q nxt] in
if !strcmp hd q a then
hd tl q
else
getInfo nxt a;;
fun getInfos(l,a)=
if l==nil then nil else
let l->[q nxt] in
if !strcmp hd q a then
tl q
else
getInfos nxt a;;
fun getInfoI(l,a)=
if l==nil then nil else
let l->[q nxt] in
if !strcmpi hd q a then
hd tl q
else
getInfoI nxt a;;
fun chgusm2(l,a,b,s,k)=
if l==nil then
if k then
s::nil
else nil
else
let l->[ll n] in
let hd strextr ll -> [h [hh _]] in
if (!strcmp h a)&&((b==nil)||(!strcmpi b substr hh 0 strlen b)) then
s::chgusm2 n a b s 0
else
ll::chgusm2 n a b s k;;
fun chgusm(a,b,line)=
_saveusmini linebuild chgusm2 (lineextr _loadusmini nil) a b line 1;;
/*! @ingroup toolslist
* \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 toolslist
* \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 toolslist
* \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 toolscommon
* \brief Test if an int is smaller than another int
*
* Use with quicksort function
*
* Prototype: fun [I I] I
*
* \param I : first int to test
* \param I : second int to test
*
* \return I : 1 if smaller -1 otherwise
**/
fun isSmallerI(s, t)= if (s < t) then 1 else -1;;
/*! @ingroup toolscommon
* \brief Test if a int is larger than another int
*
* Use with quicksort function
0
* Prototype: fun [I I] I
*
* \param I : first int to test
* \param I : second int to test
*
* \return I : 1 if larger -1 otherwise
**/
fun isLargerI(s, t)= if (s > t) then 1 else -1;;
/*! @ingroup toolscommon
* \brief Test if an float is smaller than another float
*
* Use with quicksort function
*
* Prototype: fun [F F] I
*
* \param F : first float to test
* \param F : second float to test
*
* \return I : 1 if smaller -1 otherwise
**/
fun isSmallerF(s, t)= if (s <. t) then 1 else -1;;
/*! @ingroup toolscommon
* \brief Test if a float is larger than another float
*
* Use with quicksort function
0
* Prototype: fun [F F] I
*
* \param F : first float to test
* \param F : second float to test
*
* \return I : 1 if larger -1 otherwise
**/
fun isLargerF(s, t)= if (s >. t) then 1 else -1;;
/*! @ingroup toolsstr
* \brief Test if a string is smaller than 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 toolsstr
* \brief Test if a string is larger than 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 toolsstr
* \brief Test if a string is equal to 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 toolscommon
* \brief Test if a value is equal to 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 toolsstr
* \brief Test if a string is equal to 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 suppDoublonCaseSensivity(s1, s2)= strcmp s1 s2;;
/*! @ingroup toolslist
* \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 toolslist
* \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 toolslist
* \brief Sort a string list
*
* Prototype: fun [[[S r1] r1] fun [S S] I] [S r1]
*
* \param [[S r1] 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 toolslist
* \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 toolslist
* \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 toolslist
* \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 toolslist
* \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 toolslist
* \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 toolslist
* \brief Test if a string exist in a list case insensitivity
*
* Prototype: fun [[S r1] S I I] I
*
* \param [S r1] : list
* \param S : string to search
* \param I : position
* \param I : length
*
* \return I : 1 if the string exist in the list 0 otherwise
**/
fun isStringInListiPos(l, string, pos, length)=
(l!=nil)&&((!strcmpi string (substr (hd l) pos length))||(isStringInListiPos tl l string pos length));;
/*! @ingroup toolslist
* \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 toolslist
* \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 toolslist
* \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 toolslist
* \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 toolslist
* \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 toolslist
* \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 toolslist
* \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 toolslist
* \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 toolslist
* \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));;
/*! @ingroup toolsfile
* \brief Get a file path and file name from a path
*
* Prototype: fun [S S] [S S]
*
* \param S : the path
* \param S : set to nil
*
* \return [S S] : the path and the filename
**/
fun getPathFile(longfile, file)=
if (longfile==nil) || (strlen longfile)==0 || (nth_char longfile ((strlen longfile)-1)) == '/ || (nth_char longfile ((strlen longfile)-1)) == '\ then
(
let if (nth_char longfile ((strlen longfile)-1)) == '/ then "/" else "\\" -> slash in
if (strfind "." file 0) != nil then
[longfile file]
else if file != nil then
[strcatn longfile::file::slash::nil nil]
else
[longfile nil];
)
else
getPathFile
substr longfile 0 (strlen longfile)-1
strcat
substr longfile ((strlen longfile)-1) 1
file;;
/*! @ingroup toolsfile
* \brief Get the last directory from a path
*
* Prototype: fun [S] S
*
* \param S : the path
*
* \return S : the last directory
**/
fun getlastPathDir(path)=
while ((strfind "/" path 0) != nil) do
set path = substr path ((strfind "/" path 0) + 1) 2048;
path;;
/*! @ingroup toolsfile
* \brief Get file extension from a path
*
* Prototype: fun [S] S
*
* \param S : the path
*
* \return S : the file extension
**/
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;
);;
/*! @ingroup toolsfile
* \brief Get file path without the file extension
*
* Prototype: fun [S] S
*
* \param S : the path
*
* \return S : the file path without the file extension
**/
fun getFilePathWithoutExt(file)=
substr file 0 (strfind "." file 0);;
/*! @ingroup toolsfile
* \brief Get path without the file name
*
* Prototype: fun [S] S
*
* \param S : the path
*
* \return S : the path without the file
**/
fun getFileDirectory(file)=
let getPathFile file "" -> [dir _] in
dir;;
/*! @ingroup toolsfile
* \brief Get the file name without Path and Extension
*
* Prototype: fun [S] S
*
* \param S : the path
*
* \return S : the file name
**/
fun getFileNameWithoutExt(file)=
let getPathFile file "" -> [_ file2] in
let 0 -> lastdot in
let -1 -> cpos in
let while (set cpos = (strfind "." file2 cpos + 1)) != nil do set lastdot = cpos -> pos in
substr file2 0 pos;;
/*! @ingroup toolsfile
* \brief Manage relative paths (relativ files should start with ./)
*
* Prototype: fun [S] S
*
* \param S : the path to add
* \param S : the relative file path
*
* \return S : the complete path
**/
fun getRelativePath(path, file)=
if !strcmp substr file 0 2 "./" then
strcatn path::"/"::(substr file 2 strlen file)::nil
else file;;
/*! @ingroup toolsfile
* \brief Create a new folder
*
* Prototype: fun [S] S
*
* \param S : the path to add
*
* \return I : 1 on succes, 0 otherwise
**/
fun createFolder(path)=
let strcat path "/0" -> fdir in
(
_storepack "" fdir;
let _checkpack fdir -> pf in
if (pf == nil) then
(
0;
)
else
(
_deletepack pf;
1;
);
);;
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 isExtInListi(l, string)=
if (l==nil) then 0 else
let hd l -> ext in
let if ((strfind "*." ext 0) == 0) then (substr ext 2 (strlen ext) - 2) else ext -> ext in
(l!=nil)&&((!strcmpi string ext)||(isExtInListi tl l string));;
/*! @ingroup toolsfile
* \brief Compute a name with only allowed char from a string
*
* Prototype: fun [S] S
*
* \param S : original string
*
* \return I : 1 on succes, 0 otherwise
**/
fun getShortName(name)=
let strdup name -> cpname in
//do strlowercase on the copied string, this modify the original string otherwise
let strlowercase cpname -> nname in
(
let "a"::"b"::"c"::"d"::"e"::"f"::"g"::"h"::"i"::"j"::"k"::"l"::"m"::"n"::"o"::"p"::"q"::"r"::"s"::"t"::"u"::"v"::"w"::"x"::"y"::"z"::"0"::"1"::"2"::"3"::"4"::"5"::"6"::"7"::"8"::"9"::nil -> alphanum in
let 0 -> pos in
let "" -> fname in
(
while ((strlen nname) > 0) do
(
let substr nname 0 1 -> letter in
if (!isStringInList alphanum letter) then nil else
set fname = strcat fname letter;
set nname = substr nname 1 strlen nname;
);
fname;
);
);;
/*! @ingroup toolsfile
* \brief Get the files list from a directory, with a file extension mask
*
* Prototype: fun [S [S r1]] [S r1]
*
* \param S : the path to list
* \param [S r1] : a list of string mask (ex : "pkg"::"bmp"::nil)
*
* \return [S r1] : a list of found files
**/
fun getFilesFromDir(dir, mask)=
let !strcmp (hd mask) "*.*" -> all in
let _listoffiles dir -> files in
let nil -> lfiles in
(
while (files != nil) do
(
let hd files -> file in
let getFileExt file -> ext in
if (!all && (mask != nil) && !(isExtInListi mask ext)) then nil else
set lfiles = lcat lfiles file::nil;
set files = tl files;
);
lfiles;
);;
/*! @ingroup toolsfile
* \brief Get the files list from a directory, with a file extension mask and filter
*
* Prototype: fun [S [S r1] fun [S] I ] [S r1]
*
* \param S : the path to list
* \param [S r1] : a list of string mask (ex : "pkg"::"bmp"::nil)
*
* \return [S r1] : a list of found files
**/
fun getFilesFromDirFilter(dir, mask, cbfilter)=
let !strcmp (hd mask) "*.*" -> all in
let _listoffiles dir -> files in
let nil -> lfiles in
(
while (files != nil) do
(
let hd files -> file in
let getFileExt file -> ext in
if ((!all && (mask != nil) && !(isExtInListi mask ext)) || ((cbfilter != nil) && ((exec cbfilter with [file]) != 1))) then nil else
set lfiles = lcat lfiles file::nil;
set files = tl files;
);
lfiles;
);;
/*! @ingroup toolsfile
* \brief Get the files list from a directory, with a file extension mask and case sensitive
*
* Prototype: fun [S [S r1]] [S r1]
*
* \param S : the path to list
* \param [S r1] : a list of string mask (ex : "pkg"::"bmp"::nil)
*
* \return [S r1] : a list of found files
**/
fun getFilesFromDir2(dir, mask)=
let !strcmp (hd mask) "*.*" -> all in
let _listoffiles2 dir -> files in
let nil -> lfiles in
(
while (files != nil) do
(
let hd files -> file in
let getFileExt file -> ext in
if (!all && (mask != nil) && !(isExtInListi mask ext)) then nil else
set lfiles = lcat lfiles file::nil;
set files = tl files;
);
lfiles;
);;
/*! @ingroup toolsfile
* \brief Get the files list from a directory, with a file extension mask and case sensitive and filter
*
* Prototype: fun [S [S r1] fun [S] I ] [S r1]
*
* \param S : the path to list
* \param [S r1] : a list of string mask (ex : "pkg"::"bmp"::nil)
*
* \return [S r1] : a list of found files
**/
fun getFilesFromDirFilter2(dir, mask, cbfilter)=
let !strcmp (hd mask) "*.*" -> all in
let _listoffiles2 dir -> files in
let nil -> lfiles in
(
while (files != nil) do
(
let hd files -> file in
let getFileExt file -> ext in
if ((!all && (mask != nil) && !(isExtInListi mask ext)) || ((cbfilter != nil) && ((exec cbfilter with [file]) != 1))) then nil else
set lfiles = lcat lfiles file::nil;
set files = tl files;
);
lfiles;
);;
/*! @ingroup toolsfile
* \brief Get the files names list from a directory, with a file extension mask
*
* Prototype: fun [S [S r1]] [S r1]
*
* \param S : the path to list
* \param [S r1] : a list of string mask (ex : "pkg"::"bmp"::nil)
*
* \return [S r1] : a list of found files names
**/
fun getFilesNamesFromDir(dir, mask)=
let !strcmp (hd mask) "*.*" -> all in
let _listoffiles dir -> files in
let nil -> lfiles in
(
while (files != nil) do
(
let hd files -> file in
let getFileExt file -> ext in
if (!all && (mask != nil) && !(isExtInListi mask ext)) then nil else
let getPathFile file "" -> [_ fname] in
set lfiles = lcat lfiles fname::nil;
set files = tl files;
);
lfiles;
);;
/*! @ingroup toolsfile
* \brief Get the files names list from a directory, with a file extension mask and case sensitive
*
* Prototype: fun [S [S r1]] [S r1]
*
* \param S : the path to list
* \param [S r1] : a list of string mask (ex : "pkg"::"bmp"::nil)
*
* \return [S r1] : a list of found files names
**/
fun getFilesNamesFromDir2(dir, mask)=
let !strcmp (hd mask) "*.*" -> all in
let _listoffiles2 dir -> files in
let nil -> lfiles in
(
while (files != nil) do
(
let hd files -> file in
let getFileExt file -> ext in
if (!all && (mask != nil) && !(isExtInListi mask ext)) then nil else
let getPathFile file "" -> [_ fname] in
set lfiles = lcat lfiles fname::nil;
set files = tl files;
);
lfiles;
);;
/*! @ingroup toolsfile
* \brief Replace spaces in a file name and removes special characters that are unsupported on some platforms
*
* Prototype: fun [S] S
*
* \param S : the path to sanitize
*
* \return [S r1] : path with sanitized file name
**/
fun sanitizeFileName(file)=
if (file == nil) then nil else
let getPathFile file "" -> [dir filename] in
let strdup filename -> cpname in
//do strlowercase on the copied string, this modify the original string otherwise
let strreplace (strlowercase cpname) " " "_" -> nname in
(
let "a"::"b"::"c"::"d"::"e"::"f"::"g"::"h"::"i"::"j"::"k"::"l"::"m"::"n"::"o"::"p"::"q"::"r"::"s"::"t"::"u"::"v"::"w"::"x"::"y"::"z"::"0"::"1"::"2"::"3"::"4"::"5"::"6"::"7"::"8"::"9"::"-"::"_"::"."::nil -> charset in
let 0 -> pos in
let strlen nname -> len in
let "" -> fname in
(
//while ((strlen nname) > 0) do
while (pos < len) do
(
//let substr nname 0 1 -> letter in
let substr nname pos 1 -> letter in
if (!isStringInList charset letter) then nil else
set fname = strcat fname letter;
//set nname = substr nname 1 strlen nname;
set pos = pos + 1;
);
strcat dir fname;
);
);;
/*! @ingroup toolsstr
* \brief Get the boolean value of a string
*
* Prototype: fun [S] I
*
* \param S : the boolean value "enable" "1" "on" "true" "yes"
*
* \return I : 1 if the boolean value is correct, 0 otherwise
**/
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;;
/*! @ingroup toolsstr
* \brief Compare the last word of a string
*
* Prototype: fun [S S] I
*
* \param S : the word to compare
* \param S : the full string
*
* \return I : 1 if the word is at the end of the string, 0 otherwise
**/
fun isLastWordfromString(word, string)= !strcmpi word (substr string ((strlen string) - (strlen word)) (strlen word));;
/*! @ingroup toolsstr
* \brief Compare the first word of a string
*
* Prototype: fun [S S] I
*
* \param S : the word to compare
* \param S : the full string
*
* \return I : 1 if the word is at the beginning of the string, 0 otherwise
**/
fun isFirstWordfromString(word, string)= !strcmpi word (substr string 0 (strlen word));;
/*! @ingroup toolsstr
* \brief Make the first letter uppercase
*
* Prototype: fun [S] S
*
* \param S : the text
*
* \return S : The text with first letter uppercase
**/
fun capitalizeFirstLetter(s)=
let struppercase (strdup s) -> up in
let substr up 0 1 -> majc in
strcat majc (substr s 1 (strlen s));;
/*! @ingroup toolslist
* \brief Transform a string list to lowercase
*
* Prototype: fun [[S r1]] [S r1]
*
* \param [S r1] : the string list
*
* \return [S r1] : the same string list with lowercase values
**/
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;
);;
/*! @ingroup toolsfile
* \brief List the directories of a path
*
* Prototype: fun [S] [S r1]
*
* \param S : the path directory
*
* \return [S r1] : a list of directories
**/
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
);;
/*! @ingroup toolsfile
* \brief List the files from a directory path recursively
*
* Prototype: fun [S] [S r1]
*
* \param S : the path directory
*
* \return [S r1] : a list of files
**/
fun getFilesFromDirRecursive(dir)=
if (isLastWordfromString ".svn" dir) then nil else
let _listoffiles dir -> lfiles in
let _listofsubdir dir -> lsubdirs in
(
while (lsubdirs != nil) do
(
let hd lsubdirs -> elem in
set lfiles = lcat lfiles (getFilesFromDirRecursive elem);
set lsubdirs = tl lsubdirs;
);
lfiles;
);;
/*! @ingroup toolsfile
* \brief Get the files list from a directory, with a file extension mask and filter recursively
*
* Prototype: fun [S [S r1] fun [S] I ] [S r1]
*
* \param S : the path to list
* \param [S r1] : a list of string mask (ex : "pkg"::"bmp"::nil)
*
* \return [S r1] : a list of found files
**/
fun getFilesFromDirFilterRecursive(dir, mask, cbfilter)=
let _listoffiles dir -> files in
let _listofsubdir dir -> lsubdirs in
let nil -> lfiles in
(
while (files != nil) do
(
let hd files -> file in
let getFileExt file -> ext in
if (((mask != nil) && !(isExtInListi mask ext)) || ((cbfilter != nil) && ((exec cbfilter with [file]) != 1))) then nil else
set lfiles = lcat lfiles file::nil;
set files = tl files;
);
while (lsubdirs != nil) do
(
let hd lsubdirs -> elem in
set lfiles = lcat lfiles (getFilesFromDirFilterRecursive elem mask cbfilter);
set lsubdirs = tl lsubdirs;
);
lfiles;
);;
/*! @ingroup toolsfile
* \brief List the files from a directory path recursively case sensitive
*
* Prototype: fun [S] [S r1]
*
* \param S : the path directory
*
* \return [S r1] : a list of files
**/
fun getFilesFromDirRecursive2(dir)=
if (isLastWordfromString ".svn" dir) then nil else
let _listoffiles2 dir -> lfiles in
let _listofsubdir2 dir -> lsubdirs in
(
while (lsubdirs != nil) do
(
let hd lsubdirs -> elem in
set lfiles = lcat lfiles (getFilesFromDirRecursive2 elem);
set lsubdirs = tl lsubdirs;
);
lfiles;
);;
/*! @ingroup toolsfile
* \brief Get the files list from a directory, with a file extension mask and case sensitive and filter recursively
*
* Prototype: fun [S [S r1] fun [S] I ] [S r1]
*
* \param S : the path to list
* \param [S r1] : a list of string mask (ex : "pkg"::"bmp"::nil)
*
* \return [S r1] : a list of found files
**/
fun getFilesFromDirFilterRecursive2(dir, mask, cbfilter)=
let _listoffiles2 dir -> files in
let _listofsubdir2 dir -> lsubdirs in
let nil -> lfiles in
(
while (files != nil) do
(
let hd files -> file in
let getFileExt file -> ext in
if (((mask != nil) && !(isExtInListi mask ext)) || ((cbfilter != nil) && ((exec cbfilter with [file]) != 1))) then nil else
set lfiles = lcat lfiles file::nil;
set files = tl files;
);
while (lsubdirs != nil) do
(
let hd lsubdirs -> elem in
set lfiles = lcat lfiles (getFilesFromDirFilterRecursive2 elem mask cbfilter);
set lsubdirs = tl lsubdirs;
);
lfiles;
);;
/*! @ingroup toolsfile
* \brief Delete all the files of a directory
*
* Prototype: fun [S] I
*
* \param S : the path directory
*
* \return 0
**/
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;
);
_deletepack _checkpack dir;
);
0;;
/*! @ingroup toolsfile
* \brief Remove the last '/' from a directory path
*
* Prototype: fun [S] I
*
* \param S : the directory path
*
* \return S : the directory path without the last slash
**/
fun getDirectoryWithoutLastSlash(dir)=
if isLastWordfromString "/" dir then
substr dir 0 ((strlen dir) - 1)
else
dir;;
/*! @ingroup toolsfile
* \brief Remove the first '/' from a directory path
*
* Prototype: fun [S] I
*
* \param S : the directory path
*
* \return S : the directory path without the first slash
**/
fun getDirectoryWithoutFirstSlash(dir)=
if isFirstWordfromString "/" dir then
substr dir 1 ((strlen dir) - 1)
else
dir;;
/*! @ingroup toolslist
* \brief apply a function to a list
*
* Prototype: fun [[u0 r1] fun [u0 u1] I u1] I
*
* \param [u0 r1] : the list
* \param fun [u0 u1] I : the function to call for each list element
* \param u1 : a user parameter
*
* \return I : 0
**/
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);;
/*! @ingroup toolslist
* \brief apply a function to a list reserved
*
* Prototype: fun [[u0 r1] fun [u0 u1] u0 u1] [u0 r1]
*
* \param [u0 r1] : the list
* \param fun [u0 u1] u0 : the function to call for each list element
* \param u1 : a user parameter
*
* \return [u0 r1] : the new list
**/
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);;
/*! @ingroup toolslist
* \brief Search an element in a list
*
* Prototype: fun [[u0 r1] fun [u0 u1] I u1] u0
*
* \param [u0 r1] : the list
* \param fun [u0 u1] I : the function to call for each list element to compare
* \param u1 : a user parameter
*
* \return u0 : the element found or nil
**/
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;;
/*! @ingroup toolslist
* \brief Remove an element in a list
*
* Prototype: fun [[u0 r1] u0] [u0 r1]
*
* \param [u0 r1] : the list
* \param u0 : the list element to remove
*
* \return [u0 r1] : the list without the element
**/
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 remove_nth_from_list (list, n)=
if n < 0
then
list
else
let list -> [first next] in
if n==0
then
next
else
first::remove_nth_from_list next n-1;;
fun replace_in_list(list, old, new)=
if list==nil
then
nil
else
let list -> [first next] in
if first==old
then
new::next
else
first::replace_in_list next old new;;
fun replace_nth_in_list(list, n, new)=
if list==nil
then
nil
else
let list -> [first next] in
if n==0
then
new::next
else
first::replace_nth_in_list next n-1 new;;
fun add_nth_in_list (list, n, x)=
if n < 0
then
lcat list x::nil
else
let list -> [first next] in
if n==0
then
x::list
else
first::add_nth_in_list next n-1 x;;
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;
);;
/*! @ingroup toolslist
* \brief Remove an string in a list
*
* Prototype: fun [[S r1] S] [S r1]
*
* \param [S r1] : the list
* \param S : the list element to remove
*
* \return [S r1] : the list without the element
**/
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;;
/*! @ingroup toolslist
* \brief Remove an indexed element in a list
*
* Prototype: fun [[[u0 u1] r1] u0] [[u0 u1] r1]
*
* \param [[u0 u1] r1] : the list
* \param u0 : the index to remove
*
* \return [[u0 u1] r1] : the list without the element
**/
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;;
/*! @ingroup toolslist
* \brief Remove a string indexed element in a list
*
* Prototype: fun [[[S u0] r1] S] [[S u0] r1]
*
* \param [[S u0] r1] : the list
* \param S : the index to remove
*
* \return [[S u0] r1] : the list without the element
**/
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;;
/*! @ingroup toolslist
* \brief Remove a string indexed element in a list case incensivity
*
* Prototype: fun [[[S u0] r1] S] [[S u0] r1]
*
* \param [[S u0] r1] : the list
* \param S : the index to remove
*
* \return [[S u0] r1] : the list without the element
**/
fun remove_sid_from_listi(l, sid)=
if l==nil
then
nil
else
let hd l -> [id _] in
if (!strcmpi id sid) then
tl l
else
(hd l)::remove_sid_from_listi 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_all_first_string_from_second_elem_list(l, elt)=
if l==nil
then
nil
else
let hd l -> [_ nl] in
let hd nl -> elm in
if !strcmpi elm elt then
remove_all_first_string_from_second_elem_list tl l elt
else
(hd l)::remove_all_first_string_from_second_elem_list tl l elt;;
fun remove_first_and_second_string_from_second_elem_list(l, elt1, elt2)=
if l==nil
then
nil
else
let hd l -> [_ nl] in
let hd nl -> elm1 in
let hd tl nl -> elm2 in
if (!strcmpi elm1 elt1) && (!strcmpi elm2 elt2) then
tl l
else
(hd l)::remove_first_and_second_string_from_second_elem_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 remove_first_string_from_second_element_list_start_with(l, elt)=
if l==nil
then
nil
else
let hd l -> [_ nl] in
let hd nl -> 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_sid_in_list(l,p,n)=
if l==nil then nil
else let l -> [[a _] nxt] in
if (!strcmp a p) then n
else pos_sid_in_list nxt p n+1;;
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;
);;
/*! @ingroup toolslist
* \brief Rename a string indexed element in a list
*
* Prototype: fun [[[S u0] r1] S S] [[S u0] r1]
*
* \param [[S u0] r1] : the list
* \param S : the index to rename
* \param S : the new index name
*
* \return [[S u0] r1] : the list updated
**/
fun rename_sid_from_list(l, sid, nid)=
let switchstr l sid -> selt in
let switchstr l nid -> nelt in
if (l == nil || (selt == nil) || (nelt != nil))
then
l
else
let pos_sid_in_list l sid 0 -> pos in
add_nth_in_list (remove_nth_from_list l pos) pos [nid selt];;
/*! @ingroup toolsstr
* \brief Replace a string in an another string
*
* Prototype: fun [S S S] S
*
* \param S : the string to change
* \param I : char to find
* \param S : the string to replace with
*
* \return S : the new string
**/
fun strreplaceChar(s, from, to)=
let strlen s -> size in
let 0 -> pos in
while (pos < size) do
(
if (nth_char s pos) != from then
set pos = pos + 1
else
(
set s = strcatn (substr s 0 pos)::to::(substr s (pos + 1) (strlen s))::nil;
set size = strlen s;
set pos = pos + 1 + strlen to;
);
);
s;;
/*! @ingroup toolsstr
* \brief Replace a string in an another string
*
* Prototype: fun [S S S] S
*
* \param S : the string to change
* \param S : the string to find
* \param S : the string to replace with
*
* \return S : the new string
**/
fun strreplace(s, from, to)=
let 0 -> pos in
let strlen from -> fsize in
let strlen to -> tsize in
let if (tsize == 0) then -1 else tsize -> tsize in
if (fsize <= 0) then s 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;
);;
/*! @ingroup toolsstr
* \brief Replace a string in an another string, case insensivity
*
* Prototype: fun [S S S] S
*
* \param S : the string to change
* \param S : the string to find
* \param S : the string to replace with
*
* \return S : the new string
**/
fun strreplacei(s, from, to)=
let 0 -> pos in
let strlen from -> fsize in
let strlen to -> tsize in
let if (tsize == 0) then -1 else tsize -> tsize in
if (fsize <= 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;
set pos = pos + tsize;
);
s;
);;
/*! @ingroup toolsstr
* \brief convert a string to a list of words
*
* Prototype: fun [S] [S r1]
*
* \param S : string
*
* \return [S r1] : the list of words
**/
fun strToWordList(s)=
let strextr s -> l in
let nil -> nl in
(
while (l != nil) do
(
let hd l -> lw in
while (lw != nil) do
(
set nl = (hd lw)::nl;
set lw = tl lw;
);
set l = tl l;
);
revertlist nl;
);;
/*! @ingroup toolsstr
* \brief replace key by value position in arg list ("my string is $1 with $2" "val1"::"val2"::nil)
*
* Prototype: fun [S S [S r1]] S
*
* \param S : string
* \param S : the key "$" for example
* \param [S r1] : list of arguments
*
* \return S : the converted string
**/
fun replaceByKeyIndex(s, key, args)=
let sizelist args -> size in
(
while (size > 0) do
(
set s = strreplace s (strcat key (itoa size)) (nth_list args (size - 1));
set size = size - 1;
);
s;
);;
/*! @ingroup toolsstr
* \brief replace key by value position in arg list ("my string is $1 with $2" "val1 val2")
*
* Prototype: fun [S S S] S
*
* \param S : string
* \param S : the key "$" for example
* \param S : arguments
*
* \return S : the converted string
**/
fun replaceByKeyIndex2(s, key, args)=
let strToWordList args -> lp in
let sizelist lp -> size in
(
while (size >= 0) do
(
if (size == 0) then
set s = strreplace s (strcat key (itoa size)) args
else
set s = strreplace s (strcat key (itoa size)) (nth_list lp (size - 1));
set size = size - 1;
);
s;
);;
/*! @ingroup toolsstr
* \brief Concat a string list with a defined separator
*
* Prototype: fun [[S r1] S] S
*
* \param [S r1] : the string list
* \param S : the separator to use
*
* \return S : the new string
**/
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;
);;
/*! @ingroup toolsstr
* \brief Concat a string list with a defined separator and limits
*
* Prototype: fun [[S r1] S I] S
*
* \param [S r1] : the string list
* \param S : the separator to use
*
* \return S : the new string
**/
fun strcatnSepLimits(l, sep, nb)=
let sizelist l -> size in
let nil -> ndata in
let 0 -> i in
(
while ((i < size) && (i < nb)) 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;
);;
/*! @ingroup toolsstr
* \brief Concat a string list with a defined separator and a line feed
*
* Prototype: fun [[[S r1] r1] S] S
*
* \param [[S r1] r1] : the string list
* \param S : the separator to use
*
* \return S : the new string
**/
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 strfindiLast(char, s)=
let 0 -> last in
let -1 -> cpos in
let while (set cpos = (strfindi char s cpos + 1)) != nil do set last = cpos -> pos in
pos;;
fun strfindLast(char, s)=
let 0 -> last in
let -1 -> cpos in
let while (set cpos = (strfind char s cpos + 1)) != nil do set last = cpos -> pos in
pos;;
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;
);;
/*! @ingroup toolsstr
* \brief Convert a float value to a short string
*
* Prototype: fun [F] S
*
* \param F : float value
*
* \return S : short string
**/
fun getFloatToString(float)= if (absf float) >. (itof (ftoi absf float)) then (ftoa float) else strcat (itoa (ftoi float)) ".0";;
/*! @ingroup toolsstr
* \brief Convert a float value to a short string
*
* Prototype: fun [F] S
*
* \param F : float value
*
* \return S : short string without demical if possible
**/
fun getShortFloatToString(float)= if (absf float) >. (itof (ftoi absf float)) then (ftoa float) else (itoa (ftoi float));;
/*! @ingroup toolsstr
* \brief Protect special character with a '\'
*
* Prototype: fun [S] S
*
* \param S : the string to protect
*
* \return S : the new string
**/
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) || (char == 96) then
set ret = strcatn ret::(ctoa 92)::(ctoa char)::nil
else
set ret = strcat ret (ctoa char);
set i = i + 1;
);
ret;
);;
/*! @ingroup toolsstr
* \brief Protect special \n \t \r with a '\'
*
* Prototype: fun [S] S
*
* \param S : the string to protect
*
* \return S : the new string
**/
fun protectFormat(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 == 13) || (char == 9) || (char == 10) || (char == 11) then
set ret = strcatn ret::"\\n"::nil
else
set ret = strcat ret (ctoa char);
set i = i + 1;
);
ret;
);;
/*! @ingroup toolsstr
* \brief Protect special \n \t \r and double quote with a '\'
*
* Prototype: fun [S] S
*
* \param S : the string to protect
*
* \return S : the new string
**/
fun protectParam(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 == 13) || (char == 9) || (char == 10) || (char == 11) || (char == 34) then
set ret = strcatn ret::"\\n"::nil
else
set ret = strcat ret (ctoa char);
set i = i + 1;
);
ret;
);;
/*! @ingroup toolsstr
* \brief Remove special character protection '\'
*
* Prototype: fun [S] S
*
* \param S : the string
*
* \return S : the new string
**/
fun stripSlashes(s)=
if ((s == nil) || (!strcmp s "")) then s else
(
let strlen s -> size in
let 0 -> pos in
while (pos < size) do
(
if ((((nth_char s pos) == 92) && ((nth_char s pos + 1) == 92)) || ((nth_char s pos) != 92)) then
set pos = pos + 1
else
(
set s = strcat (substr s 0 pos) (substr s (pos + 1) (strlen s));
set size = strlen s;
set pos = pos + 1;
);
);
s;
);;
/*! @ingroup toolsstr
* \brief Protect char character with a char
*
* Prototype: fun [S I I] S
*
* \param S : the string to protect
* \param I : char to protect
* \param I : char to add
*
* \return S : the new string
**/
fun addChar(s, p, c)=
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 == p) then
set ret = strcatn ret::(ctoa c)::(ctoa char)::nil
else
set ret = strcat ret (ctoa char);
set i = i + 1;
);
ret;
);;
/*! @ingroup toolsstr
* \brief Remove special character protection '\'
*
* Prototype: fun [S I] S
*
* \param S : the string
* \param I : char to remove
*
* \return S : the new string
**/
fun stripChar(s, c)=
if ((s == nil) || (!strcmp s "")) then s else
(
let strlen s -> size in
let 0 -> pos in
while (pos < size) do
(
if ((nth_char s pos) != c) then
set pos = pos + 1
else
(
set s = strcat (substr s 0 pos) (substr s (pos + 1) (strlen s));
set size = strlen s;
set pos = pos + 1;
);
);
s;
);;
/*! @ingroup toolsstr
* \brief Truncate a string
*
* Prototype: fun [S I S] S
*
* \param S : the string
* \param I : the maximun string length
* \param S : the string to add to the end (...)
*
* \return S : the new string
**/
fun strTruncate(s, maxlen, rp)=
if (strlen s) > maxlen then
strcat substr s 0 (maxlen - (strlen rp)) rp
else
s;;
/*! @ingroup toolsstr
* \brief Protect quotes in a "string"
*
* Prototype: fun [S] S
*
* \param S : the string
*
* \return S : the new string
**/
fun protectQuotes(s)=
addChar s 34 92;;
/*! @ingroup toolsstr
* \brief Remove quotes from a "string"
*
* Prototype: fun [S] S
*
* \param S : the string
*
* \return S : the new string
**/
fun removeQuotes(s)=
if (nth_char s 0) != 34 then nil else
(
set s = substr s 1 (strlen s) - 1;
if (nth_char s (strlen s) - 1) != 34 then nil else
set s = substr s 0 (strlen s) - 1;
);
s;;
/*! @ingroup toolsstr
* \brief Quote a string
*
* Prototype: fun [S S] S
*
* \param S : the string
* \param S : the character to use for quotes '"'
*
* \return S : the new string
**/
fun strQuote(s, q)= strcatn q::(strtrim s)::q::nil;;
/*! @ingroup toolsstr
* \brief Quote a string list
*
* Prototype: fun [[S r1] S] [S r1]
*
* \param [S r1] : the string list
* \param S : the character to use for quotes '"'
*
* \return [S r1] : the new string list
**/
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;
);;
/*! @ingroup toolsstr
* \brief Remove spaces and first / last character of a string
*
* Prototype: fun [S S S] S
*
* \param S : the string
* \param S : the first character to remove
* \param S : the last character to remove
*
* \return S : the new string
**/
fun strtrimChar(str, first, last)=
let strtrim str -> str in
let if (first == nil) then str else if (!strcmp (substr str 0 1) first) then substr str 1 (strlen str) -1 else str -> str in
let if (last == nil) then str else if (!strcmp (substr str (strlen str) -1 1) last) then substr str 0 (strlen str) -1 else str -> str in
str;;
/*! @ingroup toolsstr
* \brief Convert a String to a list of lines
*
* Prototype: fun [S] [S r1]
*
* \param S : the string
*
* \return [S r1] : the list of string lines
**/
fun strToList(s)=
let nil -> ret in
let strextr s -> l in
(
while (l != nil) do
(
let hd l -> line in
set ret = (strcatnSep line " ")::ret;
set l = tl l;
);
revertlist ret;
);;
fun removeNthChar(s, p)=
if ((s == nil) || (!strcmp s "") || (p == nil)) then s else
(
let strlen s -> size in
let 0 -> pos in
while (pos < size) do
(
if (pos == p) then
set pos = pos + 1
else
(
set s = strcat (substr s 0 pos) (substr s (pos + 1) (strlen s));
set size = strlen s;
set pos = pos + 1;
);
);
s;
);;
fun contcatQuotedList(l, c)=
if (l == nil) then nil else
let l -> [line next] in
(
let nil -> lp in
(
while (((mod (sizelist (set lp = (strfind2List line (ctoa c) 0))) 2) != 0) && (next != nil)) do
(
set line = strcatn line::"\n"::(hd next)::nil;
set next = tl next;
);
);
line::(contcatQuotedList next c);
);;
/*! @ingroup toolsstr
* \brief Convert a String to a list of lines but protect line with char
*
* Prototype: fun [S I] [S r1]
*
* \param S : the string
* \param I : char condition
*
* \return [S r1] : the list of string lines
**/
fun strToQuotedList(s, c)=
let nil -> ret in
let strextr s -> l in
(
while (l != nil) do
(
let hd l -> line in
set ret = (strcatnSep line " ")::ret;
set l = tl l;
);
contcatQuotedList revertlist ret c;
);;
/*! @ingroup toolsstr
* \brief Change the line separation character
*
* Prototype: fun [S S] S
*
* \param S : the string
* \param S : the line separation character
*
* \return S : the new string
**/
fun oneLineTransform(s, sep)=
strcatnSep (strToList s) sep;;
/*! @ingroup toolsstr
* \brief Convert a string to a list by a defined separator
*
* Prototype: fun [S S] [S r1]
*
* \param S : the string
* \param S : separator ';'
*
* \return [S r1] : the string list
**/
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 = value::ret;
set spos = fpos + strlen sep;
);
);
if (spos >= strlen s) then nil else
set ret = (substr s spos ((strlen s) - spos))::ret;
revertlist ret;
);;
/*! @ingroup toolsstr
* \brief Convert a string to a list by a defined open / close separators
*
* Prototype: fun [S S S] [S r1]
*
* \param S : the string
* \param S : open separator '['
* \param S : close separator ']'
*
* \return [S r1] : the string list
**/
fun strToListOpenCloseSep(s, osep, csep)=
let nil -> ret in
let 0 -> spos in
(
while (strfindi osep s spos) != nil do
(
let strfindi osep s spos -> fpos in
let strfindi csep s fpos + (strlen osep) -> epos in
let substr s (fpos + (strlen osep)) (epos - (fpos + (strlen osep))) -> value in
(
set ret = value::ret;
set spos = epos + strlen csep;
);
);
revertlist ret;
);;
/*! @ingroup toolsstr
* \brief Convert a string to a list by a defined separator
*
* Prototype: fun [S S fun [S] S] [S r1]
*
* \param S : the string
* \param S : separator ';'
* \param fun [S] S : callback to modify the value
*
* \return [S r1] : the string list
**/
fun strToListSepCb(s, sep, cb)=
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 = (exec cb with [value])::ret;
set spos = fpos + strlen sep;
);
);
if (spos >= strlen s) then nil else
set ret = (substr s spos ((strlen s) - spos))::ret;
revertlist ret;
);;
/*! @ingroup toolsstr
* \brief Convert list of words and lines to a string
*
* Prototype: fun [[[S r1] r1]] S
*
* \param [[S r1] r1] : list of words and lines
*
* \return S : the formated string
**/
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";
);;
/*! @ingroup toolsstr
* \brief Convert list of lines to a string
*
* Prototype: fun [[S r1]] S
*
* \param [S r1] : list of lines
*
* \return S : the formated string
**/
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
let sizelist lp -> s2 in
let 0 -> s in
while (s < s2) do
(
set ret = lcat ret (strcatnSep (nth_list lp s) " ")::nil;
set s = s + 1;
);
set i = i + 1;
);
if ret == nil then nil else strcatnSep ret "\n";
);;
/*! @ingroup toolsstr
* \brief Check is a string is a number or a float
*
* Prototype: fun [S] I
*
* \param S : string
*
* \return I : return 1 if the string is a number else 0
**/
fun isNumber(s)=
let if ((s == nil) || ((strlen s) == 0)) then 0 else 1 -> ret in
(
let strlen s -> size in
let 0 -> i in
while (i < size && ret) do
(
let nth_char s i -> char in
if (((char >= 48) && (char <= 57)) || (char == 46) || ((char == 45) && (i == 0))) then nil else
set ret = 0;
set i = i + 1;
);
ret;
);;
/*! @ingroup toolsstr
* \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;
);;
/*! @ingroup toolsstr
* \brief transform a float into a clean readable string
*
* Prototype: fun [F] S
*
* \param F : float value
*
* \return S : the value cleaned float string
**/
fun floatToString(float)=
let if (absf float) >. (itof (ftoi absf float)) then (ftoa float) else itoa (ftoi float) -> s in
let strfind "." s 0 -> dotpos in
if (dotpos == nil) then
s
else
(
while ((strfind "0" s ((strlen s) -1)) != nil) do
set s = substr s 0 ((strlen s) -1);
s;
);;
/*! @ingroup toolsstr
* \brief invert switchstr parameter
*
* Prototype: fun [[u0 S] S] u0
*
* \param [u0 S] : list
* \param S : value to get
*
* \return u0 : corresponding value
**/
fun switchstrInv(l, s)=
if (l == nil) || (s == nil) then nil else
let hd l -> [v t] in
if (!strcmp t s) then
v
else
switchstrInv tl l s;;
/*! @ingroup toolsstr
* \brief invert switchstri parameter
*
* Prototype: fun [[u0 S] S] u0
*
* \param [u0 S] : list
* \param S : value to get
*
* \return u0 : corresponding value
**/
fun switchstriInv(l, s)=
if (l == nil) || (s == nil) then nil else
let hd l -> [v t] in
if (!strcmpi t s) then
v
else
switchstriInv tl l s;;
/*! @ingroup toolsstr
* \brief invert switch parameter
*
* Prototype: fun [[u0 I] I] u0
*
* \param [u0 I] : list
* \param I : value to get
*
* \return u0 : corresponding value
**/
fun switchInv(l, s)=
if (l == nil) || (s == nil) then nil else
let hd l -> [v t] in
if (t == s) then
v
else
switchInv tl l s;;
/* ********************************************************************************************* /
HTTP DOWNLOAD
/ ********************************************************************************************* */
typeof lHTTP_COOKIES = [[S S] r1];;
typeof lHTTP_REQUEST = [ObjCURL r1];;
var iCURL_REQUEST_TIMEOUT = 5;;
fun strIsUrl(url)= if (strfind "://" url 0) != nil then 1 else 0;;
fun urlDecode(s)=
strreplace webtostr s "\\u0026" "&";;
fun makeSimpleJson(lp)=
let "{" -> s in
(
while (lp != nil) do
(
let hd lp -> [key val] in
set s = strcatn s::"'"::key::"':"::val::nil;
set lp = tl lp;
if (lp == nil) then nil else
set s = strcat s ", ";
);
strcat s "}";
);;
fun makeSimpleJsonEx(lp, dbquote)=
let if dbquote then "\"" else "'" -> quote in
let "{" -> s in
(
while (lp != nil) do
(
let hd lp -> [key val] in
set s = strcatn s::quote::key::quote::": "::val::nil;
set lp = tl lp;
if (lp == nil) then nil else
set s = strcat s ",\n";
);
strcat s "}\n";
);;
struct JsonTData = [
JSOND_pParent : JsonTData,
JSOND_sKey : S,
JSOND_sValue : S,
JSOND_lSons : [JsonTData r1],
JSOND_bArray : I
]mkJsonTData;;
fun makeJsonData(parent, key, value)=
let mkJsonTData [parent key value nil 0] -> ndata in
(
if (parent == nil) then nil else
set parent.JSOND_lSons = lcat parent.JSOND_lSons ndata::nil;
ndata;
);;
fun makeJsonArray(parent, key, lvalues)=
let mkJsonTData [parent key nil lvalues 1] -> ndata in
(
if (parent == nil) then nil else
set parent.JSOND_lSons = lcat parent.JSOND_lSons ndata::nil;
ndata;
);;
fun makeJsonSons(lp, dbquote, s)=
if (lp == nil) then s else
let if dbquote then "\"" else "'" -> quote in
let hd lp -> pjdata in
(
if (pjdata.JSOND_sKey == nil) then
set s = strcat s "{\n"
else
set s = strcatn s::quote::pjdata.JSOND_sKey::quote::": "::nil;
if (pjdata.JSOND_sValue == nil) then nil else
set s = strcatn s::quote::pjdata.JSOND_sValue::quote::nil;
if (!pjdata.JSOND_bArray) then nil else
set s = strcat s "[\n";
set s = makeJsonSons pjdata.JSOND_lSons dbquote s;
if ((((tl lp) == nil) || pjdata.JSOND_pParent.JSOND_bArray) || pjdata.JSOND_bArray) then nil else
set s = strcat s ",";
if (!pjdata.JSOND_bArray) then nil else
set s = strcat s "]";
if (pjdata.JSOND_sKey != nil) then nil else
(
set s = strcat s "}";
if ((tl lp) == nil) then nil else
set s = strcat s ",";
);
set s = strcat s "\n";
set s = makeJsonSons tl lp dbquote s;
);;
fun makeJson(pjdata, dbquote)=
let if dbquote then "\"" else "'" -> quote in
let "{\n" -> s in
(
if (pjdata.JSOND_sKey == nil) then nil else
set s = strcatn s::quote::pjdata.JSOND_sKey::quote::": "::nil;
if (pjdata.JSOND_sValue == nil) then nil else
set s = strcatn s::pjdata.JSOND_sValue::"\n"::nil;
set s = makeJsonSons pjdata.JSOND_lSons dbquote s;
strcat s "}\n";
);;
fun cbCheckInternetConnection(inet, p, data, code)=
let p -> [url cbfun param] in
if (code == 0) then
(
0;
)
else if (code == 1) then
(
exec cbfun with [url param 1];
0;
)
else
(
exec cbfun with [url param 0];
0;
);
0;;
/*! @ingroup toolsdl
* \brief Test the Internet connection availability (multiplatform)
*
* Prototype: fun [S fun [S u0 I] I u0] I
*
* \return 0
**/
fun checkInternetConnection(url, cbfun, param)=
let if (url == nil) || !(strIsUrl url) then "http://www.google.com" else url -> url in
INETGetURL _channel url 0 @cbCheckInternetConnection [url cbfun param];
0;;
/*! @ingroup toolsdl
* \brief Kill all current download requests
*
* Prototype: fun [] I
*
* \return 0
**/
fun clearHttpRequest()=
let lHTTP_REQUEST -> l in
while (l != nil) do
(
_KILLcurlRequest hd l;
set l = tl l;
);
set lHTTP_REQUEST = nil;
0;;
/*! @ingroup toolsdl
* \brief Kill a download request
*
* Prototype: fun [ObjCURL] I
*
* \param ObjCURL : the request to kill
*
* \return 0
**/
fun killHttpRequest(req)=
if (req == nil) then nil else
(
set lHTTP_REQUEST = remove_from_list lHTTP_REQUEST req;
_KILLcurlRequest req;
);
0;;
/*! @ingroup toolsdl
* \brief Clear all http cookies
*
* Prototype: fun [] I
*
* \return 0
**/
fun clearHttpCookies()=
set lHTTP_COOKIES = nil;
0;;
/*! @ingroup toolsdl
* \brief Get the domain of an url
*
* Prototype: fun [S] S
*
* \param S : the url
*
* \return S : the url domain
**/
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);;
/*! @ingroup toolsdl
* \brief Get Html header from an http response
*
* Prototype: fun [S] S
*
* \param S : the response
*
* \return S : the header
**/
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;
);;
/*! @ingroup toolsdl
* \brief Get Html Status code from header
*
* Prototype: fun [S] I
*
* \param S : the header
*
* \return I : the html status code
**/
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 makeHtmlCookieHeader(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 makeHtmlCookie(url)=
let getHttpDomain url -> baseurl in
let switchstri lHTTP_COOKIES baseurl -> cookie in
cookie;;
fun getHtmlCookie(url)=
let getHttpDomain url -> baseurl in
switchstri lHTTP_COOKIES baseurl;;
fun cbDownloadFile(curlobj, p, data, code)=
let p -> [str url cbfun] in
if (code == -1) then
(
mutate p <- [(strcat str data) _ _];
0;
)
// download finished
else if (code == 0) then
(
set lHTTP_REQUEST = remove_from_list lHTTP_REQUEST curlobj;
exec cbfun with [url str];
)
else
(
_fooS strcatn ">>>>>>>>> Http download failed : "::url::" with code : "::(itoa code)::nil;
set lHTTP_REQUEST = remove_from_list lHTTP_REQUEST curlobj;
exec cbfun with [url nil];
0;
);
0;;
/*! @ingroup toolsdl
* \brief Download an url
*
* Prototype: fun [S fun [S S] u0] I
*
* \param S : the url to download
* \param fun [S S] u0 : the callback with url and data
*
* \return ObjCURL : the new request
**/
fun downloadFile(file, cbfun)=
if strIsUrl file then
let makeHtmlCookie file -> cookie in
let _CRcurlRequest _channel file -> objcurl in
(
_SETcurlOption objcurl CURLOPT_SSL_VERIFYPEER 0;
_SETcurlOption objcurl CURLOPT_FOLLOWLOCATION 1;
_SETcurlOption objcurl CURLOPT_CONNECTTIMEOUT iCURL_REQUEST_TIMEOUT;
if (cookie == nil) then nil else
_SETcurlOptionS objcurl CURLOPT_COOKIE cookie;
set lHTTP_REQUEST = (_CALLcurlRequest objcurl @cbDownloadFile ["" file cbfun])::lHTTP_REQUEST;
hd lHTTP_REQUEST;
)
else
(
exec cbfun with [file nil];
nil;
);;
/*! @ingroup toolsdl
* \brief Download an url
*
* Prototype: fun [S fun [S S] u0] I
*
* \param S : the url to download
* \param fun [S S] u0 : the callback with url and data
*
* \return ObjCURL : the new request
**/
fun downloadFilePost(file, params, headeradd, cbfun)=
if strIsUrl file then
let makeHtmlCookie file -> cookie in
let _CRcurlRequest _channel file -> objcurl in
(
_SETcurlOption objcurl CURLOPT_SSL_VERIFYPEER 0;
_SETcurlOption objcurl CURLOPT_FOLLOWLOCATION 1;
_SETcurlOption objcurl CURLOPT_CONNECTTIMEOUT iCURL_REQUEST_TIMEOUT;
if (headeradd == nil) then nil else
_SETcurlOptionList objcurl CURLOPT_HTTPHEADER headeradd;
if (cookie == nil) then nil else
_SETcurlOptionS objcurl CURLOPT_COOKIE cookie;
if (params == nil || (!strcmp (strtrim params) "")) then nil else
(
_SETcurlOption objcurl CURLOPT_POST 1;
_SETcurlOptionS objcurl CURLOPT_POSTFIELDS params;
);
set lHTTP_REQUEST = (_CALLcurlRequest objcurl @cbDownloadFile ["" file cbfun])::lHTTP_REQUEST;
hd lHTTP_REQUEST;
)
else
(
exec cbfun with [file nil];
nil;
);;
fun cbDownloadFileW(curlobj, p, data, code)=
let p -> [url wfile cbfun] in
if (code == -1) then
(
_appendpack data wfile;
0;
)
// download finished
else if (code == 0) then
(
set lHTTP_REQUEST = remove_from_list lHTTP_REQUEST curlobj;
exec cbfun with [url wfile];
)
else
(
_fooS strcatn ">>>>>>>>> Http download failed : "::url::" with code : "::(itoa code)::nil;
set lHTTP_REQUEST = remove_from_list lHTTP_REQUEST curlobj;
exec cbfun with [url wfile];
0;
);
0;;
/*! @ingroup toolsdl
* \brief Download an url in a file
*
* Prototype: fun [S fun [S S] u0] I
*
* \param S : the url to download
* \param w : the file to write
* \param fun [S W] u0 : the callback with url and data
*
* \return ObjCURL : the new request
**/
fun downloadFileW(file, wfile, cbfun)=
if strIsUrl file then
let makeHtmlCookie file -> cookie in
let _CRcurlRequest _channel file -> objcurl in
(
_SETcurlOption objcurl CURLOPT_SSL_VERIFYPEER 0;
_SETcurlOption objcurl CURLOPT_FOLLOWLOCATION 1;
_SETcurlOption objcurl CURLOPT_CONNECTTIMEOUT iCURL_REQUEST_TIMEOUT;
if (cookie == nil) then nil else
_SETcurlOptionS objcurl CURLOPT_COOKIE cookie;
set lHTTP_REQUEST = (_CALLcurlRequest objcurl @cbDownloadFileW [file wfile cbfun])::lHTTP_REQUEST;
hd lHTTP_REQUEST;
)
else
(
exec cbfun with [file nil];
nil;
);;
proto cbGetContentLength = fun [ObjCURL [S S fun [S I] I] S I] I;;
fun cbGetContentLength(curlobj, p, data, code)=
let p -> [str url cbfun] in
if (code == -1) then
(
mutate p <- [(strcat str data) _ _];
0;
)
// download finished
else if (code == 0) then
(
set lHTTP_REQUEST = remove_from_list lHTTP_REQUEST curlobj;
let getHtmlHeader str -> [header cont] in
let getNextToValue header "Location:" -> location in
(
if (location != nil) then
(
let makeHtmlCookie location -> cookie in
let _CRcurlRequest _channel location -> objcurl in
(
_SETcurlOption objcurl CURLOPT_SSL_VERIFYPEER 0;
_SETcurlOption objcurl CURLOPT_HEADER 1;
_SETcurlOption objcurl CURLOPT_NOBODY 1;
_SETcurlOption objcurl CURLOPT_CONNECTTIMEOUT iCURL_REQUEST_TIMEOUT;
if (cookie == nil) then nil else
_SETcurlOptionS objcurl CURLOPT_COOKIE cookie;
set lHTTP_REQUEST = (_CALLcurlRequest objcurl @cbGetContentLength ["" location cbfun])::lHTTP_REQUEST;
);
0;
)
else
(
let atoi getNextToValue header "Content-Length:" -> length in
exec cbfun with [url length];
0;
);
);
)
else
(
_fooS strcatn ">>>>>>>>> Http get content size failed : "::url::" with code : "::(itoa code)::nil;
set lHTTP_REQUEST = remove_from_list lHTTP_REQUEST curlobj;
exec cbfun with [url nil];
0;
);
0;;
/*! @ingroup toolsdl
* \brief Get content size of an url
*
* Prototype: fun [S fun [S I] u0] I
*
* \param S : the url to download
* \param fun [S I] u0 : the callback with url and content length
*
* \return ObjCURL : the new request
**/
fun getUrlContentLenght(file, cbfun)=
if strIsUrl file then
let makeHtmlCookie file -> cookie in
let _CRcurlRequest _channel file -> objcurl in
(
_SETcurlOption objcurl CURLOPT_SSL_VERIFYPEER 0;
_SETcurlOption objcurl CURLOPT_HEADER 1;
_SETcurlOption objcurl CURLOPT_NOBODY 1;
_SETcurlOption objcurl CURLOPT_CONNECTTIMEOUT iCURL_REQUEST_TIMEOUT;
if (cookie == nil) then nil else
_SETcurlOptionS objcurl CURLOPT_COOKIE cookie;
set lHTTP_REQUEST = (_CALLcurlRequest objcurl @cbGetContentLength ["" file cbfun])::lHTTP_REQUEST;
hd lHTTP_REQUEST;
)
else
(
exec cbfun with [file nil];
nil;
);;
proto cbGetContentDate = fun [ObjCURL [S S fun [S S] I] S I] I;;
fun cbGetContentDate(curlobj, p, data, code)=
let p -> [str url cbfun] in
if (code == -1) then
(
mutate p <- [(strcat str data) _ _];
0;
)
// download finished
else if (code == 0) then
(
set lHTTP_REQUEST = remove_from_list lHTTP_REQUEST curlobj;
let getHtmlHeader str -> [header cont] in
let getNextToValue header "Location:" -> location in
(
if (location != nil) then
(
let makeHtmlCookie location -> cookie in
let _CRcurlRequest _channel location -> objcurl in
(
_SETcurlOption objcurl CURLOPT_SSL_VERIFYPEER 0;
_SETcurlOption objcurl CURLOPT_HEADER 1;
_SETcurlOption objcurl CURLOPT_NOBODY 1;
_SETcurlOption objcurl CURLOPT_CONNECTTIMEOUT iCURL_REQUEST_TIMEOUT;
if (cookie == nil) then nil else
_SETcurlOptionS objcurl CURLOPT_COOKIE cookie;
set lHTTP_REQUEST = (_CALLcurlRequest objcurl @cbGetContentDate ["" location cbfun])::lHTTP_REQUEST;
);
0;
)
else
(
let getNextToValue header "Last-Modified:" -> date in
let getNextToValue header "ETag:" -> tag in
exec cbfun with [url (if (tag == nil) then date else tag)];
0;
);
);
)
else
(
_fooS strcatn ">>>>>>>>> Http get content date failed : "::url::" with code : "::(itoa code)::nil;
set lHTTP_REQUEST = remove_from_list lHTTP_REQUEST curlobj;
exec cbfun with [url nil];
0;
);
0;;
/*! @ingroup toolsdl
* \brief Get content date of an url
*
* Prototype: fun [S fun [S S] u0] I
*
* \param S : the url to download
* \param fun [S S] u0 : the callback with url and content date or tag
*
* \return ObjCURL : the new request
**/
fun getUrlContentDate(file, cbfun)=
if strIsUrl file then
let makeHtmlCookie file -> cookie in
let _CRcurlRequest _channel file -> objcurl in
(
_SETcurlOption objcurl CURLOPT_SSL_VERIFYPEER 0;
_SETcurlOption objcurl CURLOPT_HEADER 1;
_SETcurlOption objcurl CURLOPT_NOBODY 1;
_SETcurlOption objcurl CURLOPT_CONNECTTIMEOUT iCURL_REQUEST_TIMEOUT;
if (cookie == nil) then nil else
_SETcurlOptionS objcurl CURLOPT_COOKIE cookie;
set lHTTP_REQUEST = (_CALLcurlRequest objcurl @cbGetContentDate ["" file cbfun])::lHTTP_REQUEST;
hd lHTTP_REQUEST;
)
else
(
exec cbfun with [file nil];
nil;
);;
proto cbGetContentInfos = fun [ObjCURL [S S fun [S S I] I] S I] I;;
fun cbGetContentInfos(curlobj, p, data, code)=
let p -> [str url cbfun] in
if (code == -1) then
(
mutate p <- [(strcat str data) _ _];
0;
)
// download finished
else if (code == 0) then
(
set lHTTP_REQUEST = remove_from_list lHTTP_REQUEST curlobj;
let getHtmlHeader str -> [header cont] in
let getNextToValue header "Location:" -> location in
(
if (location != nil) then
(
let makeHtmlCookie location -> cookie in
let _CRcurlRequest _channel location -> objcurl in
(
_SETcurlOption objcurl CURLOPT_SSL_VERIFYPEER 0;
_SETcurlOption objcurl CURLOPT_HEADER 1;
_SETcurlOption objcurl CURLOPT_NOBODY 1;
_SETcurlOption objcurl CURLOPT_CONNECTTIMEOUT iCURL_REQUEST_TIMEOUT;
if (cookie == nil) then nil else
_SETcurlOptionS objcurl CURLOPT_COOKIE cookie;
set lHTTP_REQUEST = (_CALLcurlRequest objcurl @cbGetContentInfos ["" location cbfun])::lHTTP_REQUEST;
);
0;
)
else
(
let getNextToValue header "Last-Modified:" -> date in
let getNextToValue header "ETag:" -> tag in
let atoi getNextToValue header "Content-Length:" -> length in
exec cbfun with [url (if (tag == nil) then date else tag) length];
0;
);
);
)
else
(
_fooS strcatn ">>>>>>>>> Http get content date failed : "::url::" with code : "::(itoa code)::nil;
set lHTTP_REQUEST = remove_from_list lHTTP_REQUEST curlobj;
exec cbfun with [url nil nil];
0;
);
0;;
/*! @ingroup toolsdl
* \brief Get content infos of an url
*
* Prototype: fun [S fun [S S I] u0] I
*
* \param S : the url to download
* \param fun [S S I] u0 : the callback with url and content date or tag and length
*
* \return ObjCURL : the new request
**/
fun getUrlContentInfos(file, cbfun)=
if strIsUrl file then
let makeHtmlCookie file -> cookie in
let _CRcurlRequest _channel file -> objcurl in
(
_SETcurlOption objcurl CURLOPT_SSL_VERIFYPEER 0;
_SETcurlOption objcurl CURLOPT_HEADER 1;
_SETcurlOption objcurl CURLOPT_NOBODY 1;
_SETcurlOption objcurl CURLOPT_CONNECTTIMEOUT iCURL_REQUEST_TIMEOUT;
if (cookie == nil) then nil else
_SETcurlOptionS objcurl CURLOPT_COOKIE cookie;
set lHTTP_REQUEST = (_CALLcurlRequest objcurl @cbGetContentInfos ["" file cbfun])::lHTTP_REQUEST;
hd lHTTP_REQUEST;
)
else
(
exec cbfun with [file nil nil];
nil;
);;
fun cbGetUrlContent(curlobj, p, data, code)=
let p -> [str url cbfun fullres] in
if (code == -1) then
(
mutate p <- [(strcat str data) _ _ _];
0;
)
// download finished
else if (code == 0) then
(
set lHTTP_REQUEST = remove_from_list lHTTP_REQUEST curlobj;
let getHtmlHeader str -> [header cont] in
(
setHtmlCookie url header;
exec cbfun with [url (if fullres then str else cont)];
);
)
else
(
_fooS strcatn ">>>>>>>>> Http download failed : "::url::" with code : "::(itoa code)::nil;
set lHTTP_REQUEST = remove_from_list lHTTP_REQUEST curlobj;
exec cbfun with [url nil];
0;
);
0;;
fun deleteUrlEx(url, params, cbfun, headeradd, fullres)=
let makeHtmlCookie url -> cookie in
if strIsUrl url then
let _CRcurlRequest _channel url -> objcurl in
(
if !fullres then nil else
_SETcurlOption objcurl CURLOPT_HEADER 1;
_SETcurlOption objcurl CURLOPT_SSL_VERIFYPEER 0;
_SETcurlOption objcurl CURLOPT_CONNECTTIMEOUT iCURL_REQUEST_TIMEOUT;
_SETcurlOptionS objcurl CURLOPT_CUSTOMREQUEST "DELETE";
if (headeradd == nil) then nil else
_SETcurlOptionList objcurl CURLOPT_HTTPHEADER headeradd;
if (cookie == nil) then nil else
_SETcurlOptionS objcurl CURLOPT_COOKIE cookie;
if (params == nil || (!strcmp (strtrim params) "")) then nil else
(
_SETcurlOption objcurl CURLOPT_POST 1;
_SETcurlOptionS objcurl CURLOPT_POSTFIELDS params;
);
set lHTTP_REQUEST = (_CALLcurlRequest objcurl @cbGetUrlContent ["" url cbfun fullres])::lHTTP_REQUEST;
hd lHTTP_REQUEST;
)
else
(
exec cbfun with [url nil];
nil;
);;
fun postUrlEx(url, params, cbfun, headeradd, fullres)=
let makeHtmlCookie url -> cookie in
if strIsUrl url then
let _CRcurlRequest _channel url -> objcurl in
(
_SETcurlOption objcurl CURLOPT_HEADER 1;
_SETcurlOption objcurl CURLOPT_SSL_VERIFYPEER 0;
_SETcurlOption objcurl CURLOPT_CONNECTTIMEOUT iCURL_REQUEST_TIMEOUT;
if (headeradd == nil) then nil else
_SETcurlOptionList objcurl CURLOPT_HTTPHEADER headeradd;
if (cookie == nil) then nil else
_SETcurlOptionS objcurl CURLOPT_COOKIE cookie;
if (params == nil || (!strcmp (strtrim params) "")) then nil else
(
_SETcurlOption objcurl CURLOPT_POST 1;
_SETcurlOptionS objcurl CURLOPT_POSTFIELDS params;
);
set lHTTP_REQUEST = (_CALLcurlRequest objcurl @cbGetUrlContent ["" url cbfun fullres])::lHTTP_REQUEST;
hd lHTTP_REQUEST;
)
else
(
exec cbfun with [url nil];
nil;
);;
fun getUrlEx(url, params, cbfun, headeradd, fullres)=
let makeHtmlCookie url -> cookie in
if strIsUrl url then
let _CRcurlRequest _channel url -> objcurl in
(
_SETcurlOption objcurl CURLOPT_HEADER 1;
_SETcurlOption objcurl CURLOPT_FOLLOWLOCATION 1;
_SETcurlOption objcurl CURLOPT_SSL_VERIFYPEER 0;
_SETcurlOption objcurl CURLOPT_CONNECTTIMEOUT iCURL_REQUEST_TIMEOUT;
if (headeradd == nil) then nil else
_SETcurlOptionList objcurl CURLOPT_HTTPHEADER headeradd;
if (cookie == nil) then nil else
_SETcurlOptionS objcurl CURLOPT_COOKIE cookie;
if (params == nil || (!strcmp (strtrim params) "")) then nil else
(
_SETcurlOption objcurl CURLOPT_HTTPGET 1;
_SETcurlOptionS objcurl CURLOPT_POSTFIELDS params;
);
set lHTTP_REQUEST = (_CALLcurlRequest objcurl @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 makeHtmlCookie url -> cookie in
let _CRcurlRequest _channel url -> objcurl in
(
_SETcurlOption objcurl CURLOPT_HEADER 1;
_SETcurlOption objcurl CURLOPT_SSL_VERIFYPEER 0;
_SETcurlOption objcurl CURLOPT_CONNECTTIMEOUT iCURL_REQUEST_TIMEOUT;
if (headeradd == nil) then nil else
_SETcurlOptionList objcurl CURLOPT_HTTPHEADER headeradd;
if (cookie == nil) then nil else
_SETcurlOptionS objcurl CURLOPT_COOKIE cookie;
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
(
_ADDcurlFormField objcurl name value;
)
else
(
_ADDcurlFileFormField objcurl name _checkpack file;
);
);
set i = i + 1;
);
set lHTTP_REQUEST = (_CALLcurlRequest objcurl @cbGetUrlContent ["" url cbfun fullres])::lHTTP_REQUEST;
hd lHTTP_REQUEST;
)
else
(
exec cbfun with [url nil];
nil;
);;
/*! @ingroup toolsdl
* \brief Download an url using the GET method
*
* Prototype: fun [S S fun [S S] u0] I
*
* \param S : the url to download
* \param S : the url parameters ("login=toto&pass=tata")
* \param fun [S S] u0 : the callback with url and data
*
* \return ObjCURL : the new request
**/
fun getUrl(url, params, cbfun)=
getUrlEx url params cbfun nil 0;;
/*! @ingroup toolsdl
* \brief Download an url using the POST method
*
* Prototype: fun [S S fun [S S] u0] I
*
* \param S : the url to download
* \param S : the url parameters ("login=toto&pass=tata")
* \param fun [S S] u0 : the callback with url and data
*
* \return ObjCURL : the new request
**/
fun postUrl(url, params, cbfun)=
postUrlEx url params cbfun nil 0;;
/*! @ingroup toolsdl
* \brief Download an url using the POST method with multipart
*
* Prototype: fun [S [[S S S] r1] fun [S S] u0] I
*
* \param S : the url to download
* \param [[S S S] r1]: list of parameters [name value file]
* \param fun [S S] u0 : the callback with url and data
*
* \return ObjCURL : the new request
**/
fun postUrlMultiPart(url, lparams, cbfun)=
postUrlMultiPartEx url lparams cbfun nil 0;;
/*! @ingroup toolsdl
* \brief Call the DELETE method on an url
*
* Prototype: fun [S S fun [S S] u0] I
*
* \param S : the url
* \param S : the url parameters ("login=toto&pass=tata")
* \param fun [S S] u0 : the callback with url and data
*
* \return ObjCURL : the new request
**/
fun deleteUrl(url, params, cbfun)=
deleteUrlEx url params cbfun nil 0;;
fun sendMail(server, port, from , to, cc, subject, message, lparams, cbfun)=
if (server != nil) && (from != nil) && (to != nil) && (message != nil) && (subject != nil) then
//TODO check mail form
let if ((cc == nil) || (!strcmp cc "")) then 0 else 1 -> havecc in
let if (port == nil) then 25 else port -> port in
let strcatn "smtp://"::server::nil -> url in
let _CRcurlRequest _channel url -> objcurl in
let (strcat (ctoa 13) (ctoa 10)) -> ends in
(
_SETcurlOption objcurl CURLOPT_HEADER 0;
_SETcurlOption objcurl CURLOPT_SSL_VERIFYPEER 0;
_SETcurlOption objcurl CURLOPT_PORT port;
_SETcurlOption objcurl CURLOPT_CONNECTTIMEOUT iCURL_REQUEST_TIMEOUT;
_SETcurlOptionS objcurl CURLOPT_MAIL_FROM from;
let if (!havecc) then to::nil else to::cc::nil -> rcpt in
_SETcurlOptionList objcurl CURLOPT_MAIL_RCPT rcpt;
let strcatn "To: \""::to::"\" <"::to::">"::ends::
"From: \""::from::"\" <"::from::">"::ends::nil
-> headeradd in
let if (havecc) then strcat headeradd (strcatn "Cc: \""::cc::"\" <"::cc::">"::ends::nil) else headeradd -> headeradd in
let strcatn headeradd::"Reply-To: \""::from::"\" <"::from::">"::ends::nil -> headeradd in
let strcatn headeradd::"Message-ID: <"::(itoa time)::"-"::(_MD5value strcat from to)::"@"::(getHttpDomain server)::">"::ends::nil -> headeradd in
let hd strextr (ctime time) -> [dayname [monthname [day [hour [year _]]]]] in
let strcat headeradd
strcatn "Subject: "::(strtoutf8 subject)::"\n"::
"Date: "::dayname::", "::day::" "::monthname::" "::year::" "::hour::" +0000\n"::
nil
-> headeradd in
(
let sizelist lparams -> size in
if (size == 0) then
(
set headeradd = strcatn headeradd::ends::message::ends::ends::nil;
0;
)
else
let strcat "----=_NextPart_" (_MD5value itoa _tickcount) -> boundary in
(
set headeradd = strcat headeradd "MIME-Version: 1.0\n";
set headeradd = strcat headeradd "Content-Type: multipart/mixed;";
set headeradd = strcatn headeradd::" boundary=\""::boundary::"\""::ends::nil;
set headeradd = strcatn headeradd::"Content-Description: multipart-1"::ends::ends::nil;
set headeradd = strcatn headeradd::"--"::boundary::ends::nil;
set headeradd = strcatn headeradd::"Content-Type: text/plain"::ends::nil;
set headeradd = strcatn headeradd::"Content-Transfer-Encoding: 8BIT"::nil;
set headeradd = strcatn headeradd::"Content-Disposition: inline"::ends::nil;
set headeradd = strcatn headeradd::"Content-Description: text-part-1"::ends::ends::nil;
set headeradd = strcatn headeradd::(strtoutf8 message)::ends::ends::nil;
let 0 -> i in
while i < size do
(
let nth_list lparams i -> [name value file] in
(
if(file == nil) then
(
set headeradd = strcatn headeradd::"--"::boundary::ends::nil;
set headeradd = strcatn headeradd::"Content-Type: text/plain"::ends::nil;
set headeradd = strcatn headeradd::"Content-Transfer-Encoding: BASE64"::ends::nil;
set headeradd = strcatn headeradd::"Content-Disposition: inline"::ends::nil;
set headeradd = strcatn headeradd::"Content-Description: "::name::ends::ends::nil;
set headeradd = strcatn headeradd::(base64_encode value)::ends::ends::nil;
)
else
(
let getFileExt file -> ext in
let getPathFile file "" -> [_ filename] in
let if (!strcmpi ext "jpg") || (!strcmpi ext "jpeg") then
"image/jpeg"
else if (!strcmpi ext "png") then
"image/png"
else "text/plain"
-> mimetype in
(
set headeradd = strcatn headeradd::"--"::boundary::ends::nil;
set headeradd = strcatn headeradd::"Content-Type: "::mimetype::ends::nil;
set headeradd = strcatn headeradd::"Content-Transfer-Encoding: BASE64"::ends::nil;
set headeradd = strcatn headeradd::"Content-Disposition: attachment; filename="::filename::ends::nil;
set headeradd = strcatn headeradd::"Content-Description: File_"::(itoa i)::ends::ends::nil;
set headeradd = strcatn headeradd::(base64_encode _getpack _checkpack file)::ends::ends::nil;
);
);
);
set i = i + 1;
);
set headeradd = strcatn headeradd::"--"::boundary::ends::nil;
0;
);
_SETcurlOptionS objcurl CURLOPT_UPLOAD headeradd;
);
set lHTTP_REQUEST = (_CALLcurlRequest objcurl @cbGetUrlContent ["" url cbfun 0])::lHTTP_REQUEST;
hd lHTTP_REQUEST;
)
else
(
exec cbfun with [server "Mail Error"];
nil;
);;
/* ********************************************************************************************* /
Vector
/ ********************************************************************************************* */
/*! @ingroup toolsvec
* \brief Test if the coordinates are in the rectangle
*
* Prototype: fun [I I [I I I I]] I
*
* \param I : x coord
* \param I : y coord
* \param [I I I I] : rectangle x y width height
*
* \return I : return 1 if the coords are in the rectangle
**/
fun isCoordInRect(x, y, rect)=
let rect -> [rx ry rw rh] in
(x > rx) && (y > ry) && (x < (rx + rw)) && (y < (ry + rh));;
/*! @ingroup toolsvec
* \brief Get the smallest float value
*
* Prototype: fun [F F] F
*
* \param F : first value
* \param F : second value
*
* \return F : the smallest value
**/
fun minf(a, b)=
if a <. b then a else b;;
/*! @ingroup toolsvec
* \brief Convert a float value to a rounded int value (float to rounded integer)
*
* Prototype: fun [F] I
*
* \param F : float value
*
* \return I : rounded int value
**/
fun ftori(val)=
if (val >=. 0.0) then
ftoi (val +. 0.5)
else
ftoi (val +. 0.5);;
/*! @ingroup toolsvec
* \brief Test if a vector is set to 0
*
* Prototype: fun [[I I I]] I
*
* \param [I I I] : int vector
*
* \return I : 1 if the vector is 0, 0 otherwise
**/
fun zeroVector(vec)=
let vec -> [x y z] in
if (x || y || z) then
0
else
1;;
/*! @ingroup toolsvec
* \brief Test if a float vector is set to 0
*
* Prototype: fun [[F F F]] I
*
* \param [F F F] : float vector
*
* \return I : 1 if the vector is 0, 0 otherwise
**/
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;;
/*! @ingroup toolsvec
* \brief Test if a vector is set to 0
*
* Prototype: fun [[I I I]] I
*
* \param [I I I] : int vector
*
* \return I : 1 if the vector is 0, 0 otherwise
**/
fun vectorIsZero(vec)=
let vec -> [x y z] in
x == 0 && y == 0 && z == 0;;
/*! @ingroup toolsvec
* \brief Test if a 2d vector is set to 0
*
* Prototype: fun [[I I]] I
*
* \param [I I] : int vector
*
* \return I : 1 if the vector is 0, 0 otherwise
**/
fun vector2dIsZero(vec)=
let vec -> [x y] in
x == 0 && y == 0;;
/*! @ingroup toolsvec
* \brief Test if a float vector is set to 0
*
* Prototype: fun [[F F F]] I
*
* \param [F F F] : float vector
*
* \return I : 1 if the vector is 0, 0 otherwise
**/
fun vectorIsZeroF(vec)=
let vec -> [x y z] in
x == 0.0 && y == 0.0 && z == 0.0;;
/*! @ingroup toolsvec
* \brief Test if a 2d float vector is set to 0
*
* Prototype: fun [[F F]] I
*
* \param [F F] : float vector
*
* \return I : 1 if the vector is 0, 0 otherwise
**/
fun vector2dIsZeroF(vec)=
let vec -> [x y] in
x == 0.0 && y == 0.0;;
/*! @ingroup toolsvec
* \brief Test if two vectors are equal
*
* Prototype: fun [[I I I] [I I I]] I
*
* \param [I I I] : first int vector
* \param [I I I] : second int vector
*
* \return I : 1 if the two vectors are equal, 0 otherwise
**/
fun vectorEqual(vec1, vec2)=
let vec1 -> [x1 y1 z1] in
let vec2 -> [x2 y2 z2] in
x1 == x2 && y1 == y2 && z1 == z2;;
/*! @ingroup toolsvec
* \brief Test if two float vectors are equal
*
* Prototype: fun [[F F F] [F F F]] I
*
* \param [F F F] : first float vector
* \param [F F F] : second float vector
*
* \return I : 1 if the two vectors are equal, 0 otherwise
**/
fun vectorEqualF(vec1, vec2)=
let vec1 -> [x1 y1 z1] in
let vec2 -> [x2 y2 z2] in
x1 == x2 && y1 == y2 && z1 == z2;;
/*! @ingroup toolsvec
* \brief Normalize a float vector
*
* Prototype: fun [[F F F]] [F F F]
*
* \param [F F F] : float vector
*
* \return [F F F] : normalized float vector
**/
fun normalizeVectorF(vec)=
let vec -> [x y z] in
let sqrt (x *. x +. y *. y +. z *. z) -> sum in
let if (sum == 0.0) then 1.0 else 1.0 /. sum -> coef in
[(x *. coef) (y *. coef) (z *. coef)];;
/*! @ingroup toolsvec
* \brief Get the average of a vector
*
* Prototype: fun [[F F F]] F
*
* \param [F F F] : float vector
*
* \return F : average
**/
fun vectorAverageF(vec)=
let vec -> [x y z] in
x +. y +. z /. 3.0;;
/*! @ingroup toolsvec
* \brief Get the cube of a vector
*
* Prototype: fun [[F F F]] F
*
* \param [F F F] : float vector
*
* \return F : cube (x * y * z)
**/
fun vectorCubeF(vec)=
let vec -> [x y z] in
x *. y *. z;;
/*! @ingroup toolsvec
* \brief Get a vector length
*
* Prototype: fun [[I I I]] F
*
* \param [I I I] : int vector
*
* \return F : vector length
**/
fun getVectorLength(vec1)=
let vec1 -> [x1 y1 z1] in
sqrt itof (x1 * x1 + y1 * y1 + z1 * z1);;
/*! @ingroup toolsvec
* \brief Get a vector length
*
* Prototype: fun [[F F F]] F
*
* \param [F F F] : float vector
*
* \return F : vector length
**/
fun getVectorLengthF(vec1)=
let vec1 -> [x1 y1 z1] in
sqrt (x1 *. x1 +. y1 *. y1 +. z1 *. z1);;
/*! @ingroup toolsvec
* \brief Get a vector 4 length
*
* Prototype: fun [[F F F F]] F
*
* \param [F F F F] : float vector
*
* \return F : vector length
**/
fun getVector4LengthF(vec1)=
let vec1 -> [x1 y1 z1 w1] in
sqrt (x1 *. x1 +. y1 *. y1 +. z1 *. z1 +. w1 *. w1);;
/*! @ingroup toolsvec
* \brief Get the distance between 2 vectors
*
* Prototype: fun [[I I I] [I I I]] F
*
* \param [I I I] : int vector
* \param [I I I] : int vector
*
* \return F : vector length
**/
fun getVectorDistance(vec1, vec2)=
let vec1 -> [x1 y1 z1] in
let vec2 -> [x2 y2 z2] in
sqrt ((sqr itof(x1 - x2)) +. (sqr itof(y1 - y2)) +. (sqr itof(z1 - z2)));;
/*! @ingroup toolsvec
* \brief Get the distance between 2 2D vectors
*
* Prototype: fun [[I I] [I I]] F
*
* \param [I I] : int vector
* \param [I I] : int vector
*
* \return F : vector length
**/
fun getVector2dDistance(vec1, vec2)=
let vec1 -> [x1 y1] in
let vec2 -> [x2 y2] in
sqrt ((sqr itof(x1 - x2)) +. (sqr itof(y1 - y2)));;
/*! @ingroup toolsvec
* \brief Get the distance between 2 vectors
*
* Prototype: fun [[F F F] [F F F]] F
*
* \param [F F F] : float vector
* \param [F F F] : float vector
*
* \return F : vector length
**/
fun getVectorDistanceF(vec1, vec2)=
let vec1 -> [x1 y1 z1] in
let vec2 -> [x2 y2 z2] in
sqrt ((sqr(x1 -. x2)) +. (sqr(y1 -. y2)) +. (sqr(z1 -. z2)));;
/*! @ingroup toolsvec
* \brief Cross product of two vectors
*
* Prototype: fun [[I I I] [I I I]] [I I I]
*
* \param [I I I] : first int vector
* \param [I I I] : second int vector
*
* \return [I I I] : vector result
**/
fun crossVector(vec1, vec2)=
let vec1 -> [x1 y1 z1] in
let vec2 -> [x2 y2 z2] in
[(y1 * z2 - z1 * y2) (z1 * x2 - x1 * z2) (x1 * y2 - y1 * x2)];;
/*! @ingroup toolsvec
* \brief Cross product of two vectors
*
* Prototype: fun [[F F F] [F F F]] [F F F]
*
* \param [F F F] : first float vector
* \param [F F F] : second float vector
*
* \return [F F F] : float vector result
**/
fun crossVectorF(vec1, vec2)=
let vec1 -> [x1 y1 z1] in
let vec2 -> [x2 y2 z2] in
[(y1 *. z2 -. z1 *. y2) (z1 *. x2 -. x1 *. z2) (x1 *. y2 -. y1 *. x2)];;
/*! @ingroup toolsvec
* \brief Dot product of two vectors
*
* Prototype: fun [[I I I] [I I I]] [I I I]
*
* \param [I I I] : first int vector
* \param [I I I] : second int vector
*
* \return F : dot product result
**/
fun dotVector(vec1, vec2)=
let vec1 -> [x1 y1 z1] in
let vec2 -> [x2 y2 z2] in
x1 * x2 + y1 * y2 + z1 * z2;;
/*! @ingroup toolsvec
* \brief Dot product of two vectors
*
* Prototype: fun [[F F F] [F F F]] [F F F]
*
* \param [F F F] : first float vector
* \param [F F F] : second float vector
*
* \return F : dot product result
**/
fun dotVectorF(vec1, vec2)=
let vec1 -> [x1 y1 z1] in
let vec2 -> [x2 y2 z2] in
x1 *. x2 +. y1 *. y2 +. z1 *. z2;;
/*! @ingroup toolsvec
* \brief Get the angle between 2 vectors in radian
*
* Prototype: fun [[I I I] [I I I]] F
*
* \param [I I I] : int vector
* \param [I I I] : int vector
*
* \return F : angle between the 2 vectors
**/
fun getVectorAngle(vec1, vec2)=
let vec1 -> [x1 y1 z1] in
let vec2 -> [x2 y2 z2] in
let sqrt itof ((x1 * x1 + y1 * y1 + z1 * z1) * (x2 * x2 + y2 * y2 + z2 * z2)) -> lengthsproduct in
if (lengthsproduct == 0.0) then acos 0.0 else
acos ((itof (x1 * x2 + y1 * y2 + z1 * z2)) /. lengthsproduct);;
/*! @ingroup toolsvec
* \brief Get the angle between 2 2D vectors in degree
*
* Prototype: fun [[I I] [I I]] F
*
* \param [I I] : int vector
* \param [I I] : int vector
*
* \return F : angle between the 2 vectors
**/
fun getVector2dAngle(vec1, vec2)=
let vec1 -> [x1 y1] in
let vec2 -> [x2 y2] in
let itof (x2 - x1) -> x in
let itof (y2 - y1) -> y in
(atan2 y x) *. 180.0 /. PIf;;
/*! @ingroup toolsvec
* \brief Get the angle between 2 vectors in radian
*
* Prototype: fun [[F F F] [F F F]] F
*
* \param [F F F] : float vector
* \param [F F F] : float vector
*
* \return F : angle between the 2 vectors
**/
fun getVectorAngleF(vec1, vec2)=
let vec1 -> [x1 y1 z1] in
let vec2 -> [x2 y2 z2] in
let sqrt ((x1 *. x1 +. y1 *. y1 +. z1 *. z1) *. (x2 *. x2 +. y2 *. y2 +. z2 *. z2)) -> lengthsproduct in
if (lengthsproduct == 0.0) then acos 0.0 else
acos ((x1 *. x2 +. y1 *. y2 +. z1 *. z2) /. lengthsproduct);;
/*! @ingroup toolsvec
* \brief Get the oriented angle between 2 vectors in radian, between pi and -pi
*
* Prototype: fun [[F F F] [F F F] [F F F]] F
*
* \param [F F F] : float vector
* \param [F F F] : float vector
* \param [F F F] : normal of the plane containing both vector. Used for the angle orientation
*
* \return F : angle between the 2 vectors
**/
fun getVectorOrientedAngleF(vec1, vec2, planenormal)=
//atan2 (dotVectorF (crossVectorF vec1 vec2) planenormal) (dotVectorF vec1 vec2);;
let acos (dotVectorF (normalizeVectorF vec1) (normalizeVectorF vec2)) -> angle in
let crossVectorF vec1 vec2 -> cross in
if (dotVectorF planenormal cross) <. 0.0 then (-.angle) else angle;;
/*! @ingroup toolsvec
* \brief Min of two vectors
*
* Prototype: fun [[I I I] [I I I]] [I I I]
*
* \param [I I I] : first int vector
* \param [I I I] : second int vector
*
* \return [I I I] : min result
**/
fun minVector(vec1, vec2)=
let vec1 -> [x1 y1 z1] in
let vec2 -> [x2 y2 z2] in
[(min x1 x2) (min y1 y2) (min z1 z2)];;
/*! @ingroup toolsvec
* \brief Min of two vectors
*
* Prototype: fun [[F F F] [F F F]] [F F F]
*
* \param [F F F] : first int vector
* \param [F F F] : second int vector
*
* \return [F F F] : min result
**/
fun minVectorF(vec1, vec2)=
let vec1 -> [x1 y1 z1] in
let vec2 -> [x2 y2 z2] in
[(minf x1 x2) (minf y1 y2) (minf z1 z2)];;
/*! @ingroup toolsvec
* \brief Min of two vectors 2
*
* Prototype: fun [[F F] [F F]] [F F]
*
* \param [F F] : first int vector
* \param [F F] : second int vector
*
* \return [F F] : min result
**/
fun minVector2F(vec1, vec2)=
let vec1 -> [x1 y1] in
let vec2 -> [x2 y2] in
[(minf x1 x2) (minf y1 y2)];;
/*! @ingroup toolsvec
* \brief Max of two vectors
*
* Prototype: fun [[I I I] [I I I]] [I I I]
*
* \param [I I I] : first int vector
* \param [I I I] : second int vector
*
* \return [I I I] : max result
**/
fun maxVector(vec1, vec2)=
let vec1 -> [x1 y1 z1] in
let vec2 -> [x2 y2 z2] in
[(max x1 x2) (max y1 y2) (max z1 z2)];;
/*! @ingroup toolsvec
* \brief Max of two vectors
*
* Prototype: fun [[F F F] [F F F]] [F F F]
*
* \param [F F F] : first int vector
* \param [F F F] : second int vector
*
* \return [F F F] : max result
**/
fun maxVectorF(vec1, vec2)=
let vec1 -> [x1 y1 z1] in
let vec2 -> [x2 y2 z2] in
[(maxf x1 x2) (maxf y1 y2) (maxf z1 z2)];;
/*! @ingroup toolsvec
* \brief Max of two vectors
*
* Prototype: fun [[F F] [F F]] [F F]
*
* \param [F F] : first int vector
* \param [F F] : second int vector
*
* \return [F F] : max result
**/
fun maxVector2F(vec1, vec2)=
let vec1 -> [x1 y1] in
let vec2 -> [x2 y2] in
[(maxf x1 x2) (maxf y1 y2)];;
/*! @ingroup toolsvec
* \brief Substract two vectors
*
* Prototype: fun [[I I I] [I I I]] [I I I]
*
* \param [I I I] : first int vector
* \param [I I I] : second int vector
*
* \return [I I I] : vector result
**/
fun subVector(vec1, vec2)=
let vec1 -> [x1 y1 z1] in
let vec2 -> [x2 y2 z2] in
[(x1 - x2) (y1 - y2) (z1 - z2)];;
/*! @ingroup toolsvec
* \brief Substract two float vectors
*
* Prototype: fun [[F F F] [F F F]] [F F F]
*
* \param [F F F] : first float vector
* \param [F F F] : second float vector
*
* \return [F F F] : float vector result
**/
fun subVectorF(vec1, vec2)=
let vec1 -> [x1 y1 z1] in
let vec2 -> [x2 y2 z2] in
[(x1 -. x2) (y1 -. y2) (z1 -. z2)];;
/*! @ingroup toolsvec
* \brief Substract two vectors 2
*
* Prototype: fun [[I I] [I I]] [I I]
*
* \param [I I] : first int vector
* \param [I I] : second int vector
*
* \return [I I] : vector result
**/
fun subVector2(vec1, vec2)=
let vec1 -> [x1 y1] in
let vec2 -> [x2 y2] in
[(x1 - x2) (y1 - y2)];;
/*! @ingroup toolsvec
* \brief Substract two float vectors 2
*
* Prototype: fun [[F F] [F F]] [F F]
*
* \param [F F] : first float vector
* \param [F F] : second float vector
*
* \return [F F] : float vector result
**/
fun subVector2F(vec1, vec2)=
let vec1 -> [x1 y1] in
let vec2 -> [x2 y2] in
[(x1 -. x2) (y1 -. y2)];;
/*! @ingroup toolsvec
* \brief Add two vectors
*
* Prototype: fun [[I I I] [I I I]] [I I I]
*
* \param [I I I] : first int vector
* \param [I I I] : second int vector
*
* \return [I I I] : vector result
**/
fun addVector(vec1, vec2)=
let vec1 -> [x1 y1 z1] in
let vec2 -> [x2 y2 z2] in
[(x1 + x2) (y1 + y2) (z1 + z2)];;
/*! @ingroup toolsvec
* \brief Add two float vectors
*
* Prototype: fun [[F F F] [F F F]] [F F F]
*
* \param [F F F] : first float vector
* \param [F F F] : second float vector
*
* \return [F F F] : float vector result
**/
fun addVectorF(vec1, vec2)=
let vec1 -> [x1 y1 z1] in
let vec2 -> [x2 y2 z2] in
[(x1 +. x2) (y1 +. y2) (z1 +. z2)];;
/*! @ingroup toolsvec
* \brief Add two vectors
*
* Prototype: fun [[I I] [I I]] [I I]
*
* \param [I I] : first int vector
* \param [I I] : second int vector
*
* \return [I I] : vector result
**/
fun addVector2(vec1, vec2)=
let vec1 -> [x1 y1] in
let vec2 -> [x2 y2] in
[(x1 + x2) (y1 + y2)];;
/*! @ingroup toolsvec
* \brief Add two float vectors 2
*
* Prototype: fun [[F F] [F F]] [F F]
*
* \param [F F] : first float vector
* \param [F F] : second float vector
*
* \return [F F] : float vector result
**/
fun addVector2F(vec1, vec2)=
let vec1 -> [x1 y1] in
let vec2 -> [x2 y2] in
[(x1 +. x2) (y1 +. y2)];;
/*! @ingroup toolsvec
* \brief Divide two vectors
*
* Prototype: fun [[I I I] [I I I]] [I I I]
*
* \param [I I I] : first int vector
* \param [I I I] : second int vector
*
* \return [I I I] : vector result
**/
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)];;
/*! @ingroup toolsvec
* \brief Divide two float vectors
*
* Prototype: fun [[F F F] [F F F]] [F F F]
*
* \param [F F F] : first float vector
* \param [F F F] : second float vector
*
* \return [F F F] : float vector result
**/
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)];;
/*! @ingroup toolsvec
* \brief Divide two vectors 2
*
* Prototype: fun [[I I] [I I]] [I I]
*
* \param [I I] : first int vector
* \param [I I] : second int vector
*
* \return [I I] : vector result
**/
fun divideVector2(vec1, vec2)=
if vector2dIsZero vec2 then nil else
let vec1 -> [x1 y1] in
let vec2 -> [x2 y2] in
[(x1 / x2) (y1 / y2)];;
/*! @ingroup toolsvec
* \brief Divide two float vectors 2
*
* Prototype: fun [[F F] [F F]] [F F]
*
* \param [F F] : first float vector
* \param [F F] : second float vector
*
* \return [F F] : float vector result
**/
fun divideVector2F(vec1, vec2)=
if vector2dIsZeroF vec2 then nil else
let vec1 -> [x1 y1] in
let vec2 -> [x2 y2] in
[(x1 /. x2) (y1 /. y2)];;
/*! @ingroup toolsvec
* \brief Multiply two vectors
*
* Prototype: fun [[I I I] [I I I]] [I I I]
*
* \param [I I I] : first int vector
* \param [I I I] : second int vector
*
* \return [I I I] : vector result
**/
fun multiplyVector(vec1, vec2)=
let vec1 -> [x1 y1 z1] in
let vec2 -> [x2 y2 z2] in
[(x1 * x2) (y1 * y2) (z1 * z2)];;
/*! @ingroup toolsvec
* \brief Multiply two vectors 2
*
* Prototype: fun [[I I] [I I]] [I I]
*
* \param [I I] : first int vector
* \param [I I] : second int vector
*
* \return [I I] : vector result
**/
fun multiplyVector2(vec1, vec2)=
let vec1 -> [x1 y1] in
let vec2 -> [x2 y2] in
[(x1 * x2) (y1 * y2)];;
/*! @ingroup toolsvec
* \brief Multiply two float vectors
*
* Prototype: fun [[F F F] [F F F]] [F F F]
*
* \param [F F F] : first float vector
* \param [F F F] : second float vector
*
* \return [F F F] : float vector result
**/
fun multiplyVectorF(vec1, vec2)=
let vec1 -> [x1 y1 z1] in
let vec2 -> [x2 y2 z2] in
[(x1 *. x2) (y1 *. y2) (z1 *. z2)];;
/*! @ingroup toolsvec
* \brief Multiply two float vectors 2
*
* Prototype: fun [[F F] [F F]] [F F]
*
* \param [F F] : first float vector
* \param [F F] : second float vector
*
* \return [F F] : float vector result
**/
fun multiplyVector2F(vec1, vec2)=
let vec1 -> [x1 y1] in
let vec2 -> [x2 y2] in
[(x1 *. x2) (y1 *. y2)];;
/*! @ingroup toolsvec
* \brief Project an int vector onto another int vector
*
* Prototype: fun [[I I I] [I I I]] [F F F]
*
* \param [I I I] : int vector to project
* \param [I I I] : int vector on which the vector is projected
*
* \return [F F F] : vector result, nil if the second vector is the zero vector
**/
fun projectVector(vec1, vec2)=
let vec2 -> [x2 y2 z2] in
if (x2 == 0 && y2 == 0 && z2 == 0) then nil else
let (itof (dotVector vec1 vec2)) /. (itof (dotVector vec2 vec2)) -> scalar in
[(scalar *. (itof x2)) (scalar *. (itof y2)) (scalar *. (itof z2))];;
/*! @ingroup toolsvec
* \brief Project a float vector onto another float vector
*
* Prototype: fun [[F F F] [F F F]] [F F F]
*
* \param [F F F] : float vector to project
* \param [F F F] : float vector on which the vector is projected
*
* \return [F F F] : float vector result, nil if the second vector is the zero vector
**/
fun projectVectorF(vec1, vec2)=
let vec2 -> [x2 y2 z2] in
if (x2 == 0.0 && y2 == 0.0 && z2 == 0.0) then nil else
let (dotVectorF vec1 vec2) /. (dotVectorF vec2 vec2) -> scalar in
[(scalar *. x2) (scalar *. y2) (scalar *. z2)];;
/*! @ingroup toolsvec
* \brief Project an int vector onto a plane defined by its int normal vector
*
* Prototype: fun [[I I I] [I I I]] [F F F]
*
* \param [I I I] : int vector to project
* \param [I I I] : normal vector of the plane
*
* \return [F F F] : vector result, nil if the normal is the zero vector
**/
fun projectVectorOnPlane(vec, planenormal)=
let planenormal -> [x y z] in
if (x == 0 && y == 0 && z == 0) then nil else
let (itof (dotVector vec planenormal)) /. (itof (dotVector planenormal planenormal)) -> scalar in
let [(scalar *. (itof x)) (scalar *. (itof y)) (scalar *. (itof z))] -> vectorproj in
let vec -> [vx vy vz] in
subVectorF [(itof vx) (itof vy) (itof vz)] vectorproj;;
/*! @ingroup toolsvec
* \brief Project a float vector onto a plane defined by its float normal vector
*
* Prototype: fun [[F F F] [F F F]] [F F F]
*
* \param [F F F] : float vector to project
* \param [F F F] : normal vector of the plane
*
* \return [F F F] : float vector result, nil if the normal is the zero vector
**/
fun projectVectorOnPlaneF(vec, planenormal)=
let planenormal -> [x y z] in
if (x == 0.0 && y == 0.0 && z == 0.0) then nil else
let (dotVectorF vec planenormal) /. (dotVectorF planenormal planenormal) -> scalar in
let [(scalar *. x) (scalar *. y) (scalar *. z)] -> vectorproj in
subVectorF vec vectorproj;;
/*! @ingroup toolsvec
* \brief Intersection point between a plane and a vector
*
* Prototype: fun [[F F F] [F F F] [F F F] [F F F]] [F F F]
*
* \param [F F F] : float vector
* \param [F F F] : float point lying on the vector
* \param [F F F] : plane normal float vector
* \param [F F F] : float point lying on the plane
*
* \return [F F F] : intersection point, nil if it does not exist
**/
fun vectorPlaneIntersectionF(vec, vecpoint, planenormal, planepoint)=
let normalizeVectorF vec -> vec in
let normalizeVectorF planenormal -> planenormal in
let dotVectorF planenormal planepoint -> planeconstant in
let dotVectorF planenormal vec -> divisor in
//let if (divisor == 0.0) then 0.000001 else divisor -> divisor in
if (divisor == 0.0) then nil else
let (planeconstant -. (dotVectorF planenormal vecpoint)) /. divisor -> t in
let vec -> [dx dy dz] in
let vecpoint -> [px py pz] in
[(dx *. t +. px) (dy *. t +. py) (dz *. t +. pz)];;
/*! @ingroup toolsvec
* \brief Get a plane normal from 3 points belonging to the plane
*
* Prototype: fun [[F F F][F F F][F F F]] [F F F]
*
* \param [F F F] : first point coordinates
* \param [F F F] : second point coordinates
* \param [F F F] : third point coordinates
*
* \return [F F F] : plane normal
**/
fun getPlaneNormalF(point1, point2, point3)=
let subVectorF point2 point1 -> vec1 in
let subVectorF point3 point1 -> vec2 in
normalizeVectorF (crossVectorF vec1 vec2);;
/*! @ingroup toolsvec
* \brief Get vector X value
*
* Prototype: fun [[F F F]] F
*
* \param [F F F] : float vector
*
* \return F : X float result
**/
fun getVectorXF(vec)=
let vec -> [x1 y1 z1] in
x1;;
/*! @ingroup toolsvec
* \brief Get vector Y value
*
* Prototype: fun [[F F F]] F
*
* \param [F F F] : float vector
*
* \return F : Y float result
**/
fun getVectorYF(vec)=
let vec -> [x1 y1 z1] in
y1;;
/*! @ingroup toolsvec
* \brief Get vector Z value
*
* Prototype: fun [[F F F]] F
*
* \param [F F F] : float vector
*
* \return F : Z float result
**/
fun getVectorZF(vec)=
let vec -> [x1 y1 z1] in
z1;;
/*! @ingroup toolsvec
* \brief Get the shortest angle
*
* Prototype: fun [F] F
*
* \param F : angle in degree
*
* \return F : the shortest angle in degree
**/
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);;
/*! @ingroup toolsvec
* \brief Get quaternion inverse
*
* Prototype: fun [[F F F F]] [F F F F]
*
* \param [F F F F] : quaternion
*
* \return [F F F F] : the inversed quaternion
**/
fun quatInverse(quat)=
let quat -> [x y z w] in
let w*.w+.x*.x+.y*.y+.z*.z -> norm in
if (norm <=. 0.0) then
[x y z w]
else
let 1.0 /. norm -> inorm in
[(-.x*.inorm) (-.y*.inorm) (-.z*.inorm) (w*.inorm)];;
/*! @ingroup toolsvec
* \brief LookAt function that return pitch yaw roll in radian
*
* Prototype: fun [[F F F] [F F F] [F F F]] [F F F]
*
* \param [F F F] : source vector
* \param [F F F] : target vector
*
* \return [F F F] : pitch yaw roll in radian
**/
fun lookAtPYR(src, target, flipz)=
let subVectorF target src -> [dx dy dz] in
let sqrt (dx *. dx +. dy *. dy +. dz *. dz) -> lenght in
let if lenght >. 0.0 then
[dx /. lenght dy /. lenght dz /. lenght]
else
[dx dy dz]
-> [dx dy dz] in
let asin dy -> pitch in
let if (flipz) then (atan2 (-.dx) dz) +. PIf *. 0.5 else atan2 dx dz -> yaw in
[pitch yaw 0.0];;
fun reorientQuat(quat, upvec)=
let normalizeVectorF (crossVectorF [0.0 1.0 0.0] upvec) -> rotaxis in
let dotVectorF [0.0 1.0 0.0] upvec -> dotproduct in
let acos dotproduct -> angle in
SO3MathsQuatAdd (SO3MathsQuatFromAngleAxis angle rotaxis) quat;;
fun lookAtQuat(src, target, upaxis)=
let normalizeVectorF (subVectorF target src) -> forward in
let normalizeVectorF crossVectorF upaxis forward -> right in
let normalizeVectorF crossVectorF forward right -> up in
let dotVectorF up upaxis -> dotf in
let normalizeVectorF (multiplyVectorF [dotf dotf dotf] forward) -> up in
let up -> [upx upy upz] in
let forward -> [fx fy fz] in
let right -> [rx ry rz] in
let mktab 3 nil -> rotmat in
(
//init matrix
let 0 -> t in
while (t < 3) do
(
set rotmat.(t) = mktab 3 0.0;
set t = t + 1;
);
set rotmat.(0).(0) = rx;
set rotmat.(0).(1) = upx;
set rotmat.(0).(2) = -.fx;
set rotmat.(1).(0) = ry;
set rotmat.(1).(1) = upy;
set rotmat.(1).(2) = -.fy;
set rotmat.(2).(0) = rz;
set rotmat.(2).(1) = upz;
set rotmat.(2).(2) = -.fz;
let rotmat.(0).(0) +. rotmat.(1).(1) +. rotmat.(2).(2) -> trace in
let acos ((trace -. 1.0) *. 0.5) -> angle in
let [((rotmat.(2).(1) -. rotmat.(1).(2)) *. 0.5) ((rotmat.(0).(2) -. rotmat.(2).(0)) *. 0.5) ((rotmat.(1).(0) -. rotmat.(0).(1)) *. 0.5)] -> rotaxis in
SO3MathsQuatFromAngleAxis angle rotaxis;
);;
/* ********************************************************************************************* /
Date
/ ********************************************************************************************* */
/*! @ingroup toolsdate
* \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 toolsdate
* \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 toolsdate
* \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)=
let (year * 365 * 3600 * 24) - (1970 * 365 * 3600 * 24) -> years in
let
let 0 -> nbsec in
(
let 1 -> i in
while i < month do
(
set nbsec = nbsec + ((getMonthDays i year) * 3600 * 24);
set i = i + 1;
);
nbsec;
)
-> months in
let day * 3600 * 24 -> days in
let hours * 3600 -> hours in
let minutes * 60 -> minutes in
years + months + days + hours + minutes;;
/*! @ingroup toolsdate
* \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 toolsdate
* \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 toolsdate
* \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]
;;
/* ********************************************************************************************* /
CSV parser / writer
/ ********************************************************************************************* */
fun cbCSVstrip(s)=
stripChar s 34;;
/*! @ingroup csvtools
* \brief Write CSV format in string
*
* Prototype: fun [S [S r1] [[S r1] r1]] S
*
* \param S : separator
* \param [S r1] : list of column titles
* \param [[S r1] r1] : list of lines values
*
* \return S: formated string
**/
fun formatCSV(sep, ltitles, llinevalues)=
let if (sep == nil) then ";" else sep -> sep in
let "" -> out in
(
while (ltitles != nil) do
(
let hd ltitles -> title in
set out = strcatn out::title::sep::nil;
set ltitles = tl ltitles;
if (ltitles != nil) then nil else
set out = strcat out "\n";
);
while (llinevalues != nil) do
(
let hd llinevalues -> lvalues in
while (lvalues != nil) do
(
let hd lvalues -> val in
let if ((sizelist lineextr val) > 1) then (ctoa 34) else "" -> protect in
set out = strcatn out::protect::(addChar val 34 34)::protect::sep::nil;
set lvalues = tl lvalues;
if (lvalues != nil) then nil else
set out = strcat out "\n";
);
set llinevalues = tl llinevalues;
);
out;
);;
/*! @ingroup csvtools
* \brief Write CSV format in file
*
* Prototype: fun [S [S r1] [[S r1] r1]] S
*
* \param S : filepath
* \param S : separator
* \param [S r1] : list of column titles
* \param [[S r1] r1] : list of lines values
*
* \return 0
**/
fun writeCSV(filepath, sep, ltitles, llinevalues)=
let if (sep == nil) then ";" else sep -> sep in
let formatCSV sep ltitles llinevalues -> out in
_storepack out filepath;
0;;
/*! @ingroup csvtools
* \brief read CSV data with titles
*
* Prototype: fun [S S] [[S r1] [[S r1] r1]]
*
* \param S : data
* \param S : separator
*
* \return [[S r1] [[S r1] r1]] : list of title and list of values
**/
fun readCSVdataWithTitle(data, sep)=
let if (sep == nil) then ";" else sep -> sep in
let strToQuotedList data 34 -> ldata in
let nil -> ltitles in
let nil -> llinevalues in
(
let (hd ldata) -> titles in
set ltitles = strToListSepCb titles sep @cbCSVstrip;
set ldata = tl ldata;
while (ldata != nil) do
(
let hd ldata -> line in
let strToListSepCb line sep @cbCSVstrip -> lvalues in
set llinevalues = lvalues::llinevalues;
set ldata = tl ldata;
);
[ltitles (revertlist llinevalues)];
);;
/*! @ingroup csvtools
* \brief read CSV data
*
* Prototype: fun [S S] [[S r1] r1]
*
* \param S : data
* \param S : separator
*
* \return [[S r1] r1] : list of values
**/
fun readCSVdata(data, sep)=
let if (sep == nil) then ";" else sep -> sep in
let strToQuotedList data 34 -> ldata in
let nil -> llinevalues in
(
while (ldata != nil) do
(
let hd ldata -> line in
let strToListSepCb line sep @cbCSVstrip -> lvalues in
set llinevalues = lvalues::llinevalues;
set ldata = tl ldata;
);
revertlist llinevalues;
);;
/*! @ingroup csvtools
* \brief CSV data to array
*
* Prototype: fun [S S] [tab tab S]
*
* \param S : data
* \param S : separator
*
* \return [tab tab S] : array with datas
**/
fun readCSVdataToTab(data, sep)=
let if (sep == nil) then ";" else sep -> sep in
let strToQuotedList data 34 -> ldata in
let sizelist ldata -> nbrows in
let sizelist strToListSep (hd ldata) sep -> nbcols in
let mktab nbrows nil -> outtab in
(
let 0 -> t in
while (t < nbrows) do
(
set outtab.(t) = mktab nbcols "";
set t = t + 1;
);
let 0 -> i in
while (ldata != nil) do
(
let hd ldata -> line in
let strToListSepCb line sep @cbCSVstrip -> lvalues in
let outtab.(i) -> tval in
let 0 -> j in
while (lvalues != nil) do
(
if (j >= nbcols) then nil else
let hd lvalues -> value in
set tval.(j) = value;
set j = j + 1;
set lvalues = tl lvalues;
);
set ldata = tl ldata;
set i = i + 1;
);
outtab;
);;
/*! @ingroup csvtools
* \brief CSV data to array sized
*
* Prototype: fun [S S I I] [tab tab S]
*
* \param S : data
* \param S : separator
* \param I : Nb rows in tab
* \param I : Nb cols in tab
*
* \return [tab tab S] : array with datas
**/
fun readCSVdataToTabSized(data, sep, rows, cols)=
let if (sep == nil) then ";" else sep -> sep in
let strToQuotedList data 34 -> ldata in
let mktab rows nil -> outtab in
(
let 0 -> t in
while (t < rows) do
(
set outtab.(t) = mktab cols "";
set t = t + 1;
);
let 0 -> i in
while (ldata != nil) do
(
if (i >= rows) then nil else
(
let hd ldata -> line in
let strToListSepCb line sep @cbCSVstrip -> lvalues in
let outtab.(i) -> tval in
let 0 -> j in
while (lvalues != nil) do
(
if (j >= cols) then nil else
let hd lvalues -> value in
set tval.(j) = value;
set j = j + 1;
set lvalues = tl lvalues;
);
);
set ldata = tl ldata;
set i = i + 1;
);
outtab;
);;
/*! @ingroup csvtools
* \brief CSV tab to list
*
* Prototype: fun [[tab tab S] I I] [[S r1] r1]
*
* \param [tab tab S] : data in tab
* \param I : Nb rows
* \param I : Nb cols
*
* \return [[S r1] r1] : list of values
**/
fun readCSVTabToData(tdata, rows, cols)=
let nil -> out in
(
let 0 -> i in
while (i < rows) do
(
let tdata.(i) -> tval in
let 0 -> j in
let nil -> lines in
(
while (j < cols) do
(
let tval.(j) -> value in
set lines = value::lines;
set j = j + 1;
);
set out = (revertlist lines)::out;
);
set i = i + 1;
);
revertlist out;
);;
/*! @ingroup csvtools
* \brief CSV data to a single array row sized
*
* Prototype: fun [S S I [tab tab S] I I] [tab tab S]
*
* \param S : data
* \param S : separator
* \param I : row id
* \param [tab tab S] : input tab
* \param I : Nb rows in tab
* \param I : Nb cols in tab
*
* \return [tab tab S] : array with datas
**/
fun readCSVdataToTabRow(data, sep, rowid, srctab, rows, cols)=
let if (sep == nil) then ";" else sep -> sep in
let strToQuotedList data 34 -> ldata in
(
let rowid -> i in
while (ldata != nil) do
(
if (i >= rows) then nil else
(
let hd ldata -> line in
let strToListSepCb line sep @cbCSVstrip -> lvalues in
let srctab.(i) -> tval in
let 0 -> j in
while (lvalues != nil) do
(
if (j >= cols) then nil else
let hd lvalues -> value in
set tval.(j) = value;
set j = j + 1;
set lvalues = tl lvalues;
);
);
set ldata = tl ldata;
set i = i + 1;
);
srctab;
);;
/*! @ingroup csvtools
* \brief CSV data to a single array column sized
*
* Prototype: fun [S S I [tab tab S] I I] [tab tab S]
*
* \param S : data
* \param S : separator
* \param I : column id
* \param [tab tab S] : input tab
* \param I : Nb rows in tab
* \param I : Nb cols in tab
*
* \return [tab tab S] : array with datas
**/
fun readCSVdataToTabColumn(data, sep, colid, srctab, rows, cols)=
let if (sep == nil) then ";" else sep -> sep in
let strToQuotedList data 34 -> ldata in
(
let colid -> i in
while (ldata != nil) do
(
if (i >= cols) then nil else
(
let hd ldata -> line in
let strToListSepCb line sep @cbCSVstrip -> lvalues in
let 0 -> j in
while (lvalues != nil) do
(
if (j >= rows) then nil else
let srctab.(j) -> tval in
let hd lvalues -> value in
set tval.(i) = value;
set j = j + 1;
set lvalues = tl lvalues;
);
);
set ldata = tl ldata;
set i = i + 1;
);
srctab;
);;