[3330] | 1 | |
---|
| 2 | /* |
---|
| 3 | * ---------------------------------------------------------------------- |
---|
| 4 | * RpReadPoints - |
---|
| 5 | * |
---|
| 6 | * ====================================================================== |
---|
| 7 | * AUTHOR: Michael McLennan, Purdue University |
---|
| 8 | * Copyright (c) 2004-2012 HUBzero Foundation, LLC |
---|
| 9 | * |
---|
| 10 | * See the file "license.terms" for information on usage and |
---|
| 11 | * redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. |
---|
| 12 | * ====================================================================== |
---|
| 13 | */ |
---|
| 14 | #include <string.h> |
---|
| 15 | #include <stdlib.h> |
---|
| 16 | #include <ctype.h> |
---|
| 17 | #include <math.h> |
---|
| 18 | #include <limits.h> |
---|
| 19 | #include <errno.h> |
---|
| 20 | #include <float.h> |
---|
| 21 | #include "tcl.h" |
---|
| 22 | |
---|
| 23 | #define UCHAR(c) ((unsigned char) (c)) |
---|
| 24 | |
---|
| 25 | static INLINE const char * |
---|
| 26 | SkipSpaces(const char *s, const char *endPtr) |
---|
| 27 | { |
---|
| 28 | while ((s < endPtr) && ((*s == ' ') || (*s == '\t'))) { |
---|
| 29 | s++; |
---|
| 30 | } |
---|
| 31 | return s; |
---|
| 32 | } |
---|
| 33 | |
---|
| 34 | static INLINE const char * |
---|
| 35 | GetLine(Tcl_DString *dsPtr, const char *s, const char *endPtr) |
---|
| 36 | { |
---|
| 37 | const char *line, *p; |
---|
| 38 | Tcl_DStringSetLength(dsPtr, 0); |
---|
| 39 | line = SkipSpaces(s, endPtr); |
---|
| 40 | for (p = line; p < endPtr; p++) { |
---|
| 41 | if (*p == '\n') { |
---|
| 42 | if (p == line) { |
---|
| 43 | line++; |
---|
| 44 | continue; |
---|
| 45 | } |
---|
| 46 | Tcl_DStringAppend(dsPtr, line, p - line); |
---|
| 47 | return p + 1; |
---|
| 48 | } |
---|
| 49 | } |
---|
| 50 | Tcl_DStringAppend(dsPtr, line, p - line); |
---|
| 51 | return p; |
---|
| 52 | } |
---|
| 53 | |
---|
| 54 | int |
---|
| 55 | GetDouble(Tcl_Interp *interp, const char *s, double *valuePtr) |
---|
| 56 | { |
---|
| 57 | char *end; |
---|
| 58 | double d; |
---|
| 59 | |
---|
| 60 | errno = 0; |
---|
| 61 | d = strtod(s, &end); /* INTL: TCL source. */ |
---|
| 62 | if (end == s) { |
---|
| 63 | badDouble: |
---|
| 64 | if (interp != (Tcl_Interp *) NULL) { |
---|
| 65 | Tcl_AppendResult(interp, |
---|
| 66 | "expected floating-point number but got \"", s, "\"", |
---|
| 67 | (char *) NULL); |
---|
| 68 | } |
---|
| 69 | return TCL_ERROR; |
---|
| 70 | } |
---|
| 71 | if (errno != 0 && (d == HUGE_VAL || d == -HUGE_VAL || d == 0)) { |
---|
| 72 | if (interp != (Tcl_Interp *) NULL) { |
---|
| 73 | char msg[64 + TCL_INTEGER_SPACE]; |
---|
| 74 | |
---|
| 75 | sprintf(msg, "unknown floating-point error, errno = %d", errno); |
---|
| 76 | Tcl_AppendToObj(Tcl_GetObjResult(interp), msg, -1); |
---|
| 77 | Tcl_SetErrorCode(interp, "ARITH", "UNKNOWN", msg, (char *) NULL); |
---|
| 78 | } |
---|
| 79 | return TCL_ERROR; |
---|
| 80 | } |
---|
| 81 | while ((*end != 0) && isspace(UCHAR(*end))) { /* INTL: ISO space. */ |
---|
| 82 | end++; |
---|
| 83 | } |
---|
| 84 | if (*end != 0) { |
---|
| 85 | goto badDouble; |
---|
| 86 | } |
---|
| 87 | *valuePtr = d; |
---|
| 88 | return TCL_OK; |
---|
| 89 | } |
---|
[4979] | 90 | |
---|
[3330] | 91 | /* |
---|
| 92 | * ReadPoints string dimVar pointsVar |
---|
| 93 | */ |
---|
| 94 | static int |
---|
| 95 | ReadPoints(ClientData clientData, Tcl_Interp *interp, int objc, |
---|
| 96 | Tcl_Obj *const *objv) |
---|
| 97 | { |
---|
| 98 | Tcl_Obj *listObjPtr; |
---|
| 99 | const char *p, *pend; |
---|
| 100 | const char *string; |
---|
| 101 | int count, length, dim; |
---|
| 102 | Tcl_DString ds; |
---|
| 103 | |
---|
| 104 | if (objc != 4) { |
---|
| 105 | Tcl_AppendResult(interp, "wrong # arguments: should be \"", |
---|
| 106 | Tcl_GetString(objv[0]), " string dimVar pointsVar\"", |
---|
| 107 | (char *)NULL); |
---|
| 108 | return TCL_ERROR; |
---|
| 109 | } |
---|
| 110 | dim = 0; |
---|
| 111 | string = Tcl_GetStringFromObj(objv[1], &length); |
---|
| 112 | count = 0; |
---|
| 113 | Tcl_DStringInit(&ds); |
---|
| 114 | listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **)NULL); |
---|
| 115 | for (p = string, pend = p + length; p < pend; /*empty*/) { |
---|
| 116 | int i, argc; |
---|
| 117 | const char **argv; |
---|
| 118 | int result; |
---|
| 119 | |
---|
| 120 | p = GetLine(&ds, p, pend); |
---|
| 121 | if (Tcl_DStringLength(&ds) == 0) { |
---|
| 122 | break; /* EOF */ |
---|
| 123 | } |
---|
| 124 | result = Tcl_SplitList(interp, Tcl_DStringValue(&ds), &argc, &argv); |
---|
| 125 | if (result != TCL_OK) { |
---|
| 126 | goto error; |
---|
| 127 | } |
---|
| 128 | if (argc == 0) { |
---|
| 129 | Tcl_Free((char *)argv); |
---|
| 130 | goto error; |
---|
| 131 | } |
---|
| 132 | if (dim == 0) { |
---|
| 133 | dim = argc; |
---|
| 134 | } |
---|
| 135 | if (dim != argc) { |
---|
[3404] | 136 | Tcl_AppendResult(interp, "wrong # of elements on line", (char *)NULL); |
---|
[3330] | 137 | Tcl_Free((char *)argv); |
---|
| 138 | goto error; |
---|
| 139 | } |
---|
| 140 | for (i = 0; i < argc; i++) { |
---|
| 141 | double d; |
---|
| 142 | |
---|
| 143 | if (GetDouble(interp, argv[i], &d) != TCL_OK) { |
---|
| 144 | Tcl_Free((char *)argv); |
---|
| 145 | goto error; |
---|
| 146 | } |
---|
| 147 | Tcl_ListObjAppendElement(interp, listObjPtr, Tcl_NewDoubleObj(d)); |
---|
| 148 | count++; |
---|
| 149 | } |
---|
| 150 | Tcl_Free((char *)argv); |
---|
| 151 | } |
---|
| 152 | Tcl_DStringFree(&ds); |
---|
| 153 | if (Tcl_ObjSetVar2(interp, objv[2], NULL, Tcl_NewIntObj(dim), |
---|
| 154 | TCL_LEAVE_ERR_MSG) == NULL) { |
---|
| 155 | return TCL_ERROR; |
---|
| 156 | } |
---|
| 157 | if (Tcl_ObjSetVar2(interp, objv[3], NULL, listObjPtr, |
---|
| 158 | TCL_LEAVE_ERR_MSG) == NULL) { |
---|
| 159 | return TCL_ERROR; |
---|
| 160 | } |
---|
| 161 | return TCL_OK; |
---|
| 162 | error: |
---|
| 163 | Tcl_DStringFree(&ds); |
---|
| 164 | return TCL_ERROR; |
---|
| 165 | } |
---|
| 166 | |
---|
| 167 | /* |
---|
| 168 | * ------------------------------------------------------------------------ |
---|
| 169 | * RpReadPoints_Init -- |
---|
| 170 | * |
---|
| 171 | * Invoked when the Rappture GUI library is being initialized |
---|
| 172 | * to install the "ConvertDxToVtk" command into the interpreter. |
---|
| 173 | * |
---|
| 174 | * Returns TCL_OK if successful, or TCL_ERROR (along with an error |
---|
| 175 | * message in the interp) if anything goes wrong. |
---|
| 176 | * ------------------------------------------------------------------------ |
---|
| 177 | */ |
---|
| 178 | int |
---|
| 179 | RpReadPoints_Init(Tcl_Interp *interp) |
---|
| 180 | { |
---|
| 181 | /* install the widget command */ |
---|
| 182 | Tcl_CreateObjCommand(interp, "Rappture::ReadPoints", ReadPoints, |
---|
| 183 | NULL, NULL); |
---|
| 184 | return TCL_OK; |
---|
| 185 | } |
---|