fivedev/harbour-core
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

2001-05-12 18:30 GMT+0200 Martin Vogel <vogel@inttec.de>

Browse Source
This commit is contained in:
Martin Vogel
2001-05-12 16:29:33 +00:00
parent 0a4e3d34ff
commit b1cf172910
23 changed files with 2338 additions and 116 deletions
Download Patch File Download Diff File Expand all files Collapse all files

73
harbour/ChangeLog
View File

@@ -1,3 +1,76 @@
2001-05-12 18:30 GMT+0200 Martin Vogel <vogel@inttec.de>
+ contrib/libct/charmix.c
- contrib/libct/ctchrmix.c
! ctchrmix.c replaced by charmix.c
+ contrib/libct/charone.c
! CHARONE() function
! WORDONE() function
+ contrib/libct/charonly.c
! CHARONLY() function
! WORDONLY() function
! CHARREM() function
! WORDREM() function !New function!
+ contrib/libct/charsort.c
! CHARSORT() function
+ contrib/libct/charswap.c
! CHARSWAP() function
! WORDSWAP() function
* contrib/libct/Makefile
* added charmix.c, removed ctchrmix.c
+ added charone.c
+ added charonly.c
+ added charsort.c
+ added charswap.c
* contrib/libct/makefile.bc
* added charmix.c, removed ctchrmix.c
+ added charone.c
+ added charonly.c
+ added charsort.c
+ added charswap.c
* contrib/libct/makefile.vc
* added charmix.c, removed ctchrmix.c
+ added charone.c
+ added charonly.c
+ added charsort.c
+ added charswap.c
* contrib/libct/readme.txt
! enhancement list updated !
* contrib/libct/ctflist.txt
! function status list updated !
+ contrib/libct/tests/charmix.prg
+ contrib/libct/tests/charone.prg
+ contrib/libct/tests/charonly.prg
+ contrib/libct/tests/charrem.prg
+ contrib/libct/tests/charsort.prg
+ contrib/libct/tests/charswap.prg
+ contrib/libct/tests/wordone.prg
+ contrib/libct/tests/wordonly.prg
+ contrib/libct/tests/wordrem.prg
+ contrib/libct/tests/wordswap.prg
* contrib/libct/tests/Makefile
+ added charmix.prg
+ added charone.prg
+ added charonly.prg
+ added charrem.prg
+ added charsort.prg
+ added charswap.prg
+ added wordone.prg
+ added wordonly.prg
+ added wordrem.prg
+ added wordswap.prg
2001-05-11 14:15 UTC-0800 Ron Pinkas <ron@profit-master.com>
* include/hbclass.ch
+ Added syntax declaration support for METHOD ... OPERATOR ...

85
harbour/contrib/libct/Makefile
View File

@@ -4,31 +4,70 @@
ROOT = ../../
C_SOURCES=\
addascii.c \
asciisum.c \
ascpos.c \
atadjust.c \
atnum.c \
atrepl.c \
charevod.c \
charlist.c \
charmirr.c \
charop.c \
charrepl.c \
ctset.c \
ctstr.c \
ctchksum.c \
ctchrmix.c \
ctcolton.c \
ctcrypt.c \
ctposupp.c \
token1.c \
wordrepl.c \
C_SOURCES = \
addascii.c \
asciisum.c \
ascpos.c \
atadjust.c \
atnum.c \
atrepl.c \
charevod.c \
charlist.c \
charmirr.c \
charmix.c \
charone.c \
charonly.c \
charop.c \
charrepl.c \
charsort.c \
charswap.c \
ctset.c \
ctstr.c \
ctchksum.c \
ctcolton.c \
ctcrypt.c \
ctposupp.c \
token1.c \
wordrepl.c \
PRG_SOURCES=\
ctmisc.prg \
PRG_SOURCES= \
ctmisc.prg \
LIBNAME=ct3
include $(TOP)$(ROOT)config/lib.cf

146
harbour/contrib/libct/charmix.c Normal file
View File

@@ -0,0 +1,146 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* CHARMIX() CT3 function
*
* Initial code: Copyright 1999 Victor Szakats <info@szelvesz.hu>
*
* CT3 conformity: Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany
* Author: Martin Vogel <vogel@inttec.de>
*
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version, with one exception:
*
* The exception is that if you link the Harbour Runtime Library (HRL)
* and/or the Harbour Virtual Machine (HVM) with other files to produce
* an executable, this does not by itself cause the resulting executable
* to be covered by the GNU General Public License. Your use of that
* executable is in no way restricted on account of linking the HRL
* and/or HVM code into it.
*
* 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 General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit
* their web site at http://www.gnu.org/).
*
*/
#include "ct.h"
/* $DOC$
* $FUNCNAME$
* CHARMIX()
* $CATEGORY$
* CT3 string functions
* $ONELINER$
* Mix two strings
* $SYNTAX$
* CHARMIX (<cString1>[, <cString2>]) --> cMixedString
* $ARGUMENTS$
* <cString1> String that will be mixed with the characters from <cString2>
* [<cString2>] String whose characters will be mixed with the one from
* <cString1>.
* Default: " " (string with one space char)
* $RETURNS$
* <cMixedString> Mixed string
* $DESCRIPTION$
* The CHARMIX() function mixes the strings <cString1> and <cString2>. To
* do this it takes one character after the other alternatively from
* <cString1> and <cString2> and puts them in the output string.
* This procedure is stopped when the end of <cString1> is reached. If
* <cString2> is shorter than <cString1>, the function will start at
* the begin of <cString2> again. If on the other hand <cString2> is
* longer than <cString1>, the surplus characters will be omitted.
* $EXAMPLES$
* ? CHARMIX("ABC", "123") // "A1B2C3"
* ? CHARMIX("ABCDE", "12") // "A1B2C1D2E1"
* ? CHARMIX("AB", "12345") // "A1B2"
* ? CHARMIX("HELLO", " ") // "H E L L O "
* ? CHARMIX("HELLO", "") // "HELLO"
* $TESTS$
* CHARMIX("ABC", "123") == "A1B2C3"
* CHARMIX("ABCDE", "12") == "A1B2C1D2E1"
* CHARMIX("AB", "12345") == "A1B2"
* CHARMIX("HELLO", " ") == "H E L L O "
* CHARMIX("HELLO", "") == "HELLO"
* $STATUS$
* Ready
* $COMPLIANCE$
* CHARMIX() is compatible with CT3's CHARMIX().
* NOTE: CA-Tools version of CHARMIX() will hang
* if the second parameter is an empty string, this version will not.
* $PLATFORMS$
* All
* $FILES$
* Source is charmix.c, library is ct3.
* $SEEALSO$
* CHAREVEN() CHARODD()
* $END$
*/
HB_FUNC (CHARMIX)
{
if (ISCHAR (1))
{
char *pcString1 = hb_parc (1);
char *pcString2, *pcResult;
size_t sLen1 = hb_parclen (1);
size_t sLen2, sPos1, sPos2, sResultPos;
if (sLen1 == 0)
{
hb_retc ("");
return;
}
if (ISCHAR (2))
{
pcString2 = hb_parc (2);
sLen2 = hb_parclen (2);
if (sLen2 == 0)
{
hb_retclen (pcString1, sLen1);
return;
}
}
else
{
pcString2 = " "; /* NOTE: The original CT3 uses " " as 2nd string
if the 2nd param is not a string ! */
sLen2 = 1;
}
pcResult = hb_xgrab (sLen1 * 2);
sPos2 = sResultPos = 0;
for (sPos1 = 0; sPos1 < sLen1;)
{
pcResult[sResultPos++] = pcString1[sPos1++];
pcResult[sResultPos++] = pcString2[sPos2++];
sPos2 %= sLen2;
}
hb_retclen (pcResult, sLen1 * 2);
hb_xfree (pcResult);
}
else
{
hb_retc ("");
}
}

