/*ScianArrays.c Eric Pepke February 9, 1990 Array handling stuff in scian */ #include "Scian.h" #include "ScianTypes.h" #include "ScianWindows.h" #include "ScianObjWindows.h" #include "ScianDialogs.h" #include "ScianArrays.h" #include "ScianLists.h" #include "ScianErrors.h" #include "ScianIDs.h" #include "ScianDatasets.h" #include "ScianTimers.h" #include "ScianNetObjects.h" #include "ScianGarbageMan.h" ObjPtr arrayClass, objectArrayClass, byteArrayClass, shortArrayClass, realArrayClass, pointerArrayClass; #ifdef PROTO long SearchReal(ObjPtr array, real value) #else long SearchReal(array, value) ObjPtr array; real value; #endif /*Assuming array is a sorted, 1-dimensional real array, finds the index to the lowest element which is larger than value, or the dims if the value is higher than all. Returns -1 if the array is bad.*/ { long top, bottom, mid; real *elements; if ((!IsRealArray(array)) || (RANK(array) != 1)) { ReportError("SearchReal", "This function requires a real array of rank 1"); return -1; } bottom = 0; top = DIMS(array)[0] - 1; elements = ELEMENTS(array); if (value >= elements[top]) { return top + 1; } while (top > bottom) { mid = (top + bottom) / 2; if (value >= elements[mid]) { bottom = mid + 1; } else { top = mid; } } return bottom; } #ifdef PROTO long SearchShort(ObjPtr array, short value) #else long SearchShort(array, value) ObjPtr array; short value; #endif /*Assuming array is a sorted, 1-dimensional short array, finds the index to the lowest element which is larger than value, or the dims if the value is higher than all. Returns -1 if the array is bad.*/ { long top, bottom, mid; short *elements; if ((!IsShortArray(array)) || (RANK(array) != 1)) { ReportError("SearchShort", "This function requires a short array of rank 1"); return -1; } bottom = 0; top = DIMS(array)[0] - 1; elements = ELEMENTS(array); if (value >= elements[top]) { return top + 1; } while (top > bottom) { mid = (top + bottom) / 2; if (value >= elements[mid]) { bottom = mid + 1; } else { top = mid; } } return bottom; } #ifdef PROTO real SearchFuzzyReal(ObjPtr array, real value) #else real SearchFuzzyReal(array, value) ObjPtr array; real value; #endif /*Assuming array is a sorted, 1-dimensional real array, finds a fuzzy real index into the array.*/ { long found; real *elements; if ((!IsRealArray(array)) || (RANK(array) != 1)) { ReportError("SearchFuzzyReal", "This function requires a real array of rank 1"); return 0.0; } found = SearchReal(array, value); elements = ELEMENTS(array); if (DIMS(array)[0] == 1) { /*Degenerate case*/ return 0; } if (found >= DIMS(array)[0]) { /*This is bigger. Extrapolate*/ return (value - elements[DIMS(array)[0] - 1]) / (elements[DIMS(array)[0] - 1] - elements[DIMS(array)[0] - 2]) + (real) (DIMS(array)[0] - 1); } else if (found <= 0) { /*This is smaller. Extrapolate*/ return (value - elements[0]) / (elements[1] - elements[0]); } else { /*It's in between*/ return (value - elements[found - 1]) / (elements[found] - elements[found - 1]) + (real) (found - 1); } } #ifdef PROTO real FuzzyRealIndex(ObjPtr array, real index) #else real FuzzyRealIndex(array, index) ObjPtr array; real index; #endif /*Assuming array is a sorted, 1-dimensional real array, indexes a fuzzy real index into the array.*/ { real *elements; long indexI; if ((!IsRealArray(array)) || (RANK(array) != 1)) { ReportError("FuzzyRealIndex", "This function requires a real array of rank 1"); return -1.0; } elements = ELEMENTS(array); /*Degenerate case*/ if (DIMS(array)[0] == 1) { return elements[0]; } indexI = index; if (indexI < 0) { /*Extrapolate*/ return elements[0] + index * (elements[1] - elements[0]); } else if (indexI >= DIMS(array)[0] - 1) { /*Extrapolate*/ return elements[DIMS(array)[0] - 1] + (index - (DIMS(array)[0] - 1)) * (elements[DIMS(array)[0] - 1] - elements[DIMS(array)[0] - 2]); } else { /*Interpolate*/ return elements[indexI] + (index - (real) indexI) * (elements[indexI + 1] - elements[indexI]); } } static int globalVar; #ifdef PROTO int CompareStringVars(const void *a, const void *b) #else int CompareStringVars(a, b) void *a, *b; #endif /*Compares two object's globalVar strings for qsort*/ { ObjPtr s1, s2; s1 = GetStringVar("CompareStringVars", *((ObjPtr *) a), NAME); s2 = GetStringVar("CompareStringVars", *((ObjPtr *) b), NAME); if (!s1 || !s2) return 0; return strcmp2(GetString(s1), GetString(s2)); } #ifdef PROTO ObjPtr SortArrayByStringVar(ObjPtr array, NameTyp var) #else ObjPtr SortArrayByStringVar(array, var) ObjPtr array; NameTyp var; #endif /*Sorts a 1-dimensional object array by var, which must be a string. Returns the sorted array or NULLOBJ*/ { ObjPtr retVal; long *newDims; ObjPtr *elements, *newElements; long k; if (!IsObjArray(array) || RANK(array) != 1) { ReportError("SortArrayByStringVar", "This function requires an object array of rank 1"); return NULLOBJ; } /*Make the elements*/ newElements = (ObjPtr *) Alloc(sizeof(ObjPtr) * DIMS(array)[0]); if (!newElements) { OMErr(); return NULLOBJ; } /*Make the dimensions*/ newDims = (long *) Alloc(sizeof(long)); if (!newDims) { Free(newElements); OMErr(); return NULLOBJ; } /*Make the array*/ retVal = NewObject(objectArrayClass, sizeof(Array) - sizeof(Obj)); /*If can't, return NIL*/ if (!retVal) { Free(newElements); Free(newDims); OMErr(); return NULLOBJ; } /*Make elements and dims*/ ELEMENTS(retVal) = newElements; DIMS(retVal) = newDims; newDims[0] = DIMS(array)[0]; /*Fill in values for flags and dimensions*/ SETOBJTYPE(retVal -> flags, OBJTYPE(array -> flags)); RANK(retVal) = 1; elements = ELEMENTS(array); for (k = 0; k < DIMS(array)[0]; ++k) { newElements[k] = elements[k]; } globalVar = var; qsort(newElements, DIMS(array)[0], sizeof(ObjPtr), CompareStringVars); return retVal; } #ifdef PROTO long SearchStringVar(ObjPtr array, NameTyp whichVar, char *value) #else long SearchStringVar(array, whichVar, value) ObjPtr array; NameTyp whichVar; char *value; #endif /*Assuming array is a sorted, 1-dimensional object array, finds the index to the lowest element which has a string var whichVar larger than value, or the dims if the value is higher than all. Returns -1 if the array is bad.*/ { long top, bottom, mid; ObjPtr var; ObjPtr *elements; if ((!IsObjArray(array)) || (RANK(array) != 1)) { ReportError("SearchStringVar", "This function requires an object array of rank 1"); return -1; } bottom = 0; top = DIMS(array)[0] - 1; elements = ELEMENTS(array); MakeVar(elements[top], whichVar); var = GetVar(elements[top], whichVar); if (var && IsString(var)) { if (strcmp2(value, GetString(var)) >= 0) { return top + 1; } } else { return -1; } while (top > bottom) { mid = (top + bottom) / 2; MakeVar(elements[mid], whichVar); var = GetVar(elements[mid], whichVar); if (var && IsString(var)) { if (strcmp2(value, GetString(var)) >= 0) { bottom = mid + 1; } else { top = mid; } } else { return -1; } } return bottom; } #ifdef PROTO long SearchIntVar(ObjPtr array, NameTyp whichVar, int value) #else long SearchIntVar(array, whichVar, value) ObjPtr array; NameTyp whichVar; int value; #endif /*Assuming array is a sorted, 1-dimensional object array, finds the index to the lowest element which has an int var whichVar larger than value, or the dims if the value is higher than all. Returns -1 if the array is bad.*/ { long top, bottom, mid; ObjPtr var; ObjPtr *elements; if ((!IsObjArray(array)) || (RANK(array) != 1)) { ReportError("SearchIntVar", "This function requires an object array of rank 1"); return -1; } bottom = 0; top = DIMS(array)[0] - 1; elements = ELEMENTS(array); MakeVar(elements[top], whichVar); var = GetVar(elements[top], whichVar); if (var && IsInt(var)) { if (value >= GetInt(var)) { return top + 1; } } else { return -1; } while (top > bottom) { mid = (top + bottom) / 2; MakeVar(elements[mid], whichVar); var = GetVar(elements[mid], whichVar); if (var && IsInt(var)) { if (value >= GetInt(var)) { bottom = mid + 1; } else { top = mid; } } else { return -1; } } return bottom; } #ifdef PROTO static int ComparePointers(const void *a, const void *b) #else static int ComparePointers(a, b) void *a, *b; #endif /*Compares two pointers*/ { return (*(ObjPtr *) a) - (*(ObjPtr *) b); } #ifdef PROTO static int CR(const void *a, const void *b) #else static int CR(a, b) void *a, *b; #endif /*Compares two reals*/ { return (*(real *) a) - (*(real *) b); } #ifdef PROTO ObjPtr Uniq(ObjPtr array) #else ObjPtr Uniq(array) ObjPtr array; #endif /*Returns array with only unique elements of array. Array must be 1-dimensional. Warning! This will sort the array first*/ { long *newDims; ObjPtr retVal; int s, d; if ((!IsObjArray(array) && !IsRealArray(array)) || RANK(array) != 1) { ReportError("Uniq", "This function requires an array of rank 1"); return NULLOBJ; } /*Make the new dims*/ newDims = (long *) Alloc(sizeof(long)); if (!newDims) { OMErr(); return NULLOBJ; } /*Make the array*/ retVal = NewObject(IsRealArray(array) ? realArrayClass : objectArrayClass, sizeof(Array) - sizeof(Obj)); /*If can't, return NIL*/ if (!retVal) { Free(newDims); OMErr(); return NULLOBJ; } /*Set dims*/ DIMS(retVal) = newDims; /*Fill in values for flags and dimensions*/ SETOBJTYPE(retVal -> flags, OBJTYPE(array -> flags)); RANK(retVal) = 1; if (IsRealArray(array)) { real *elements; real *newElements; elements = ELEMENTS(array); /*Make the new elements*/ newElements = (real *) Alloc(sizeof(real) * DIMS(array)[0]); if (!newElements) { OMErr(); return NULLOBJ; } for (s = 0; s < DIMS(array)[0]; ++s) { newElements[s] = elements[s]; } qsort(newElements, DIMS(array)[0], sizeof(real), CR); s = d = 0; ++s; while (s < DIMS(array)[0]) { if (newElements[s] != newElements[d]) { newElements[++d] = newElements[s]; } ++s; } newElements = Realloc(newElements, sizeof(ObjPtr) * (d + 1)); ELEMENTS(retVal) = newElements; } else { ObjPtr *elements; ObjPtr *newElements; elements = ELEMENTS(array); /*Make the new elements*/ newElements = (ObjPtr *) Alloc(sizeof(ObjPtr) * DIMS(array)[0]); if (!newElements) { OMErr(); return NULLOBJ; } for (s = 0; s < DIMS(array)[0]; ++s) { newElements[s] = elements[s]; } qsort(newElements, DIMS(array)[0], sizeof(real), ComparePointers); s = d = 0; ++s; while (s < DIMS(array)[0]) { if (newElements[s] != newElements[d]) { newElements[++d] = newElements[s]; } ++s; } newElements = Realloc(newElements, sizeof(ObjPtr) * (d + 1)); ELEMENTS(retVal) = newElements; } DIMS(retVal)[0] = d + 1; return retVal; } #ifdef PROTO ObjPtr SortArray(ObjPtr array) #else ObjPtr SortArray(array) ObjPtr array; #endif /*Returns array from array sorted by real value or object address. Array must be 1-dimensional.*/ { long *newDims; ObjPtr retVal; long k; if ((!IsObjArray(array) && !IsRealArray(array)) || RANK(array) != 1) { ReportError("SortArray", "This function requires an array of rank 1"); return NULLOBJ; } /*Make the new dims*/ newDims = (long *) Alloc(sizeof(long)); if (!newDims) { OMErr(); return NULLOBJ; } /*Make the array*/ retVal = NewObject(IsRealArray(array) ? realArrayClass : objectArrayClass, sizeof(Array) - sizeof(Obj)); /*If can't, return NIL*/ if (!retVal) { Free(newDims); OMErr(); return NULLOBJ; } /*Set dims*/ DIMS(retVal) = newDims; /*Fill in values for flags and dimensions*/ SETOBJTYPE(retVal -> flags, OBJTYPE(array -> flags)); RANK(retVal) = 1; if (IsRealArray(array)) { real *elements; real *newElements; elements = ELEMENTS(array); /*Make the new elements*/ newElements = (real *) Alloc(sizeof(real) * DIMS(array)[0]); if (!newElements) { OMErr(); return NULLOBJ; } for (k = 0; k < DIMS(array)[0]; ++k) { newElements[k] = elements[k]; } qsort(newElements, DIMS(array)[0], sizeof(real), CR); ELEMENTS(retVal) = newElements; } else { ObjPtr *elements; ObjPtr *newElements; elements = ELEMENTS(array); /*Make the new elements*/ newElements = (ObjPtr *) Alloc(sizeof(ObjPtr) * DIMS(array)[0]); if (!newElements) { OMErr(); return NULLOBJ; } for (k = 0; k < DIMS(array)[0]; ++k) { newElements[k] = elements[k]; } qsort(newElements, DIMS(array)[0], sizeof(real), ComparePointers); ELEMENTS(retVal) = newElements; } DIMS(retVal)[0] = DIMS(array)[0]; return retVal; } #ifdef PROTO ObjPtr RealArrayDeltas(ObjPtr array) #else ObjPtr RealArrayDeltas(array) ObjPtr array; #endif /*Takes a real array of rank one, dimension n. If n is 1, returns an array of dimension 1 with a 0 in it. If n > 1, returns an array of dimension n - 1 where each element is the difference between successive elements of array*/ { ObjPtr retVal; real *sElements, *dElements; long k; if ((!IsRealArray(array)) || RANK(array) != 1) { ReportError("Uniq", "This function requires a real array of rank 1"); return NULLOBJ; } if (DIMS(array)[0] <= 1) { retVal = NewRealArray(1, 1L); *((real *) ELEMENTS(retVal)) = 0.0; return retVal; } /*Make new array*/ retVal = NewRealArray(1, DIMS(array)[0] - 1); /*If can't, return NIL*/ if (!retVal) { return NULLOBJ; } /*Fill in new array*/ sElements = ELEMENTS(array); dElements = ELEMENTS(retVal); for (k = 0; k < DIMS(retVal)[0]; ++k) { dElements[k] = sElements[k + 1] - sElements[k]; } return retVal; } #ifdef PROTO ObjPtr InsertInArray(ObjPtr array, ObjPtr value, long index) #else ObjPtr InsertInArray(array, value, index) ObjPtr array; ObjPtr value; long index; #endif /*Inserts value into a new array like array at index*/ { long *newDims; ObjPtr retVal; int s; if ((!IsObjArray(array) && !IsRealArray(array)) || RANK(array) != 1) { ReportError("InsertInArray", "This function requires an array of rank 1"); return NULLOBJ; } if (IsRealArray(array) && !IsReal(value)) { ReportError("InsertInArray", "You can only insert reals into real arrays"); } /*Make the new dims*/ newDims = (long *) Alloc(sizeof(long)); if (!newDims) { OMErr(); return NULLOBJ; } /*Make the array*/ retVal = NewObject(IsRealArray(array) ? realArrayClass : objectArrayClass, sizeof(Array) - sizeof(Obj)); /*If can't, return NIL*/ if (!retVal) { Free(newDims); OMErr(); return NULLOBJ; } /*Set dims*/ DIMS(retVal) = newDims; DIMS(retVal)[0] = DIMS(array)[0] + 1; /*Fill in values for flags and dimensions*/ SETOBJTYPE(retVal -> flags, OBJTYPE(array -> flags)); RANK(retVal) = 1; if (IsRealArray(array)) { real *elements; real *newElements; elements = ELEMENTS(array); /*Make the new elements*/ newElements = (real *) Alloc(sizeof(real) * (DIMS(array)[0] + 1)); if (!newElements) { OMErr(); return NULLOBJ; } /*Copy the elements*/ for (s = 0; s < index; ++s) { newElements[s] = elements[s]; } newElements[index] = GetReal(value); for (s = index; s < DIMS(array)[0]; ++s) { newElements[s + 1] = elements[s]; } ELEMENTS(retVal) = newElements; } else { ObjPtr *elements; ObjPtr *newElements; elements = ELEMENTS(array); /*Make the new elements*/ newElements = (ObjPtr *) Alloc(sizeof(ObjPtr) * (DIMS(array)[0] + 1)); if (!newElements) { OMErr(); return NULLOBJ; } /*Copy the elements*/ for (s = 0; s < index; ++s) { newElements[s] = elements[s]; } newElements[index] = value; for (s = index; s < DIMS(array)[0]; ++s) { newElements[s + 1] = elements[s]; } ELEMENTS(retVal) = newElements; } return retVal; } #ifdef PROTO ObjPtr InterpArray(ObjPtr interp1, ObjPtr interp2, real weight) #else ObjPtr InterpArray(interp1, interp2, weight) ObjPtr interp1, interp2; real weight; #endif /*Makes a new array that linearly interpolates between interp1 and interp2. Weight is the amount, between 0.0 and 1.0, to favor interp2 over interp1.*/ { register long nels; /*Number of elements in array*/ register int k; /*Random counter*/ long *dimPtr1, *dimPtr2, *dimPtr3; /*Pointer to dimensions and then some*/ register real *interpPtr1, *interpPtr2; register real *destPtr; APtr retVal; real *elements; /*Pointer to the elements*/ long *dims; /*Pointer to dims*/ if ((!IsRealArray(interp1)) || (!IsRealArray(interp2))) { ReportError("InterpArray","Can only interpolate between real arrays"); return NULLOBJ; } if (RANK(interp1) != RANK(interp2)) { ReportError("InterpArray","Rank mismatch"); return NULLOBJ; } nels = 1; dimPtr1 = DIMS(interp1); dimPtr2 = DIMS(interp2); for (k = 0; k < RANK(interp1); ++k) { if (*dimPtr1 != *dimPtr2) { ReportError("InterpArray","Dimension mismatch\n"); return NULLOBJ; } nels *= *dimPtr1; ++dimPtr1; ++dimPtr2; } /*Try to allocate the elements*/ elements = (real *) Alloc(nels * sizeof(real)); /*If can't, return NIL*/ if (!elements) { OMErr(); return NULLOBJ; } /*Try to allocate the dims*/ dims = (long *) Alloc(RANK(interp1) * sizeof(long)); if (!dims) { Free(elements); OMErr(); return NULLOBJ; } /*Make the array*/ retVal = (APtr) NewObject(realArrayClass, sizeof(Array) - sizeof(Obj)); /*If can't, return NIL*/ if (!retVal) { OMErr(); Free(elements); Free(dims); return (ObjPtr) retVal; } /*Make elements and dims*/ ELEMENTS(retVal) = elements; DIMS(retVal) = dims; /*Fill in values for flags and dimensions*/ SETOBJTYPE(retVal -> thing . flags, REALARRAY); retVal -> rank = RANK(interp1); dimPtr1 = DIMS(interp1); dimPtr2 = DIMS(interp2); dimPtr3 = DIMS(retVal); for (k = 0; k < RANK(interp1); ++k) { DIMS(retVal)[k] = DIMS(interp1)[k]; ++dimPtr1; ++dimPtr2; ++dimPtr3; } interpPtr1 = ELEMENTS(interp1); interpPtr2 = ELEMENTS(interp2); destPtr = ELEMENTS(retVal); while (nels) { *destPtr = *interpPtr2 * weight + *interpPtr1 * (1.0 - weight); if (*interpPtr1 == missingData || *interpPtr2 == missingData) { *destPtr = missingData; } ++destPtr; ++interpPtr1; ++interpPtr2; --nels; } return (ObjPtr) retVal; } #ifdef PROTO ObjPtr MergeRealArrays(ObjPtr merge1, ObjPtr merge2) #else ObjPtr MergeRealArrays(merge1, merge2) ObjPtr merge1, merge2; #endif /*Makes a new real array that merges values from merge1 and merge2. Assumes that merge1 and merge2 are already sorted*/ { register long nels1, nels2; /*Number of elements in array*/ register int k; /*Random counter*/ register long s1, s2, d; /*Indices for copy*/ register real *mergePtr1, *mergePtr2; register real *destPtr; APtr retVal; real *elements; /*Pointer to the elements*/ long *dims; /*Pointer to dims*/ if ((!IsRealArray(merge2)) || (!IsRealArray(merge1))) { ReportError("MergeRealArrays", "Can only merge real arrays"); return NULLOBJ; } if (RANK(merge1) != 1 || RANK(merge2) != 1) { ReportError("MergeRealArrays", "Can only merge arrays of rank 1"); return NULLOBJ; } nels1 = DIMS(merge1)[0]; nels2 = DIMS(merge2)[0]; /*Try to allocate the elements*/ elements = (real *) Alloc((nels1 + nels2) * sizeof(real)); /*If can't, return NIL*/ if (!elements) { OMErr(); return NULLOBJ; } /*Try to allocate the dims*/ dims = (long *) Alloc(sizeof(long)); if (!dims) { Free(elements); OMErr(); return NULLOBJ; } dims[0] = nels1 + nels2; /*Make the array*/ retVal = (APtr) NewObject(realArrayClass, sizeof(Array) - sizeof(Obj)); /*If can't, return NIL*/ if (!retVal) { OMErr(); Free(elements); Free(dims); return (ObjPtr) retVal; } /*Make elements and dims*/ ELEMENTS(retVal) = elements; DIMS(retVal) = dims; /*Fill in values for flags and dimensions*/ SETOBJTYPE(retVal -> thing . flags, REALARRAY); retVal -> rank = 1; mergePtr1 = ELEMENTS(merge1); mergePtr2 = ELEMENTS(merge2); destPtr = ELEMENTS(retVal); s1 = 0; s2 = 0; d = 0; while (s1 < nels1 || s2 < nels2) { if (s2 >= nels2) { destPtr[d] = mergePtr1[s1]; ++s1; ++d; } else if (s1 >= nels1) { destPtr[d] = mergePtr2[s2]; ++s2; ++d; } else if (mergePtr1[s1] < mergePtr2[s2]) { destPtr[d] = mergePtr1[s1]; ++s1; ++d; } else { destPtr[d] = mergePtr2[s2]; ++s2; ++d; } } return (ObjPtr) retVal; } void CArray2Array(array, pointer) ObjPtr array; real *pointer; /*Fills array with the data at pointer. It better be right!*/ { long nels; /*Number of elements in array*/ int k; /*Random counter*/ long *dimPtr; /*Pointer to dimensions and then some*/ real *destPtr; /*Pointer to destination within array*/ nels = 1; dimPtr = DIMS(array); for (k = 0; k < RANK(array); ++k) { nels *= *dimPtr; ++dimPtr; } destPtr = ELEMENTS(array); while (nels) { *destPtr = *pointer; ++destPtr; ++pointer; --nels; } } #ifdef PROTO void MinMax(real *min, real *max, real *elements, long nels) #else void MinMax(min, max, elements, nels) real *min; real *max; real *elements; long nels; #endif /*Returns the min and max of nels reals at elements*/ { Bool firstTime = true; while (nels) { if (*elements != missingData) { if (firstTime) { firstTime = false; *min = *max = *elements; } else { if (*elements > *max) *max = *elements; if (*elements < *min) *min = *elements; } } ++elements; --nels; } } void Array2CArray(pointer, array) ObjPtr array; real *pointer; /*Fills data at pointer with array. It better be right!*/ { int nels; /*Number of elements in array*/ int k; /*Random counter*/ long *dimPtr; /*Pointer to dimensions and then some*/ real *srcPtr; /*Pointer to source within array*/ nels = 1; dimPtr = DIMS(array); for (k = 0; k < ((APtr) array) -> rank; ++k) { nels *= *dimPtr; ++dimPtr; } srcPtr = ELEMENTS(array); while (nels) { *pointer = *srcPtr; ++srcPtr; ++pointer; --nels; } } #ifdef PROTO ObjPtr NewRealArray(int rank, ...) #else ObjPtr NewRealArray(rank) int rank; #endif /*Makes a real array with rank rank and long dimensions starting after. For example, to make a 20 by 25 by 30 array, use NewRealArray(3, 20, 25, 30). An array of rank 0 has exactly one element. Arrays of negative rank will return NIL, as will arrays too big to create in memory. Sets every element of the array to zero*/ { long numEls; /*Number of elements in array*/ register int k; /*Counter for random purposes*/ long *dimPtr; /*Pointer to the next dimension*/ APtr retVal; /*Value to return*/ real *runner; /*Runner for setting stuff to 0.0*/ real *elements; /*The elements of the array*/ long *dims; /*The dimensions of the array*/ /*Check for valid rank*/ if (rank < 0) { return (ObjPtr) NIL; } /*Calculate the number of elements*/ dimPtr = (long *) (&rank + 1); numEls = 1; for (k = 0; k < rank; ++k) { numEls *= *dimPtr; ++dimPtr; } /*Try to allocate the elements*/ elements = (real *) Alloc(numEls * sizeof(real)); if (!elements) { OMErr(); return NULLOBJ; } /*Try to allocate the dims*/ dims = 0; if (rank) { dims = (long *) Alloc(rank * sizeof(long)); if (!dims) { Free(elements); OMErr(); return NULLOBJ; } } /*Try to allocate the array*/ retVal = (APtr) NewObject(realArrayClass, sizeof(Array) - sizeof(Obj)); /*If can't, return NIL*/ if (!retVal) { OMErr(); Free(elements); SAFEFREE(dims); return NULLOBJ; } /*Put in the elements and dims*/ ELEMENTS(retVal) = elements; DIMS(retVal) = dims; /*Fill in values for flags and dimensions*/ SETOBJTYPE(retVal -> thing . flags, REALARRAY); RANK(retVal) = rank; dimPtr = (long *) (&rank + 1); for (k = 0; k < rank; ++k) { DIMS(retVal)[k] = *dimPtr; ++dimPtr; } /*Zero the array*/ runner = ArrayMeat((ObjPtr) retVal); while (numEls) { *runner = 0.0; ++runner; --numEls; } return (ObjPtr) retVal; } #ifdef PROTO ObjPtr NewArray(int arrayType, int rank, long *dimensions) #else ObjPtr NewArray(arrayType, rank, dimensions) int arrayType; int rank; long *dimensions; #endif /*Makes an array of arrayType with rank rank and dimensions in an array of longs pointed to by dimensions. Arrays of negative rank will return NIL, as will arrays too big to create in memory. Sets every element of the array to zero or NIL or whatever*/ { long numEls; /*Number of elements in array*/ register int k; /*Counter for random purposes*/ APtr retVal; /*Value to return*/ long *dimPtr; /*Running pointer to dimensions*/ long *dims; /*Pointer to dimensions*/ ObjPtr superClass; /*Check for valid rank*/ if (rank < 0) { return (ObjPtr) NIL; } /*Calculate the number of elements*/ numEls = 1; dimPtr = dimensions; for (k = 0; k < rank; ++k) { numEls *= *dimPtr; ++dimPtr; } /*Try to allocate the array*/ switch(arrayType) { case AT_REAL: superClass = realArrayClass; break; case AT_OBJECT: superClass = objectArrayClass; break; case AT_BYTE: superClass = byteArrayClass; break; case AT_POINTER: superClass = pointerArrayClass; break; case AT_SHORT: superClass = shortArrayClass; break; default: ReportError("NewArray", "Bad array type"); return ObjFalse; } retVal = (APtr) NewObject(superClass, sizeof(Array) - sizeof(Obj)); /*If can't, return NIL*/ if (!retVal) { OMErr(); return (ObjPtr) retVal; } ELEMENTS(retVal) = 0; DIMS(retVal) = 0; /*Try to allocate the elements*/ switch(arrayType) { case AT_REAL: { real *elements; real *runner; elements = (void *) Alloc(numEls * sizeof(real)); /*If can't, return NIL*/ if (!elements) { OMErr(); return NULLOBJ; } /*Put in the elements*/ ELEMENTS(retVal) = elements; /*Fill in values for flags*/ SETOBJTYPE(retVal -> thing . flags, REALARRAY); /*Zero the array*/ runner = elements; while (numEls) { *runner = 0.0; ++runner; --numEls; } } break; case AT_BYTE: { unsigned char *elements; unsigned char *runner; elements = (void *) Alloc(numEls * sizeof(unsigned char)); /*If can't, return NIL*/ if (!elements) { OMErr(); return NULLOBJ; } /*Put in the elements*/ ELEMENTS(retVal) = elements; /*Fill in values for flags*/ SETOBJTYPE(retVal -> thing . flags, OT_BYTEARRAY); /*Zero the array*/ runner = elements; while (numEls) { *runner = 0; ++runner; --numEls; } } break; case AT_SHORT: { short *elements; short *runner; elements = (void *) Alloc(numEls * sizeof(short)); /*If can't, return NIL*/ if (!elements) { OMErr(); return NULLOBJ; } /*Put in the elements*/ ELEMENTS(retVal) = elements; /*Fill in values for flags*/ SETOBJTYPE(retVal -> thing . flags, OT_SHORTARRAY); /*Zero the array*/ runner = elements; while (numEls) { *runner = 0; ++runner; --numEls; } } break; case AT_OBJECT: { ObjPtr *elements; ObjPtr *runner; elements = (void *) Alloc(numEls * sizeof(ObjPtr)); /*If can't, return NIL*/ if (!elements) { OMErr(); return NULLOBJ; } /*Put in the elements*/ ELEMENTS(retVal) = elements; /*Fill in values for flags*/ SETOBJTYPE(retVal -> thing . flags, OBJECTARRAY); /*Zero the array*/ runner = elements; while (numEls) { *runner = NULLOBJ; ++runner; --numEls; } } break; case AT_POINTER: { void **elements; void **runner; elements = (void *) Alloc(numEls * sizeof(ObjPtr)); /*If can't, return NIL*/ if (!elements) { OMErr(); return NULLOBJ; } /*Put in the elements*/ ELEMENTS(retVal) = elements; /*Fill in values for flags*/ SETOBJTYPE(retVal -> thing . flags, OT_POINTERARRAY); /*Zero the array*/ runner = elements; while (numEls) { *runner = NULL; ++runner; --numEls; } } break; default: ReportError("NewArray", "Bad array type"); return NULLOBJ; } /*Try to allocate the dims*/ if (rank) { dims = (long *) Alloc(rank * sizeof(long)); if (!dims) { OMErr(); return NULLOBJ; } } else { dims = 0; } DIMS(retVal) = dims; /*Fill in rank and dimensions*/ retVal -> rank = rank; dimPtr = dimensions; for (k = 0; k < rank; ++k) { retVal -> dims[k] = *dimPtr; ++dimPtr; } return (ObjPtr) retVal; } #ifdef PROTO ObjPtr ListToArray(ObjPtr list) #else ObjPtr ListToArray(list) ObjPtr list; #endif /*Converts a list to a 1-dimensional object array*/ { ObjPtr retVal; long size; ThingListPtr runner; ObjPtr *elements; long k; size = ListCount(list); retVal = NewArray(AT_OBJECT, 1, &size); elements = ELEMENTS(retVal); runner = LISTOF(list); k = 0; while (runner) { elements[k] = runner -> thing; ++k; runner = runner -> next; } return retVal; } static ObjPtr MarkObjectArray(array) ObjPtr array; /*Marks an object array*/ { long nels; long *dimPtr; long k; ObjPtr *meat; if (!IsObjArray(array)) { /*Needed to avoid marking class*/ return ObjFalse; } nels = 1; dimPtr = DIMS(array); for (k = 0; k < RANK(array); ++k) { nels *= *dimPtr; ++dimPtr; } meat = (ObjPtr *) ELEMENTS(array); while (nels) { if (*meat) { MarkObject(*meat); } ++meat; --nels; } return ObjTrue; } static ObjPtr CleanupArray(array) ObjPtr array; /*Cleans up an array by getting rid of its elements*/ { if (ELEMENTS(array)) { Free(ELEMENTS(array)); ELEMENTS(array) = 0; } if (DIMS(array)) { Free(DIMS(array)); DIMS(array) = 0; } return ObjTrue; } static ObjPtr RegisterRealArray(field, whichField) ObjPtr field; int whichField; /*Registers an array field in field slot whichField*/ { Component *component = 0; component = (Component *) Alloc(sizeof(Component)); if (!component) { OMErr(); return ObjFalse; } component -> flags = 0; component -> indices = 0; component -> dimensions = 0; component -> steps = 0; curFields[whichField] . components = component; curFields[whichField] . nComponents = 1; return RegisterComponent(whichField, 0, field) ? ObjTrue : ObjFalse; } static ObjPtr RegisterByteArray(field, whichField) ObjPtr field; int whichField; /*Registers an array field in field slot whichField*/ { Component *component = 0; ObjPtr var; component = (Component *) Alloc(sizeof(Component)); if (!component) { OMErr(); return ObjFalse; } component -> flags = 0; component -> indices = 0; component -> dimensions = 0; component -> steps = 0; curFields[whichField] . components = component; curFields[whichField] . nComponents = 1; return RegisterComponent(whichField, 0, field) ? ObjTrue : ObjFalse; } static ObjPtr RegisterObjectArray(field, whichField) ObjPtr field; int whichField; /*Registers an object array field in field slot whichField*/ { int nComponents; int k; long dimension; Component *component = 0; ObjPtr retVal; if (RANK(field) != 1) { /*Only vectors allowed, bud.*/ ReportError("RegisterObjectArray", "Only vector object arrays can be used in datasets."); return ObjFalse; } nComponents = DIMS(field)[0]; component = (Component *) Alloc(nComponents * sizeof(Component)); if (!component) { OMErr(); return ObjFalse; } for (k = 0; k < nComponents; ++k) { component[k] . flags = 0; component[k] . indices = 0; component[k] . dimensions = 0; component[k] . steps = 0; } retVal = ObjTrue; curFields[whichField] . components = component; curFields[whichField] . nComponents = nComponents; for (dimension = 0; dimension < nComponents; ++dimension) { ObjPtr temp; temp = GetObjectElement(field, &dimension); if (!RegisterComponent(whichField, dimension, temp)) { retVal = false; } } return retVal; } static ObjPtr RegisterByteComponent(field, whichField, whichComponent) ObjPtr field; int whichField, whichComponent; /*Registers an array field in field slot whichField in component whichComponent*/ { Component *component; int *indices = 0; long *dimensions = 0; long *steps = 0; ObjPtr indicesVar; long dataSize; int k; ObjPtr var; /*A scalar array, the simplest type of field*/ if (RANK(field)) { indices = (int *) Alloc(RANK(field) * sizeof(int)); if (!indices) { OMErr(); return ObjFalse; } steps = (long *) Alloc(RANK(field) * sizeof(long)); if (!steps) { Free(indices); OMErr(); return ObjFalse; } dimensions = (long *) Alloc(RANK(field) * sizeof(long)); if (!dimensions) { Free(indices); Free(steps); OMErr(); return ObjFalse; } } else { steps = 0; indices = 0; dimensions = 0; } indicesVar = GetVar(field, INDICES); if (indicesVar) { if (!IsRealArray(indicesVar) || RANK(indicesVar) != 1 || DIMS(indicesVar)[0] != RANK(field)) { ReportError("ReigsterRealComponent", "Bad INDICES variable"); indicesVar = 0; } } component = &(curFields[whichField] . components[whichComponent]); /*Fill in dimensions, indices, and steps*/ dataSize = 1; for (k = RANK(field) - 1; k >= 0; --k) { if (indicesVar) { indices[k] = ((real *) ELEMENTS(indicesVar))[k]; } else { indices[k] = k; } dimensions[k] = DIMS(field)[k]; dataSize *= DIMS(field)[k]; steps[k] = (k == RANK(field) - 1) ? 1 : dimensions[k + 1] * steps[k + 1]; } var = GetVar(field, CTABLE); if (var && IsRealArray(var) && RANK(var) == 1 && DIMS(var)[0] == 256) { Array2CArray(&(component -> cTable), var); } else { for (k = 0; k < 256; ++k) { component -> cTable[k] = (real) k; } } component -> data . comp = ELEMENTS(field); component -> dataCompressed = true; component -> dataSize = dataSize; component -> nIndices = RANK(field); component -> indices = indices; component -> dimensions = dimensions; component -> steps = steps; return ObjTrue; } static ObjPtr RegisterRealComponent(field, whichField, whichComponent) ObjPtr field; int whichField, whichComponent; /*Registers an array field in field slot whichField in component whichComponent*/ { Component *component; int *indices = 0; long *dimensions = 0; long *steps = 0; ObjPtr indicesVar; long dataSize; int k; /*A scalar array, the simplest type of field*/ if (RANK(field)) { indices = (int *) Alloc(RANK(field) * sizeof(int)); if (!indices) { OMErr(); return ObjFalse; } steps = (long *) Alloc(RANK(field) * sizeof(long)); if (!steps) { Free(indices); OMErr(); return ObjFalse; } dimensions = (long *) Alloc(RANK(field) * sizeof(long)); if (!dimensions) { Free(indices); Free(steps); OMErr(); return ObjFalse; } } else { steps = 0; indices = 0; dimensions = 0; } indicesVar = GetVar(field, INDICES); if (indicesVar) { if (!IsRealArray(indicesVar) || RANK(indicesVar) != 1 || DIMS(indicesVar)[0] != RANK(field)) { ReportError("ReigsterRealComponent", "Bad INDICES variable"); indicesVar = 0; } } component = &(curFields[whichField] . components[whichComponent]); /*Fill in dimensions, indices, and steps*/ dataSize = 1; for (k = RANK(field) - 1; k >= 0; --k) { if (indicesVar) { indices[k] = ((real *) ELEMENTS(indicesVar))[k]; } else { indices[k] = k; } dimensions[k] = DIMS(field)[k]; dataSize *= DIMS(field)[k]; steps[k] = (k == RANK(field) - 1) ? 1 : dimensions[k + 1] * steps[k + 1]; } component -> data . unComp = ELEMENTS(field); component -> dataCompressed = false; component -> dataSize = dataSize; component -> nIndices = RANK(field); component -> indices = indices; component -> dimensions = dimensions; component -> steps = steps; return ObjTrue; } ObjPtr GetArrayTopDim(array) ObjPtr array; /*Gets the topological dimension of array*/ { return NewInt(RANK(array)); } ObjPtr GetObjArrayTopDim(array) ObjPtr array; /*Gets the topological dimension of array*/ { FuncTyp method; ObjPtr firstElement; long dimension; dimension = 0; firstElement = GetObjectElement(array, &dimension); method = GetMethod(firstElement, GETTOPDIM); if (method) { return (*method)(firstElement); } else { return NewInt(0); } } #ifdef PROTO ObjPtr GetObjectElement(ObjPtr array, long *dims) #else ObjPtr GetObjectElement(array, dims) ObjPtr array; long *dims; #endif /*Gets a element specified by dims within array, assuming that array is an object array. There had better be enough dims.*/ { long offset; int k; ObjPtr *elements; if (!IsObjArray(array)) { return NULLOBJ; } offset = 0; for (k = 0; k < RANK(array); ++k) { if (k) { offset *= DIMS(array)[k]; } offset += dims[k]; } elements = (ObjPtr *) ELEMENTS(array); /*Hey, John! Put your code in here!*/ return elements[offset]; } #ifdef PROTO void InitArrays(void) #else void InitArrays() #endif /*Initializes the array system*/ { arrayClass = NewObject(NULLOBJ, sizeof(Array) - sizeof(Obj)); ELEMENTS(arrayClass) = 0; DIMS(arrayClass) = 0; AddToReferenceList(arrayClass); SetMethod(arrayClass, CLEANUP, CleanupArray); SetMethod(arrayClass, GETTOPDIM, GetArrayTopDim); realArrayClass = NewObject(arrayClass, sizeof(Array) - sizeof(Obj)); ELEMENTS(realArrayClass) = 0; DIMS(realArrayClass) = 0; AddToReferenceList(realArrayClass); SetMethod(realArrayClass, REGISTERFIELD, RegisterRealArray); SetMethod(realArrayClass, REGISTERCOMP, RegisterRealComponent); #ifdef SOCKETS #if MACHINE == IRIS4D #ifdef FASTSOCKETS fprintf(stderr, "Using fast, raw data sockets\n"); SetMethod(realArrayClass, TRANSMITEXTRA, TransmitExtraStuffRealArrayRaw); SetMethod(realArrayClass, RECEIVEEXTRA, ReceiveExtraStuffRealArrayRaw); #else fprintf(stderr, "Using slow, ascii data sockets\n"); SetMethod(realArrayClass, TRANSMITEXTRA, TransmitExtraStuffRealArrayAscii); SetMethod(realArrayClass, RECEIVEEXTRA, ReceiveExtraStuffRealArrayAscii); #endif #else fprintf(stderr, "Using slow, ascii data sockets\n"); SetMethod(realArrayClass, TRANSMITEXTRA, TransmitExtraStuffRealArrayAscii); SetMethod(realArrayClass, RECEIVEEXTRA, ReceiveExtraStuffRealArrayAscii); #endif #endif byteArrayClass = NewObject(arrayClass, sizeof(Array) - sizeof(Obj)); ELEMENTS(byteArrayClass) = 0; DIMS(byteArrayClass) = 0; AddToReferenceList(byteArrayClass); SetMethod(byteArrayClass, REGISTERFIELD, RegisterByteArray); SetMethod(byteArrayClass, REGISTERCOMP, RegisterByteComponent); pointerArrayClass = NewObject(arrayClass, sizeof(Array) - sizeof(Obj)); ELEMENTS(pointerArrayClass) = 0; DIMS(pointerArrayClass) = 0; AddToReferenceList(pointerArrayClass); shortArrayClass = NewObject(arrayClass, sizeof(Array) - sizeof(Obj)); ELEMENTS(shortArrayClass) = 0; DIMS(shortArrayClass) = 0; AddToReferenceList(shortArrayClass); objectArrayClass = NewObject(arrayClass, sizeof(Array) - sizeof(Obj)); ELEMENTS(objectArrayClass) = 0; DIMS(objectArrayClass) = 0; AddToReferenceList(objectArrayClass); SetMethod(objectArrayClass, MARK, MarkObjectArray); SetMethod(objectArrayClass, REGISTERCOMP, (FuncTyp) 0); SetMethod(objectArrayClass, REGISTERFIELD, RegisterObjectArray); SetMethod(objectArrayClass, GETTOPDIM, GetObjArrayTopDim); #ifdef SOCKETS SetMethod(objectArrayClass, TRANSMITEXTRA, TransmitExtraStuffObjectArray); SetMethod(objectArrayClass, RECEIVEEXTRA, ReceiveExtraStuffObjectArray); #endif } #ifdef PROTO void KillArrays(void) #else void KillArrays() #endif /*Kills the array system*/ { DeleteThing(objectArrayClass); DeleteThing(pointerArrayClass); DeleteThing(byteArrayClass); DeleteThing(realArrayClass); DeleteThing(arrayClass); }