Adding GT Library

harbour/source/tools/ascpos.c

@@ -0,0 +1,80 @@
+/*
+ * GT CLIPPER STANDARD HEADER
+ *
+ * File......: ascpos.c
+ * Author....: Andy M Leighton
+ * BBS.......: The Dark Knight Returns
+ * Net/Node..: 050/069
+ * User Name.: Andy Leighton
+ * Date......: 23/05/93
+ * Revision..: 1.00
+ *
+ * This is an original work by Andy Leighton and is placed in the
+ * public domain.
+ *
+ * Modification history:
+ * ---------------------
+ *
+ * $Log$
+ * Revision 1.1  1999/06/02 06:21:33  ajahja
+ * Adding GT Library
+ *
+ *
+ */
+
+/*
+ *  $DOC$
+ *  $FUNCNAME$
+ *      GT_ASCPOS()
+ *  $CATEGORY$
+ *      String
+ *  $ONELINER$
+ *      Return the ascii value of a specified character in a string
+ *  $SYNTAX$
+ *      GT_Ascpos(<cStr>, <nPos>) --> nAscVal
+ *  $ARGUMENTS$
+ *      <cStr>  - The string
+ *      <nPos>  - The position in <cStr>
+ *  $RETURNS$
+ *      nAscVal - The ascii value of substr(<cStr>, <nPos>, 1)
+ *  $DESCRIPTION$
+ *      Return the ascii value of a specified character in a string
+ *      Equivalent (but much faster) to
+ *          asc(substr(cStr, nPos, 1)
+ *
+ *      NOTE:
+ *         invalid parameters will return -1
+ *         nPos > len(cStr)   will return -2
+ *
+ *      This last behaviour is different to the Funcky function of the
+ *      same name.  I changed the behaviour because some of the strings
+ *      I process contain embedded NULs.
+ *  $EXAMPLES$
+ *       ? gt_ascpos("the cat sat on the mat", 3)
+ *                                   // prints e
+ *  $END$
+ */
+
+#include <extend.h>
+
+HARBOUR
+gt_ascpos()
+{
+  char *s;
+  int  p;
+
+  if (ISCHAR(1) && ISNUM(2)) {
+    s = _parc(1);
+    p = _parni(2);
+    p--;                            // decrement p to adjust for c strings
+                                    // starting at position 0
+
+    if (p > _parclen(1))            // oh oh p > length of passed string
+      _retni(-2);                   // error -2
+    else
+      _retni((int) s[p]);           // return ascii code of appropriate
+                                    // character in string
+  } else {
+    _retni(-1);                     // parameter mismatch - error -1
+  }
+}

harbour/source/tools/atdiff.c

@@ -0,0 +1,86 @@
+/*
+ * GT CLIPPER STANDARD HEADER
+ *
+ * File......: atdiff.c
+ * Author....: Andy M Leighton
+ * BBS.......: The Dark Knight Returns
+ * Net/Node..: 050/069
+ * User Name.: Andy Leighton
+ * Date......: 23/05/93
+ * Revision..: 1.00
+ *
+ * This is an original work by Andy Leighton and is placed in the
+ * public domain.
+ *
+ * Modification history:
+ * ---------------------
+ *
+ * $Log$
+ * Revision 1.1  1999/06/02 06:18:45  ajahja
+ * Adding GT Library
+ *
+ *
+ */
+
+/*
+ *  $DOC$
+ *  $FUNCNAME$
+ *      GT_ATDIFF()
+ *  $CATEGORY$
+ *      String
+ *  $ONELINER$
+ *      Return the position where two strings begin to differ
+ *  $SYNTAX$
+ *      GT_AtDiff(<cStr1>, <cStr2>) --> nPos
+ *  $ARGUMENTS$
+ *      <cStr1>  - A character string to compare
+ *      <cStr2>  - The string to compare with
+ *  $RETURNS$
+ *      nPos     - The position in <cStr2> where <cStr1> begins to differ
+ *  $DESCRIPTION$
+ *      Return the position in <cStr2> where <cStr1> begins to differ.
+ *      If the strings differ in the first character GT_AtDiff() will
+ *      return 1.  If the two strings are identical (or identical upto
+ *      the last character in <cStr2>) the function will return 0.
+ *
+ *      NOTE:
+ *         invalid parameters will return -1
+ *  $EXAMPLES$
+ *      ? gt_atDiff("the cat", "the rat")          // prints 5
+ *      ? gt_atDiff("the cat", "the ")             // prints 0
+ *
+ *  $END$
+ */
+
+
+#include <extend.h>
+
+HARBOUR
+gt_atdiff()
+{
+  char *s1, *s2;
+  int pos, len;
+
+  if (ISCHAR(1) && ISCHAR(2)) {
+    s1  = _parc(1);
+    s2  = _parc(2);
+    len = _parclen(2);
+
+    /*
+       loop through comparing both strings
+
+       NOTE: pos starts at 1, so as to return a string index
+             for CLIPPER
+    */
+
+    for (pos = 1; (pos <= len) && (*s1 == *s2); s2++, s1++)
+      pos++;
+
+    if (pos > len)                  // strings match exactly!!!
+      _retni(0);
+    else
+      _retni(pos);
+  } else {
+    _retni(-1);                     // parameter mismatch - error -1
+  }
+}