344
harbour/contrib/libct/charone.c Normal file
View File

@@ -0,0 +1,344 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* CT3 string functions
* - CHARONE()
* - WORDONE()
*
* Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany
* Author: Martin Vogel <vogel@inttec.de>
*
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, 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 General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries with other
* files to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for Harbour, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*
*/
#include "ct.h"
/* defines */
#define DO_CHARONE_CHARONE 0
#define DO_CHARONE_WORDONE 1
/* helper function for the *one functions */
static void do_charone (int iSwitch)
{
char *pcString;
size_t sStrLen;
char *pcDeleteSet;
size_t sDeleteSetLen;
/* param check */
if (ISCHAR (1))
{
if (ISCHAR (2))
{
pcString = hb_parc (2);
sStrLen = (size_t)hb_parclen (2);
pcDeleteSet = hb_parc (1);
sDeleteSetLen = (size_t)hb_parclen (1);
}
else
{
pcString = hb_parc (1);
sStrLen = (size_t)hb_parclen (1);
pcDeleteSet = NULL;
sDeleteSetLen = 0;
}
switch (iSwitch)
{
case DO_CHARONE_CHARONE:
{
if (sStrLen > 1)
{
char *pcSub;
char *pcRet;
size_t sRetStrLen = 0;
char cCurrent = *pcString;
int iDoDelete = 1;
pcRet = hb_xgrab (sStrLen);
/* copy first char */
*(pcRet+sRetStrLen) = cCurrent;
sRetStrLen++;
for (pcSub = pcString+1; pcSub<pcString+sStrLen; pcSub++)
{
if (*pcSub != cCurrent)
{
char *pc;
/* "new" character */
cCurrent = *pcSub;
*(pcRet+sRetStrLen) = cCurrent;
sRetStrLen++;
/* check if it should be deleted */
if (pcDeleteSet == NULL)
{
iDoDelete = 1;
}
else
{
pc = ct_at_exact_forward (pcDeleteSet, sDeleteSetLen,
pcSub, 1, NULL);
if (pc != NULL)
iDoDelete = 1;
else
iDoDelete = 0;
}
}
else
{
if (!iDoDelete)
{
*(pcRet+sRetStrLen) = cCurrent;
sRetStrLen++;
}
}
}
hb_retclen (pcRet, sRetStrLen);
hb_xfree (pcRet);
}
else /* if (sStrLen > 1) */
{
/* algorithm does nothing to 1-char-strings */
hb_retclen (pcString, sStrLen);
}
}; break;
case DO_CHARONE_WORDONE:
{
if (sStrLen > 3)
{
char *pcSub;
char *pcRet;
size_t sRetStrLen = 0;
char cCurrent1 = *pcString;
char cCurrent2 = *(pcString+1);
int iDoDelete = 1;
pcRet = hb_xgrab (sStrLen);
/* copy first double char */
*(pcRet+sRetStrLen) = cCurrent1;
*(pcRet+sRetStrLen+1) = cCurrent2;
sRetStrLen += 2;
for (pcSub = pcString+2; pcSub<(pcString+sStrLen-1); pcSub+=2)
{
if (!((*pcSub == cCurrent1) && (*(pcSub+1) == cCurrent2)))
{
char *pc;
/* "new" character */
cCurrent1 = *pcSub;
cCurrent2 = *(pcSub+1);
*(pcRet+sRetStrLen) = cCurrent1;
*(pcRet+sRetStrLen+1) = cCurrent2;
sRetStrLen += 2;
/* check if it should be deleted */
if (pcDeleteSet == NULL)
{
iDoDelete = 1;
}
else
{
pc = ct_at_exact_forward (pcDeleteSet, sDeleteSetLen,
pcSub, 2, NULL);
if ((pc != NULL) && (((pc-pcDeleteSet)%2) == 0))
iDoDelete = 1;
else
iDoDelete = 0;
}
}
else
{
if (!iDoDelete)
{
*(pcRet+sRetStrLen) = cCurrent1;
*(pcRet+sRetStrLen+1) = cCurrent2;
sRetStrLen += 2;
}
}
}
/* copy last character if string len is odd */
if (sStrLen%2==1)
{
*(pcRet+sRetStrLen) = *(pcString+sStrLen-1);
sRetStrLen++;
}
hb_retclen (pcRet, sRetStrLen);
hb_xfree (pcRet);
}
else /* if (sStrLen > 3) */
{
/* algorithm does nothing to 3-char-strings */
hb_retclen (pcString, sStrLen);
}
}; break;
} /* switch (iSwitch) */
}
else /* if (ISCHAR (1)) */
{
hb_retc ("");
}
return;
}
/* $DOC$
* $FUNCNAME$
* CHARONE()
* $CATEGORY$
* CT3 string functions
* $ONELINER$
* Reduce multiple occurences of a character to one
* $SYNTAX$
* CHARONE ([<cCharactersToReduce>,] <cString>) -> cReducedString
* $ARGUMENTS$
* [<cCharactersToReduce>] specifies the characters the multiple
* occurences of which should be reduced to one
* Default: All characters.
* <cString> specifies the processed string
* $RETURNS$
* <cReducedString> the string with the reduced occurences
* $DESCRIPTION$
* The CHARONE() function reduces multiple occurences of characters in
* <cString> to a single one. It is important to note that the multiple
* occurences must occur directly one behind the other. This behaviour is
* is in contrast to the CHARLIST() function.
* $EXAMPLES$
* ? CHARONE("122333a123") // "123a123"
* ? CHARONE("A B CCCD") // "A B CD"
* ? CHARONE(" ", "A B A B") // "A B A B"
* ? CHARONE("o", "122oooB12o") // "122oB12o"
* $TESTS$
* CHARONE("122333a123") == "123a123"
* CHARONE("A B CCCD") == "A B CD"
* CHARONE(" ", "A B A B") == "A B A B"
* CHARONE("o", "122oooB12o") == "122oB12o"
* $STATUS$
* Ready
* $COMPLIANCE$
* CHARONE() is compatible with CT3's CHARONE().
* $PLATFORMS$
* All
* $FILES$
* Source is charone.c, library is ct3.
* $SEEALSO$
* CHARREM() WORDONE()
* $END$
*/
HB_FUNC (CHARONE)
{
do_charone (DO_CHARONE_CHARONE);
return;
}
/* $DOC$
* $FUNCNAME$
* WORDONE()
* $CATEGORY$
* CT3 string functions
* $ONELINER$
* Reduce multiple occurences of a double character to one
* $SYNTAX$
* WORDONE ([<cDoubleCharactersToReduce>,] <cString>) -> cReducedString
* $ARGUMENTS$
* [<cDoubleCharactersToReduce>] specifies the double characters the multiple
* occurences of which should be reduced to one
* Default: All characters.
* <cString> specifies the processed string
* $RETURNS$
* <cReducedString> the string with the reduced occurences
* $DESCRIPTION$
* The WORDONE() function reduces multiple occurences of double characters in
* <cString> to a single one. It is important to note that the multiple
* occurences must occur directly one behind the other.
* $EXAMPLES$
* ? WORDONE("12ABAB12") // "12AB12"
* ? WORDONE("1AAAA2") // "1AAAA2"
* ? WORDONE("12", "1212ABAB") // "12ABAB"
* $TESTS$
* WORDONE("12ABAB12") == "12AB12"
* WORDONE("1AAAA2") == "1AAAA2"
* WORDONE("12", "1212ABAB") == "12ABAB"
* $STATUS$
* Ready
* $COMPLIANCE$
* WORDONE() is compatible with CT3's WORDONE().
* $PLATFORMS$
* All
* $FILES$
* Source is charone.c, library is ct3.
* $SEEALSO$
* CHARONE() CHARREM()
* $END$
*/
HB_FUNC (WORDONE)
{
do_charone (DO_CHARONE_WORDONE);
return;
}

