source: trunk/gui/src/RpReadPoints.c @ 3330

Last change on this file since 3330 was 3330, checked in by gah, 10 years ago

merge (by hand) with Rappture1.2 branch

File size: 4.6 KB
Line 
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
25static INLINE const char *
26SkipSpaces(const char *s, const char *endPtr)
27{
28    while ((s < endPtr) && ((*s == ' ') || (*s == '\t'))) {
29        s++;
30    }
31    return s;
32}
33
34static INLINE const char *
35GetLine(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
54int
55GetDouble(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}
90   
91/*
92 *  ReadPoints string dimVar pointsVar
93 */
94static int
95ReadPoints(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        const char *line;
117        int i, argc;
118        const char **argv;
119        char saved;
120        int result;
121
122        p = GetLine(&ds, p, pend);
123        if (Tcl_DStringLength(&ds) == 0) {
124            break;                      /* EOF */
125        }
126        result = Tcl_SplitList(interp, Tcl_DStringValue(&ds), &argc, &argv);
127        if (result != TCL_OK) {
128            goto error;
129        }
130        if (argc == 0) {
131            Tcl_Free((char *)argv);
132            goto error;
133        }
134        if (dim == 0) {
135            dim = argc;
136        }
137        if (dim != argc) {
138            Tcl_AppendResult(interp, "wrong # of elements on line \"",
139                        line, "\"", (char *)NULL);
140            Tcl_Free((char *)argv);
141            goto error;
142        }
143        for (i = 0; i < argc; i++) {
144            double d;
145
146            if (GetDouble(interp, argv[i], &d) != TCL_OK) {
147                Tcl_Free((char *)argv);
148                goto error;
149            }
150            Tcl_ListObjAppendElement(interp, listObjPtr, Tcl_NewDoubleObj(d));
151            count++;
152        }
153        Tcl_Free((char *)argv);
154    }
155    Tcl_DStringFree(&ds);
156    if (Tcl_ObjSetVar2(interp, objv[2], NULL, Tcl_NewIntObj(dim),
157                      TCL_LEAVE_ERR_MSG) == NULL) {
158        return TCL_ERROR;
159    }
160    if (Tcl_ObjSetVar2(interp, objv[3], NULL, listObjPtr,
161                      TCL_LEAVE_ERR_MSG) == NULL) {
162        return TCL_ERROR;
163    }
164    return TCL_OK;
165 error:
166    Tcl_DStringFree(&ds);
167    return TCL_ERROR;
168}
169
170/*
171 * ------------------------------------------------------------------------
172 *  RpReadPoints_Init --
173 *
174 *  Invoked when the Rappture GUI library is being initialized
175 *  to install the "ConvertDxToVtk" command into the interpreter.
176 *
177 *  Returns TCL_OK if successful, or TCL_ERROR (along with an error
178 *  message in the interp) if anything goes wrong.
179 * ------------------------------------------------------------------------
180 */
181int
182RpReadPoints_Init(Tcl_Interp *interp)
183{
184    /* install the widget command */
185    Tcl_CreateObjCommand(interp, "Rappture::ReadPoints", ReadPoints,
186        NULL, NULL);
187    return TCL_OK;
188}
Note: See TracBrowser for help on using the repository browser.