home *** CD-ROM | disk | FTP | other *** search
/ TestDrive Super Store 2.3 / TESTDRIVE_2.ISO / realizer / lib / stdarray.rlz < prev    next >
Encoding:
Text File  |  1992-09-30  |  3.4 KB  |  118 lines
  1. '***********************************************************************
  2. '    StdArray.rlz                              
  3. '
  4. '    Standard Array Function Library
  5. '
  6. '    Copyright ⌐ 1991-1992 Computer Associates International, Inc.
  7. '    All rights reserved.
  8. '
  9. '***********************************************************************
  10.  
  11. IF QVar(%%StdArray, _Defined) THEN
  12.     EXIT MACRO
  13. END IF
  14. %%StdArray = 1
  15.  
  16. RUN "StdError"
  17.  
  18. '*** Dim(rsNumElems  [, gsValue])
  19.  
  20. FUNC Dim(rsNumElems, ..)
  21.     LOCAL i, v, retval
  22.  
  23.     ECType(rsNumElems, _Real + _Scalar, 1)
  24.     ECRange(rsNumElems, 1, 8192, 1)
  25.     ECProto(QNOptParams, 1, "Dim(rsNumElems  [, gsValue])")
  26.     IF QNOptParams THEN
  27.         ECType(QOptParam(1), _Scalar, 2)
  28.         v = QOptParam(1)
  29.         retval[1:rsNumElems] = v
  30.         RETURN retval
  31.     ELSE
  32.         retval[1:rsNumElems] = 0
  33.         RETURN retval
  34.     END IF
  35. END FUNC
  36.  
  37.  
  38. '*** FirstMatch(gvArray, gsMatch, rsStart, rsEnd)
  39.  
  40. EXTERNAL "standard.exe" FUNC FirstNonZero(POINTER, INTEGER, INTEGER, INTEGER) AS INTEGER
  41. EXTERNAL "standard.exe" FUNC FirstRealMatch(POINTER, REAL, INTEGER, INTEGER, INTEGER) AS INTEGER
  42.  
  43. FUNC FirstMatch(gvArray, gsMatch, ..)
  44.     LOCAL shift, size, retval
  45.  
  46.     ECType(gvArray, _Array, 1)
  47.     ECType(gsMatch, _Scalar, 2)
  48.     ECProto(QNOptParams, 2, "FirstMatch(gvArray, gsMatch [, rsStart [, rsEnd]])")
  49.     shift = StartValid(gvArray) - 1
  50.     size = EndValid(gvArray) - StartValid(gvArray) + 1
  51.     IF QVar(gsMatch, _Real) THEN
  52.         ECType(gvArray, _Real, 1)
  53.         IF shift THEN
  54.             SELECT CASE QNoptParams
  55.             CASE 0
  56.                 retval = FirstRealMatch(gvArray[+shift], gsMatch, size, 1, size)
  57.             CASE 1
  58.                 ECType(QOptParam(1), _Real + _Scalar, 3)
  59.                 retval = FirstRealMatch(gvArray[+shift], gsMatch, size, QOptParam(1)-shift, size)
  60.             CASE 2
  61.                 ECType(QOptParam(1), _Real + _Scalar, 3)
  62.                 ECType(QOptParam(2), _Real + _Scalar, 4)
  63.                 retval = FirstRealMatch(gvArray[+shift], gsMatch, size, QOptParam(1)-shift, QOptParam(2)-shift)
  64.             END SELECT    
  65.         ELSE
  66.             SELECT CASE QNoptParams
  67.             CASE 0
  68.                 retval = FirstRealMatch(gvArray,  gsMatch, size, 1, size)
  69.             CASE 1
  70.                 ECType(QOptParam(1), _Real + _Scalar, 3)
  71.                 retval = FirstRealMatch(gvArray,  gsMatch, size, QOptParam(1), size)
  72.             CASE 2
  73.                 ECType(QOptParam(1), _Real + _Scalar, 3)
  74.                 ECType(QOptParam(2), _Real + _Scalar, 4)
  75.                 retval = FirstRealMatch(gvArray,  gsMatch, size, QOptParam(1), QOptParam(2))
  76.             END SELECT    
  77.         END IF
  78.     ELSE
  79.         IF QVar(gsMatch, _DateTime) THEN
  80.             ECType(gvArray, _DateTime, 1)
  81.         ELSE
  82.             ECType(gvArray, _Alpha, 1)
  83.         END IF
  84.         IF shift THEN
  85.             SELECT CASE QNoptParams
  86.             CASE 0
  87.                 retval = FirstNonZero(gvArray[+shift] = gsMatch, size, 1, size)
  88.             CASE 1
  89.                 ECType(QOptParam(1), _Real + _Scalar, 3)
  90.                 retval = FirstNonZero(gvArray[+shift] = gsMatch, size, QOptParam(1)-shift, size)
  91.             CASE 2
  92.                 ECType(QOptParam(1), _Real + _Scalar, 3)
  93.                 ECType(QOptParam(2), _Real + _Scalar, 4)
  94.                 retval = FirstNonZero(gvArray[+shift] = gsMatch, size, QOptParam(1)-shift, QOptParam(2)-shift)
  95.             END SELECT    
  96.         ELSE
  97.             SELECT CASE QNoptParams
  98.             CASE 0
  99.                 retval = FirstNonZero(gvArray = gsMatch, size, 1, size)
  100.             CASE 1
  101.                 ECType(QOptParam(1), _Real + _Scalar, 3)
  102.                 retval = FirstNonZero(gvArray = gsMatch, size, QOptParam(1), size)
  103.             CASE 2
  104.                 ECType(QOptParam(1), _Real + _Scalar, 3)
  105.                 ECType(QOptParam(2), _Real + _Scalar, 4)
  106.                 retval = FirstNonZero(gvArray = gsMatch, size, QOptParam(1), QOptParam(2))
  107.             END SELECT    
  108.         END IF
  109.     END IF
  110.  
  111.     IF retval THEN
  112.         RETURN retval + shift
  113.     ELSE
  114.         RETURN 0
  115.     END IF
  116. END FUNC
  117.  
  118.