320
harbour/contrib/libct/charonly.c Normal file
View File

@@ -0,0 +1,320 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* CT3 string functions
* - CHARONLY()
* - CHARREM()
* - WORDONLY()
* - WORDREM()
*
* Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany
* Author: Martin Vogel <vogel@inttec.de>
*
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, 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 General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries with other
* files to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for Harbour, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*
*/
#include "ct.h"
/* defines */
#define DO_CHARONLY_CHARONLY 0
#define DO_CHARONLY_WORDONLY 1
#define DO_CHARONLY_CHARREM 2
#define DO_CHARONLY_WORDREM 3
/* helper function for the *one functions */
static void do_charonly (int iSwitch)
{
/* param check */
if (ISCHAR (1) && ISCHAR (2))
{
char *pcString = hb_parc (2);
size_t sStrLen = (size_t)hb_parclen (2);
char *pcOnlySet = hb_parc (1);
size_t sOnlySetLen = (size_t)hb_parclen (1);
char *pcRet;
size_t sRetStrLen = 0;
int iShift, iBool;
char *pcSub, *pc;
if ((iSwitch == DO_CHARONLY_WORDONLY) || (iSwitch == DO_CHARONLY_WORDREM))
{
iShift = 2;
}
else
{
iShift = 1;
}
pcRet = hb_xgrab (sStrLen);
for (pcSub = pcString; pcSub < pcString+sStrLen+1-iShift; pcSub += iShift)
{
pc = ct_at_exact_forward (pcOnlySet, sOnlySetLen,
pcSub, iShift, NULL);
iBool = ((pc != NULL) && (((pc-pcOnlySet)%iShift) == 0));
if ((iBool && ((iSwitch == DO_CHARONLY_CHARONLY) || (iSwitch == DO_CHARONLY_WORDONLY))) ||
(!iBool && ((iSwitch == DO_CHARONLY_CHARREM) || (iSwitch == DO_CHARONLY_WORDREM))))
{
for (pc = pcSub; pc < pcSub+iShift; pc++)
{
pcRet[sRetStrLen++] = *pc;
}
}
}
/* copy last character if string len is odd */
if ((iShift == 2) && (sStrLen%2==1))
{
pcRet[sRetStrLen++] = pcString[sStrLen-1];
}
hb_retclen (pcRet, sRetStrLen);
hb_xfree (pcRet);
}
else /* if (ISCHAR (1) && ISCHAR (2)) */
{
hb_retc ("");
}
return;
}
/* $DOC$
* $FUNCNAME$
* CHARONLY()
* $CATEGORY$
* CT3 string functions
* $ONELINER$
* Intersectional set of two strings based on characters
* $SYNTAX$
* CHARONLY (<cThisCharactersOnly>, <cString>) -> cReducedString
* $ARGUMENTS$
* <cThisCharactersOnly> specifies the characters that must not be
* deleted in <cString>.
* <cString> is the string that should be processed
* $RETURNS$
* <cReducedString> A string with all characters deleted but those
* specified in <cThisCharactersOnly>.
* $DESCRIPTION$
* The CHARONLY() function calculates the intersectional set of two
* strings. To do this, it deletes all characters from <cString> that
* do not appear in <cThisCharacterOnly>.
* $EXAMPLES$
* ? CHARONLY("0123456789", "0211 - 38 99 77") // "0211389977"
* ? CHARONLY("0123456789", "0211/ 389 977") // "0211389977"
* $TESTS$
* CHARONLY("0123456789", "0211 - 38 99 77") == "0211389977"
* CHARONLY("0123456789", "0211/ 389 977") == "0211389977"
* $STATUS$
* Ready
* $COMPLIANCE$
* CHARONLY() is compatible with CT3's CHARONLY().
* $PLATFORMS$
* All
* $FILES$
* Source is charonly.c, library is ct3.
* $SEEALSO$
* CHARREM() WORDONLY() WORDREM()
* $END$
*/
HB_FUNC (CHARONLY)
{
do_charonly (DO_CHARONLY_CHARONLY);
return;
}
/* $DOC$
* $FUNCNAME$
* WORDONLY()
* $CATEGORY$
* CT3 string functions
* $ONELINER$
* Intersectional set of two strings based on double characters
* $SYNTAX$
* WORDONLY (<cThisDoubleCharactersOnly>, <cString>) -> cReducedString
* $ARGUMENTS$
* <cThisDoubleCharactersOnly> specifies the double characters that must
* not be deleted in <cString>.
* <cString> is the string that should be processed
* $RETURNS$
* <cReducedString> A string with all double characters deleted
* but those specified in <cThisCharactersOnly>.
* $DESCRIPTION$
* The WORDONLY() function calculates the intersectional set of two
* strings based on double characters. To do this, it deletes all double
* characters from <cString> that do not appear in <cThisDoubleCharacterOnly>.
* $EXAMPLES$
* ? WORDONLY("AABBCCDD", "XXAAYYBBZZ") // "AABB"
* ? WORDONLY("AABBCCDD", "XAAYYYBBZZ") // "BB"
* $TESTS$
* WORDONLY("AABBCCDD", "XXAAYYBBZZ") == "AABB"
* WORDONLY("AABBCCDD", "XAAYYYBBZZ") == "BB"
* $STATUS$
* Ready
* $COMPLIANCE$
* WORDONLY() is compatible with CT3's WORDONLY().
* $PLATFORMS$
* All
* $FILES$
* Source is charonly.c, library is ct3.
* $SEEALSO$
* CHARONLY() CHARREM() WORDREM()
* $END$
*/
HB_FUNC (WORDONLY)
{
do_charonly (DO_CHARONLY_WORDONLY);
return;
}
/* $DOC$
* $FUNCNAME$
* CHARREM()
* $CATEGORY$
* CT3 string functions
* $ONELINER$
* Removes characters from a string
* $SYNTAX$
* CHARREM (<cDeleteThisCharacters>, <cString>) -> cReducedString
* $ARGUMENTS$
* <cDeleteThisCharacters> specifies the characters that should
* be deleted in <cString>
* <cString>) is the string that should be processed
* $RETURNS$
* <cReducedString> is a string where the characters specified
* in <cDeleteThisCharacters> are deleted
* $DESCRIPTION$
* The CHARREM() function deletes the characters specified in
* <cDeleteThisCharacters> from <cString>.
* $EXAMPLES$
* ? CHARREM(" ", " 1 2 ") // "12"
* ? CHARREM("3y", "xyz123") // "xz12"
* $TESTS$
* CHARREM(" ", " 1 2 ") == "12"
* CHARREM("3y", "xyz123") == "xz12"
* $STATUS$
* Ready
* $COMPLIANCE$
* CHARREM() is compatible with CT3's CHARREM().
* $PLATFORMS$
* All
* $FILES$
* Source is charonly.c, library is ct3.
* $SEEALSO$
* CHARONLY() WORDONLY() WORDREM()
* $END$
*/
HB_FUNC (CHARREM)
{
do_charonly (DO_CHARONLY_CHARREM);
return;
}
/* $DOC$
* $FUNCNAME$
* WORDREM()
* $CATEGORY$
* CT3 string functions
* $ONELINER$
* Removes characters from a string
* $SYNTAX$
* WORDREM (<cDeleteThisDoubleCharacters>, <cString>) -> cReducedString
* $ARGUMENTS$
* <cDeleteThisDoubleCharacters> specifies the double characters that
* should be deleted in <cString>
* <cString>) is the string that should be processed
* $RETURNS$
* <cReducedString> is a string where the double characters
* specified in <cDeleteThisDoubleCharacters>
* are deleted
* $DESCRIPTION$
* The WORDREM() function deletes the double characters specified in
* <cDeleteThisDoubleCharacters> from <cString>.
* $EXAMPLES$
* ? WORDREM("abcd", "0ab1cd") // "0ab1"
* ? WORDREM("abcd", "ab0cd1") // "0cd1"
* $TESTS$
* WORDREM("abcd", "0ab1cd") == "0ab1"
* WORDREM("abcd", "ab0cd1") == "0cd1"
* $STATUS$
* Ready
* $COMPLIANCE$
* WORDREM() is a new function available only in Harbour's CT3.
* $PLATFORMS$
* All
* $FILES$
* Source is charonly.c, library is ct3.
* $SEEALSO$
* CHARONLY CHARREM() WORDREM()
* $END$
*/
HB_FUNC (WORDREM)
{
do_charonly (DO_CHARONLY_WORDREM);
return;
}

