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

Last change on this file since 4503 was 3404, checked in by ldelgass, 8 years ago

Fix compiler warnings

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        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) {
136            Tcl_AppendResult(interp, "wrong # of elements on line", (char *)NULL);
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 */
178int
179RpReadPoints_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}
Note: See TracBrowser for help on using the repository browser.