252
harbour/contrib/libct/charsort.c Normal file
View File

@@ -0,0 +1,252 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* CHARSORT() CT3 string functions
*
* Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany
* Author: Martin Vogel <vogel@inttec.de>
*
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, 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 General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries with other
* files to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for Harbour, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*
*/
#include "ct.h"
/* statics */
static size_t ssCompareLen; /* TODO: make this thread safe */
static size_t ssElementPos; /* TODO: make this thread safe */
static int siDescend; /* TODO: make this thread safe */
/* qsort function */
static int do_charsort (const void *p1, const void *p2)
{
char *pc1 = (char *)p1;
char *pc2 = (char *)p2;
int iCmp;
pc1 += ssElementPos;
pc2 += ssElementPos;
iCmp = strncmp (pc1, pc2, ssCompareLen);
iCmp *= (siDescend ? -1 : 1);
return (iCmp);
}
/* $DOC$
* $FUNCNAME$
* CHARSORT()
* $CATEGORY$
* CT3 string functions
* $ONELINER$
* Sort sequences within a string.
* $SYNTAX$
* CHARSORT (<[@]cString>, [<nElementLength>], [<nCompareLength>],
* [<nIgnoreCharacters>], [<nElemenOffset>], [<nSortLength>],
* [<lDescending>]) -> cSortedString
* $ARGUMENTS$
* <[@]cString> is the string that should be processed
* [<nElementLength>] specifies the length of the elements that
* should be sorted
* Default: 1
* [<nCompareLength>] specifies how many characters within one
* element should be used for comparison
* Default: <nElementLength>
* [<nIgnoreCharacters>] specifies the number of characters at the
* beginning of <cString> that should be ignored
* in the sort process
* Default: 0
* [<nElementOffset>] specifies the offset of the comparison string
* within a element
* Default: 0
* [<nSortLength>] specifies how many characters in <cString>,
* starting from the <nIgnoreCharacters> position,
* should be sorted
* Default: len(cString)-nIgnoreCharacters
* [<lDescending>]) specifies whether the process should
* sort descending or not
* $RETURNS$
* <cSortedString> the string resulting from the sort process
* $DESCRIPTION$
* The CHARSORT function sorts the characters within a string <cString>.
* With the parameters <nIgnoreCharacters> and <nSortLength>, you can
* determine that only the substring from position <nIgnoreCharacters>+1
* to position <nIgnoreCharacters>+<nSortLength> within <cString> should
* be sorted.
* The sorting algorithm is determined with the other parameters.
* <nElementLength> specifies the length of one element, i.e. there are
* <nSortLength>/<nElementLength> elements that are sorted. Note that
* surplus characters are not sorted but stay at their position.
* To do the sorting, the function uses the Quicksort algorithm implemented
* in the C-lib qsort() function. This algorithm needs to know how to compare
* and order two elements. This is done by comparing the ASCII values of
* a substring within each element. This substring is determined by the
* parameters <nElementOffset> and <nCompareLength> and the order
* by <lDescending>.
* By setting the CSETREF() switch to .T., one can omit the return value
* of the function, but one must then pass <cString> by reference.
* $EXAMPLES$
* ? CHARSORT("qwert") // "eqrtw"
* ? CHARSORT("qwert", 2) // "erqwt"
* ? CHARSORT("b1a4a3a2a1", 2, 1) // "a2a1a3a4b1"
* ? CHARSORT("XXXqwert", 1, 1, 3) // "XXXeqrtw"
* ? CHARSORT("b1a4a3a2a1", 2, 1, 0, 1) // "a1b1a2a3a4"
* ? CHARSORT("384172852", 1, 1, 0, 0, 4) // "134872852"
* ? CHARSORT("qwert", .T.) // "wtrqe"
* $TESTS$
* CHARSORT("qwert") == "eqrtw"
* CHARSORT("qwert", 2) == "erqwt"
* CHARSORT("b1a4a3a2a1", 2, 1) == "a2a1a3a4b1"
* CHARSORT("XXXqwert", 1, 1, 3) == "XXXeqrtw"
* CHARSORT("b1a4a3a2a1", 2, 1, 0, 1) == "a1b1a2a3a4"
* CHARSORT("384172852", 1, 1, 0, 0, 4) == "134872852"
* CHARSORT("qwert", .T.) == "wtrqe"
* $STATUS$
* Ready
* $COMPLIANCE$
* CHARSORT() is compatible with CT3's CHARSORT().
* $PLATFORMS$
* All
* $FILES$
* Source is charsort.c, library is ct3.
* $SEEALSO$
* CSETREF()
* $END$
*/
HB_FUNC (CHARSORT)
{
int iNoRet;
/* suppressing return value ? */
iNoRet = ct_getref();
/* param check I */
if (ISCHAR (1))
{
/* get parameters */
char *pcString = hb_parc (1);
char *pcRet;
size_t sStrLen = (size_t)hb_parclen (1);
size_t sElementLen, sIgnore, sSortLen;
if (ISNUM (2))
sElementLen = hb_parnl (2);
else
sElementLen = 1;
if (ISNUM (3))
ssCompareLen = hb_parnl (3);
else
ssCompareLen = sElementLen;
if (ISNUM (4))
sIgnore = hb_parnl (4);
else
sIgnore = 0;
if (ISNUM (5))
ssElementPos = hb_parnl (5);
else
ssElementPos = 0;
if (ISNUM (6))
sSortLen = hb_parnl (6);
else
sSortLen = sStrLen-sIgnore;
if (ISLOG (7))
siDescend = hb_parl (7);
else
siDescend = 0;
/* param check II */
if ((sElementLen == 0) ||
(ssCompareLen > sElementLen) ||
(sIgnore+sElementLen > sStrLen) ||
((ssElementPos+ssCompareLen) > sElementLen) ||
(sSortLen+sIgnore > sStrLen))
{
if (iNoRet)
hb_retl (0);
else
hb_retc ("");
return;
}
pcRet = hb_xgrab (sStrLen);
hb_xmemcpy (pcRet, pcString, sStrLen);
qsort (pcRet+sIgnore, (sSortLen/sElementLen), sElementLen, do_charsort);
/* return string */
if (ISBYREF (1))
hb_storclen (pcRet, sStrLen, 1);
if (iNoRet)
hb_retl (0);
else
hb_retclen (pcRet, sStrLen);
hb_xfree (pcRet);
}
else /* if (ISCHAR (1)) */
{
if (iNoRet)
hb_retl (0);
else
hb_retc ("");
}
}

282
harbour/contrib/libct/charswap.c Normal file
View File

@@ -0,0 +1,282 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* CT3 string functions
* - CHARSWAP()
* - WORDSWAP()
*
* Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany
* Author: Martin Vogel <vogel@inttec.de>
*
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, 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 General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries with other
* files to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for Harbour, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*
*/
#include "ct.h"
/* defines */
#define DO_CHARSWAP_CHARSWAP 0
#define DO_CHARSWAP_WORDSWAP 1
#define DO_CHARSWAP_WORDSWAP_CHARSWAP 2
/* helper function for the charswap and wordswap functions */
static void do_charswap (int iSwitch)
{
int iNoRet;
/* suppress return value ? */
iNoRet = ct_getref();
/* param check */
if (ISCHAR (1))
{
char *pcString = hb_parc (1);
size_t sStrLen = (size_t)hb_parclen (1);
char *pcRet;
size_t sRetIndex = 0;
int iShift, iMod;
char *pcSub, *pc;
if (iSwitch == DO_CHARSWAP_WORDSWAP)
{
iShift = 4;
if (ISLOG (2) && hb_parl (2))
{
iSwitch = DO_CHARSWAP_WORDSWAP_CHARSWAP;
}
}
else
{
iShift = 2;
}
pcRet = hb_xgrab (sStrLen);
for (pcSub = pcString; pcSub < pcString+sStrLen+1-iShift; pcSub += iShift)
{
switch (iSwitch)
{
case DO_CHARSWAP_WORDSWAP:
{
*(pcRet+sRetIndex) = *(pcSub+2);
sRetIndex++;
*(pcRet+sRetIndex) = *(pcSub+3);
sRetIndex++;
*(pcRet+sRetIndex) = *(pcSub);
sRetIndex++;
*(pcRet+sRetIndex) = *(pcSub+1);
sRetIndex++;
}; break;
case DO_CHARSWAP_WORDSWAP_CHARSWAP:
{
*(pcRet+sRetIndex) = *(pcSub+3);
sRetIndex++;
*(pcRet+sRetIndex) = *(pcSub+2);
sRetIndex++;
}; /* no 'break' here !! */
case DO_CHARSWAP_CHARSWAP:
{
*(pcRet+sRetIndex) = *(pcSub+1);
sRetIndex++;
*(pcRet+sRetIndex) = *(pcSub);
sRetIndex++;
};
}
}
/* copy rest of string */
if ((iSwitch == DO_CHARSWAP_WORDSWAP) ||
(iSwitch == DO_CHARSWAP_WORDSWAP_CHARSWAP))
{
iMod = sStrLen%4;
}
else
{
iMod = sStrLen%2;
}
for (pcSub = pcString+sStrLen-iMod; pcSub < pcString+sStrLen; pcSub++)
{
*(pcRet+sRetIndex) = *pcSub;
sRetIndex++;
}
/* return string */
if (ISBYREF (1))
{
hb_storclen (pcRet, sRetIndex, 1);
}
if (iNoRet)
{
hb_retl (0);
}
else
{
hb_retclen (pcRet, sRetIndex);
}
hb_xfree (pcRet);
}
else /* if (ISCHAR (1)) */
{
if (iNoRet)
{
hb_retl (0);
}
else
{
hb_retc ("");
}
}
}
/* $DOC$
* $FUNCNAME$
* CHARSWAP()
* $CATEGORY$
* CT3 string functions
* $ONELINER$
* Swap neighbouring characters in a string
* $SYNTAX$
* CHARSWAP (<[@]cString>) -> cSwappedString
* $ARGUMENTS$
* <[@]cString> is the string that should be processed
* $RETURNS$
* <cSwappedString> a string where neighbour characters are swapped
* $DESCRIPTION$
* The CHARSWAP() function loops through <cString> in steps of two
* characters and exchanges the characters from the odd and the even
* positions.
* By setting the CSETREF() switch to .T., one can omit the return value
* of this functin, but one must then pass <cString> by reference.
* $EXAMPLES$
* ? CHARSWAP("0123456789") // "1032547698"
* ? CHARSWAP("ABCDEFGHIJK") // "BADCFEHGJIK"
* $TESTS$
* CHARSWAP("0123456789") == "1032547698"
* CHARSWAP("ABCDEFGHIJK") == "BADCFEHGJIK"
* $STATUS$
* Ready
* $COMPLIANCE$
* CHARSWAP() is compatible with CT3's CHARSWAP().
* $PLATFORMS$
* All
* $FILES$
* Source is charswap.c, library is ct3.
* $SEEALSO$
* WORDSWAP() CSETREF()
* $END$
*/
HB_FUNC (CHARSWAP)
{
do_charswap (DO_CHARSWAP_CHARSWAP);
return;
}
/* $DOC$
* $FUNCNAME$
* WORDSWAP()
* $CATEGORY$
* CT3 string functions
* $ONELINER$
* Swap neighbouring double characters in a string
* $SYNTAX$
* WORDSWAP (<[@]cString> [, <lSwapCharacters>]) -> cSwappedString
* $ARGUMENTS$
* <[@]cString> is the string that should be processed
* [<lSwapCharacters>] specifies whether an additional swap should be
* done within the double characters
* Default: .F., no additional swap
* $RETURNS$
* <cSwappedString> a string where neighbouring double characters are
* swapped
* $DESCRIPTION$
* The WORDSWAP() function loops through <cString> in steps of four
* characters and exchanges the double characters from the first and
* second position with the one from the third and forth position.
* Additionally the function can perform a swap of the both char of
* each double character.
* By setting the CSETREF() switch to .T., one can omit the return value
* of this functin, but one must then pass <cString> by reference.
* $EXAMPLES$
* ? WORDSWAP("1234567890") // "3412785690"
* ? WORDSWAP("1234567890", .t.) // "4321876590"
* $TESTS$
* WORDSWAP("1234567890") == "3412785690"
* WORDSWAP("1234567890", .t.) == "4321876590"
* $STATUS$
* Ready
* $COMPLIANCE$
* WORDSWAP() is compatible with CT3's WORDSWAP().
* $PLATFORMS$
* All
* $FILES$
* Source is charswap.c, library is ct3.
* $SEEALSO$
* CHARSWAP() CSETREF()
* $END$
*/
HB_FUNC (WORDSWAP)
{
do_charswap (DO_CHARSWAP_WORDSWAP);
return;
}

71
harbour/contrib/libct/ctchrmix.c
View File

@@ -1,71 +0,0 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* CHARMIX() CA-Tools compatible function
*
* Copyright 1999 Victor Szakats <info@szelvesz.hu>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version, with one exception:
*
* The exception is that if you link the Harbour Runtime Library (HRL)
* and/or the Harbour Virtual Machine (HVM) with other files to produce
* an executable, this does not by itself cause the resulting executable
* to be covered by the GNU General Public License. Your use of that
* executable is in no way restricted on account of linking the HRL
* and/or HVM code into it.
*
* 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 General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit
* their web site at http://www.gnu.org/).
*
*/
#include "hbapi.h"
#include "hbapiitm.h"
/* NOTE: CA-Tools will hang if the second parameter is an empty string */
HB_FUNC( CHARMIX )
{
PHB_ITEM pStr1 = hb_param( 1, HB_IT_STRING );
PHB_ITEM pStr2 = hb_param( 2, HB_IT_STRING );
ULONG ulLen2;
if( pStr1 && pStr2 && ( ulLen2 = hb_itemGetCLen( pStr2 ) ) > 0 )
{
ULONG ulLen1 = hb_itemGetCLen( pStr1 );
char * pszStr1 = hb_itemGetCPtr( pStr1 );
char * pszStr2 = hb_itemGetCPtr( pStr2 );
char * pszResult = ( char * ) hb_xgrab( 2 * ulLen1 );
ULONG ulPos1 = 0;
ULONG ulPos2 = 0;
ULONG ulPosResult = 0;
while( ulPos1 < ulLen1 )
{
pszResult[ ulPosResult++ ] = pszStr1[ ulPos1++ ];
pszResult[ ulPosResult++ ] = pszStr2[ ulPos2++ ];
if( ulPos2 == ulLen2 )
ulPos2 = 0;
}
hb_retclen( pszResult, 2 * ulLen1 );
hb_xfree( pszResult );
}
else
hb_retc( "" );
}

17
harbour/contrib/libct/ctflist.txt
View File

@@ -179,23 +179,23 @@ CHARMIX ;R;
CHARNOLIST ;R;
CHARNOT ;R;
CHARODD ;R;
CHARONE ;N;
CHARONLY ;N;
CHARONE ;R;
CHARONLY ;R;
CHAROR ;R;
CHARPACK ;N;
CHARRELA ;N;
CHARRELREP ;N;
CHARREM ;N;
CHARREM ;R;
CHARREPL ;R;
CHARRLL ;R; !NEW!
CHARRLR ;R; !NEW!
CHARSHL ;R; !NEW!
CHARSHR ;R; !NEW!
CHARSLIST ;R; !NEW!
CHARSORT ;N;
CHARSORT ;R;
CHARSPREAD ;N;
CHARSUB ;R; !NEW!
CHARSWAP ;N;
CHARSWAP ;R;
CHARUNPACK ;N;
CHARXOR ;R;
CHECKSUM ;R;
@@ -249,10 +249,11 @@ TOKENNEXT ;N;
TOKENSEP ;R;
TOKENUPPER ;R;
VALPOS ;R;
WORDONE ;N;
WORDONLY ;N;
WORDONE ;R;
WORDONLY ;R;
WORDREM ;R; !NEW!
WORDREPL ;R;
WORDSWAP ;N;
WORDSWAP ;R;
WORDTOCHAR ;N;
;
;

30
harbour/contrib/libct/makefile.bc
View File

@@ -99,12 +99,16 @@ TOOLS_LIB_OBJS = \
$(OBJ_DIR)\charevod.obj \
$(OBJ_DIR)\charlist.obj \
$(OBJ_DIR)\charmirr.obj \
$(OBJ_DIR)\charmix.obj \
$(OBJ_DIR)\charone.obj \
$(OBJ_DIR)\charonly.obj \
$(OBJ_DIR)\charop.obj \
$(OBJ_DIR)\charrepl.obj \
$(OBJ_DIR)\charsort.obj \
$(OBJ_DIR)\charswap.obj \
$(OBJ_DIR)\ctset.obj \
$(OBJ_DIR)\ctstr.obj \
$(OBJ_DIR)\ctchksum.obj \
$(OBJ_DIR)\ctchrmix.obj \
$(OBJ_DIR)\ctcolton.obj \
$(OBJ_DIR)\ctcrypt.obj \
$(OBJ_DIR)\ctposupp.obj \
@@ -166,6 +170,18 @@ $(OBJ_DIR)\charmirr.obj : $(TOOLS_DIR)\charmirr.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,,
$(OBJ_DIR)\charmix.obj : $(TOOLS_DIR)\charmix.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,,
$(OBJ_DIR)\charone.obj : $(TOOLS_DIR)\charone.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,,
$(OBJ_DIR)\charonly.obj : $(TOOLS_DIR)\charonly.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,,
$(OBJ_DIR)\charop.obj : $(TOOLS_DIR)\charop.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,,
@@ -174,6 +190,14 @@ $(OBJ_DIR)\charrepl.obj : $(TOOLS_DIR)\charrepl.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,,
$(OBJ_DIR)\charsort.obj : $(TOOLS_DIR)\charsort.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,,
$(OBJ_DIR)\charswap.obj : $(TOOLS_DIR)\charswap.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,,
$(OBJ_DIR)\ctset.obj : $(TOOLS_DIR)\ctset.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,,
@@ -186,10 +210,6 @@ $(OBJ_DIR)\ctchksum.obj : $(TOOLS_DIR)\ctchksum.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,,
$(OBJ_DIR)\ctchrmix.obj : $(TOOLS_DIR)\ctchrmix.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,,
$(OBJ_DIR)\ctcolton.obj : $(TOOLS_DIR)\ctcolton.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,,

12
harbour/contrib/libct/makefile.vc
View File

@@ -119,12 +119,16 @@ TOOLS_LIB_OBJS = \
$(OBJ_DIR)\charevod.obj \
$(OBJ_DIR)\charlist.obj \
$(OBJ_DIR)\charmirr.obj \
$(OBJ_DIR)\charmix.obj \
$(OBJ_DIR)\charone.obj \
$(OBJ_DIR)\charonly.obj \
$(OBJ_DIR)\charop.obj \
$(OBJ_DIR)\charrepl.obj \
$(OBJ_DIR)\charsort.obj \
$(OBJ_DIR)\charswap.obj \
$(OBJ_DIR)\ctset.obj \
$(OBJ_DIR)\ctstr.obj \
$(OBJ_DIR)\ctchksum.obj \
$(OBJ_DIR)\ctchrmix.obj \
$(OBJ_DIR)\ctcolton.obj \
$(OBJ_DIR)\ctcrypt.obj \
$(OBJ_DIR)\ctposupp.obj \
@@ -151,12 +155,16 @@ CLEAN:
-@if exist $(OBJ_DIR)\charevod.* del $(OBJ_DIR)\charevod.*
-@if exist $(OBJ_DIR)\charlist.* del $(OBJ_DIR)\charlist.*
-@if exist $(OBJ_DIR)\charmirr.* del $(OBJ_DIR)\charmirr.*
-@if exist $(OBJ_DIR)\charmix.* del $(OBJ_DIR)\charmix.*
-@if exist $(OBJ_DIR)\charone.* del $(OBJ_DIR)\charone.*
-@if exist $(OBJ_DIR)\charonly.* del $(OBJ_DIR)\charonly.*
-@if exist $(OBJ_DIR)\charop.* del $(OBJ_DIR)\charop.*
-@if exist $(OBJ_DIR)\charrepl.* del $(OBJ_DIR)\charrepl.*
-@if exist $(OBJ_DIR)\charsort.* del $(OBJ_DIR)\charsort.*
-@if exist $(OBJ_DIR)\charswap.* del $(OBJ_DIR)\charswap.*
-@if exist $(OBJ_DIR)\ctset.* del $(OBJ_DIR)\ctset.*
-@if exist $(OBJ_DIR)\ctstr.* del $(OBJ_DIR)\ctstr.*
-@if exist $(OBJ_DIR)\ctchksum.* del $(OBJ_DIR)\ctchksum.*
-@if exist $(OBJ_DIR)\ctchrmix.* del $(OBJ_DIR)\ctchrmix.*
-@if exist $(OBJ_DIR)\ctcolton.* del $(OBJ_DIR)\ctcolton.*
-@if exist $(OBJ_DIR)\ctcrypt.* del $(OBJ_DIR)\ctcrypt.*
-@if exist $(OBJ_DIR)\ctposupp.* del $(OBJ_DIR)\ctposupp.*

20
harbour/contrib/libct/readme.txt
View File

@@ -12,6 +12,7 @@ Victor Szakats <info@szelvesz.hu>
Changes and Enhancements over the original CA-T**ls 3 Library
Martin Vogel <vogel@inttec.de>
=============================================================
* ADDASCII() New 4th parameter to enable a carry over in the addition
@@ -22,19 +23,19 @@ Changes and Enhancements over the original CA-T**ls 3 Library
* ATTOKEN() New 4th parameter to specify a skip width equal to the
TOKEN() function
+ CHARHIST generates a character histogram of a string
+ CHARHIST() generates a character histogram of a string
+ CHARRLL bitwise roll to the left operation on characters
+ CHARRLL() bitwise roll to the left operation on characters
+ CHARRLR bitwise roll to the right operation on characters
+ CHARRLR() bitwise roll to the right operation on characters
+ CHARSHL bitwise shift left operation on characters
+ CHARSHL() bitwise shift left operation on characters
+ CHARSHR bitwise shift right operation on characters
+ CHARSHR() bitwise shift right operation on characters
+ CHARSLIST generates a sorted character list of a string
+ CHARSLIST() generates a sorted character list of a string
+ CHARSUB subtracts corresponding ASCII values
+ CHARSUB() subtracts corresponding ASCII values
* SETATLIKE() 2nd parameter can be passed by reference so that SETATLIKE
can store the acutal wildcard character in it
@@ -45,3 +46,8 @@ Changes and Enhancements over the original CA-T**ls 3 Library
* TOKENLOWER() New 4th parameter <nSkipWidth>
* TOKENUPPER() New 4th parameter <nSkipWidth>
+ WORDREM() remove double characters from a string

10
harbour/contrib/libct/tests/Makefile
View File

@@ -45,16 +45,22 @@ PRG_SOURCES=\
charhist.prg \
charlist.prg \
charmirr.prg \
charmix.prg \
charnlst.prg \
charnot.prg \
charodd.prg \
charone.prg \
charonly.prg \
charor.prg \
charrem.prg \
charrepl.prg \
charrll.prg \
charrlr.prg \
charshl.prg \
charshr.prg \
charslst.prg \
charsort.prg \
charswap.prg \
charsub.prg \
charxor.prg \
csetref.prg \
@@ -66,7 +72,11 @@ PRG_SOURCES=\
tokensep.prg \
tokenupp.prg \
valpos.prg \
wordone.org \
wordonly.prg \
wordrepl.prg \
wordrem.prg \
wordswap.prg \
PRG_HEADERS=\

80
harbour/contrib/libct/tests/charmix.prg Normal file
View File

@@ -0,0 +1,80 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* Test CT3 function CHARMIX()
*
* Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany
* Author: Martin Vogel <vogel@inttec.de>
*
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, 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 General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries with other
* files to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for Harbour, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*
*/
#include "../ct.ch"
procedure main
qout ("Begin test of CHARMIX()")
qout ("")
// simple tests
qout ("Simple tests:")
qout ([ charmix("ABC", "123") == "A1B2C3" ? --> "] + charmix("ABC", "123") + ["])
qout ([ charmix("ABCDE", "12") == "A1B2C1D2E1" ? --> "] + charmix("ABCDE", "12") + ["])
qout ([ charmix("AB", "12345") == "A1B2" ? --> "] + charmix("AB", "12345") + ["])
qout ([ charmix("HELLO", " ") == "H E L L O " ? --> "] + charmix("HELLO", " ") + ["])
qout ([ charmix("HELLO", "") == "HELLO" ? --> "] + charmix("HELLO", "") + ["])
qout ("")
qout ("End test of CHARMIX()")
qout ("")
return

80
harbour/contrib/libct/tests/charone.prg Normal file
View File

@@ -0,0 +1,80 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* Test CT3 function CHARONE()
*
* Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany
* Author: Martin Vogel <vogel@inttec.de>
*
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, 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 General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries with other
* files to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for Harbour, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*
*/
#include "../ct.ch"
procedure main
qout ("Begin test of CHARONE()")
qout ("")
// simple tests
qout ("Simple tests:")
qout ([ charone("112333a123") == "123a123"? --> "] + charone("112333a123") + ["])
qout ([ charone("122333a123") == "123a123"? --> "] + charone("122333a123") + ["])
qout ([ charone("A B CCCD") == "A B CD"? ---> "] + charone("A B CCCD") + ["])
qout ([ charone(" ", "A B A B") == "A B A B"? --> "] + charone(" ", "A B A B") + ["])
qout ([ charone("o", "122oooB12o") == "122oB12o"? -> "] + charone("o", "122oooB12o") + ["])
qout ("")
qout ("End test of CHARONE()")
qout ("")
return

78
harbour/contrib/libct/tests/charonly.prg Normal file
View File

@@ -0,0 +1,78 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* Test CT3 function CHARONLY()
*
* Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany
* Author: Martin Vogel <vogel@inttec.de>
*
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, 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 General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries with other
* files to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for Harbour, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*
*/
#include "../ct.ch"
procedure main
qout ("Begin test of CHARONLY()")
qout ("")
// simple tests
qout ("Simple tests:")
qout ([ charonly("0123456789", "0211 - 38 99 77") == "0211389977" ? --> "] + charonly("0123456789", "0211 - 38 99 77")+ ["])
qout ([ charonly("0123456789", "0211/ 389 977") == "0211389977" ? --> "] + charonly("0123456789", "0211/ 389 977") + ["])
qout ("")
qout ("End test of CHARONLY()")
qout ("")
return

78
harbour/contrib/libct/tests/charrem.prg Normal file
View File

@@ -0,0 +1,78 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* Test CT3 function CHARREM()
*
* Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany
* Author: Martin Vogel <vogel@inttec.de>
*
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, 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 General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries with other
* files to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for Harbour, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*
*/
#include "../ct.ch"
procedure main
qout ("Begin test of CHARREM()")
qout ("")
// simple tests
qout ("Simple tests:")
qout ([ charrem(" ", " 1 2 ") == "12" ? ---> "] + charrem(" ", " 1 2 ")+ ["])
qout ([ charrem("3y", "xyz123") == "xz12" ? ---> "] + charrem("3y", "xyz123")+ ["])
qout ("")
qout ("End test of CHARREM()")
qout ("")
return

85
harbour/contrib/libct/tests/charsort.prg Normal file
View File

@@ -0,0 +1,85 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* Test CT3 function CHARSORT()
*
* Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany
* Author: Martin Vogel <vogel@inttec.de>
*
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, 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 General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries with other
* files to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for Harbour, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*
*/
#include "../ct.ch"
procedure main
qout ("Begin test of CHARSORT()")
qout ("")
// simple tests
qout ("Simple tests:")
qout ([ charsort("qwert") == "eqrtw" ? --> "] + charsort("qwert") + ["])
qout ([ charsort("qwert", 2) == "erqwt" ? --> "] + charsort("qwert", 2) + ["])
qout ([ charsort("b1a4a3a2a1", 2, 1) == "a2a1a3a4b1" ? --> "] + charsort("b1a4a3a2a1", 2, 1) + ["])
qout ([ NOTE : The order of equal elements (here the one beginning with the same char) is NOT determined !])
qout ([ charsort("XXXqwert", 1, 1, 3) == "XXXeqrtw" ? --> "] + charsort("XXXqwert", 1, 1, 3) + ["])
qout ([ charsort("b1a4a3a2a1", 2, 1, 0, 1) == "a1b1a2a3a4" ? --> "] + charsort("b1a4a3a2a1", 2, 1, 0, 1) + ["])
qout ([ NOTE : The order of equal elements (here the one ending with the same number) is NOT determined !])
qout ([ charsort("384172852", 1, 1, 0, 0, 4) == "134872852" ? --> "] + charsort("384172852", 1, 1, 0, 0, 4)+ ["])
qout ([ charsort("qwert",,,,,,.T.) == "wtrqe" ? --> "] + charsort("qwert",,,,,,.T.) + ["])
qout ("")
qout ("End test of CHARSORT()")
qout ("")
return

78
harbour/contrib/libct/tests/charswap.prg Normal file
View File

@@ -0,0 +1,78 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* Test CT3 function CHARSWAP()
*
* Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany
* Author: Martin Vogel <vogel@inttec.de>
*
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, 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 General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries with other
* files to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for Harbour, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*
*/
#include "../ct.ch"
procedure main
qout ("Begin test of CHARSWAP()")
qout ("")
// simple tests
qout ("Simple tests:")
qout ([ charswap("0123456789") == "1032547698" ? --> "] + charswap("0123456789") + ["])
qout ([ charswap("ABCDEFGHIJK") == "BADCFEHGJIK" ? --> "] + charswap("ABCDEFGHIJK")+ ["])
qout ("")
qout ("End test of CHARSWAP()")
qout ("")
return

78
harbour/contrib/libct/tests/wordone.prg Normal file
View File

@@ -0,0 +1,78 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* Test CT3 function WORDONE()
*
* Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany
* Author: Martin Vogel <vogel@inttec.de>
*
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, 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 General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries with other
* files to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for Harbour, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*
*/
#include "../ct.ch"
procedure main
qout ("Begin test of WORDONE()")
qout ("")
// simple tests
qout ("Simple tests:")
qout ([ wordone("12ABAB12") == "12AB12" ? --> "] + wordone("12ABAB12") + ["])
qout ([ wordone("1AAAA2") == "1AAAA2" ? --> "] + wordone("1AAAA2") + ["])
qout ([ wordone("12", "1212ABAB") == "12ABAB" ? --> "] + wordone("12", "1212ABAB") + ["])
qout ("")
qout ("End test of WORDONE()")
qout ("")
return

78
harbour/contrib/libct/tests/wordonly.prg Normal file
View File

@@ -0,0 +1,78 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* Test CT3 function WORDONLY()
*
* Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany
* Author: Martin Vogel <vogel@inttec.de>
*
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, 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 General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries with other
* files to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for Harbour, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*
*/
#include "../ct.ch"
procedure main
qout ("Begin test of WORDONLY()")
qout ("")
// simple tests
qout ("Simple tests:")
qout ([ wordonly("AABBCCDD", "XXAAYYBBZZ") == "AABB" ? --> "] + wordonly("AABBCCDD", "XXAAYYBBZZ")+ ["])
qout ([ wordonly("AABBCCDD", "XAAYYYBBZZ") == "BB" ? ----> "] + wordonly("AABBCCDD", "XAAYYYBBZZ")+ ["])
qout ("")
qout ("End test of WORDONLY()")
qout ("")
return

79
harbour/contrib/libct/tests/wordrem.prg Normal file
View File

@@ -0,0 +1,79 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* Test CT3 function WORDREM()
*
* Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany
* Author: Martin Vogel <vogel@inttec.de>
*
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, 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 General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries with other
* files to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for Harbour, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*
*/
#include "../ct.ch"
procedure main
qout ("Begin test of WORDREM()")
qout ("")
// simple tests
qout ("Simple tests:")
qout ([ wordrem("abcd", "0ab1cd") == "0ab1" ? ----> "] + wordrem("abcd", "0ab1cd") + ["])
qout ([ wordrem("abcd", "ab0cd1") == "0cd1" ? ----> "] + wordrem("abcd", "ab0cd1") + ["])
qout ("")
qout ("End test of WORDREM()")
qout ("")
return

78
harbour/contrib/libct/tests/wordswap.prg Normal file
View File

@@ -0,0 +1,78 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* Test CT3 function WORDSWAP()
*
* Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany
* Author: Martin Vogel <vogel@inttec.de>
*
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, 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 General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries with other
* files to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for Harbour, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*
*/
#include "../ct.ch"
procedure main
qout ("Begin test of WORDSWAP()")
qout ("")
// simple tests
qout ("Simple tests:")
qout ([ wordswap("1234567890") == "3412785690" ? --> "] + wordswap("1234567890") + ["])
qout ([ wordswap("1234567890", .t.) == "4321876590" ? --> "] + wordswap("1234567890", .t.)+ ["])
qout ("")
qout ("End test of WORDSWAP()")
qout ("")
return