1 /*
2 * tclgeomapTime.c --
3 *
4 * This file defines the structures and functions that add the ability
5 * to manage time Tclgeomap.
6 *
7 * Copyright (c) 2006 Gordon D. Carrie. All rights reserved.
8 *
9 * Licensed under the Open Software License version 2.1
10 *
11 * Please address questions and feedback to user0@tkgeomap.org
12 *
13 * @(#) $Id: tclgeomapTime.c,v 1.6 2006/10/10 17:46:09 tkgeomap Exp $
14 *
15 ********************************************
16 *
17 */
18
19 #include "tclgeomap.h"
20 #include "tclgeomapInt.h"
21
22 /*
23 * Forward declarations
24 */
25
26 static int callback _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp,
27 int objc, Tcl_Obj *CONST objv[]));
28 static int jul_to_cal _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp,
29 int objc, Tcl_Obj *CONST objv[]));
30 static int cal_to_jul _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp,
31 int objc, Tcl_Obj *CONST objv[]));
32 static int incr _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp,
33 int objc, Tcl_Obj *CONST objv[]));
34 static int cmp _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp,
35 int objc, Tcl_Obj *CONST objv[]));
36 static int diff _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp,
37 int objc, Tcl_Obj *CONST objv[]));
38
39 /*
40 *------------------------------------------------------------------------
41 *
42 * TclgeomapTimeInit --
43 *
44 * This procedure initializes the Tclgeomap_Time interface and provides
45 * the tclgeotime package.
46 *
47 * Results:
48 * A standard Tcl result.
49 *
50 * Side effects:
51 * The "geomap::time" command is added to the interpreter.
52 *
53 *------------------------------------------------------------------------
54 */
55
56 int
TclgeomapTimeInit(interp)57 TclgeomapTimeInit(interp)
58 Tcl_Interp *interp; /* Current Tcl interpreter */
59 {
60 static int loaded; /* Tell if package already loaded */
61
62 if (loaded) {
63 return TCL_OK;
64 }
65 #ifdef USE_TCL_STUBS
66 if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
67 return TCL_ERROR;
68 }
69 #endif
70 Tcl_CreateObjCommand(interp, "::geomap::time", callback, NULL, NULL);
71 loaded = 1;
72 return TCL_OK;
73 }
74
75 /*
76 *------------------------------------------------------------------------
77 *
78 * callback --
79 *
80 * This is the callback for the "geomap::time" command.
81 *
82 * Results:
83 * A standard Tcl result.
84 *
85 * Side effects:
86 * This procedure invokes the callback corresponding to the first
87 * argument given to the "geomap::time" command. Side effects depend
88 * on the subcommand called.
89 *
90 *------------------------------------------------------------------------
91 */
92
93 int
callback(clientData,interp,objc,objv)94 callback(clientData, interp, objc, objv)
95 ClientData clientData; /* Not used */
96 Tcl_Interp *interp; /* Current interpreter */
97 int objc; /* Number of arguments */
98 Tcl_Obj *const objv[]; /* Argument objects */
99 {
100 char *nmPtr[] = {
101 "jul_to_cal", "cal_to_jul", "incr", "cmp", "diff", NULL
102 };
103 Tcl_ObjCmdProc *procPtr[] = {
104 jul_to_cal, cal_to_jul, incr, cmp, diff
105 };
106 int i;
107
108 if (objc < 2) {
109 Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
110 return TCL_ERROR;
111 }
112 if (Tcl_GetIndexFromObj(interp, objv[1], nmPtr, "subcommand", 0, &i)
113 != TCL_OK) {
114 return TCL_ERROR;
115 }
116 return (procPtr[i])(NULL, interp, objc, objv);
117 }
118
119 /*
120 *------------------------------------------------------------------------
121 *
122 * jul_to_cal --
123 *
124 * This is the callback for the "geomap::time jul_to_cal" command.
125 *
126 * Results:
127 * A standard Tcl result.
128 *
129 * Side effects:
130 * Interpreter result will be set. See the user documentation.
131 *
132 *------------------------------------------------------------------------
133 */
134
135 int
jul_to_cal(clientData,interp,objc,objv)136 jul_to_cal(clientData, interp, objc, objv)
137 ClientData clientData; /* Not used */
138 Tcl_Interp *interp; /* The current interpreter */
139 int objc; /* Number of arguments */
140 Tcl_Obj *const objv[]; /* Argument objects */
141 {
142 Tcl_Obj *dayObj, *secObj; /* Julian day and seconds from command
143 * line */
144 int day; /* Julian day from command line */
145 double second; /* Seconds from command line */
146
147 if (objc != 3) {
148 Tcl_WrongNumArgs(interp, 2, objv, "{julian_day second}");
149 return TCL_ERROR;
150 }
151 if (Tcl_ListObjIndex(interp, objv[2], 0, &dayObj) != TCL_OK || !dayObj) {
152 Tcl_AppendResult(interp, "Julian time must be in form {day second}",
153 NULL);
154 return TCL_ERROR;
155 }
156 if (Tcl_GetIntFromObj(interp, dayObj, &day) != TCL_OK) {
157 return TCL_ERROR;
158 }
159 if (Tcl_ListObjIndex(interp, objv[2], 1, &secObj) != TCL_OK || !secObj) {
160 Tcl_AppendResult(interp, "Julian time must be in form {day second}",
161 NULL);
162 return TCL_ERROR;
163 }
164 if (Tcl_GetDoubleFromObj(interp, secObj, &second) != TCL_OK) {
165 return TCL_ERROR;
166 }
167 Tcl_SetObjResult(interp,
168 Tclgeomap_NewGeoTimeObj(GeoTime_JulSet(day, second)));
169 return TCL_OK;
170 }
171
172 /*
173 *------------------------------------------------------------------------
174 *
175 * cal_to_jul --
176 *
177 * This is the callback for the "geomap::time cal_to_jul" command.
178 *
179 * Results:
180 * A standard Tcl result.
181 *
182 * Side effects:
183 * Interpreter result will be set. See the user documentation.
184 *
185 *------------------------------------------------------------------------
186 */
187
188 int
cal_to_jul(clientData,interp,objc,objv)189 cal_to_jul(clientData, interp, objc, objv)
190 ClientData clientData; /* Not used */
191 Tcl_Interp *interp; /* The current interpreter */
192 int objc; /* Number of arguments */
193 Tcl_Obj *const objv[]; /* Argument objects */
194 {
195 struct GeoTime_Jul jul; /* Days and seconds in cal */
196 Tcl_Obj *result; /* Return value {day sec} */
197
198 if (objc != 3) {
199 Tcl_WrongNumArgs(interp, 1, objv,
200 "{year month day hour minute second}");
201 return TCL_ERROR;
202 }
203 if (Tclgeomap_GetGeoTimeFromObj(interp, objv[2], &jul)) {
204 return TCL_ERROR;
205 }
206 result = Tcl_NewObj();
207 Tcl_ListObjAppendElement(NULL, result, Tcl_NewIntObj(jul.day));
208 Tcl_ListObjAppendElement(NULL, result, Tcl_NewDoubleObj(jul.second));
209 Tcl_SetObjResult(interp, result);
210 return TCL_OK;
211 }
212
213 /*
214 *------------------------------------------------------------------------
215 *
216 * incr --
217 *
218 * This is the callback for the "geomap::time incr" command.
219 *
220 * Results:
221 * A standard Tcl result.
222 *
223 * Side effects:
224 * Interpreter result will be set. See the user documentation.
225 *
226 *------------------------------------------------------------------------
227 */
228
229 int
incr(clientData,interp,objc,objv)230 incr(clientData, interp, objc, objv)
231 ClientData clientData; /* Not used */
232 Tcl_Interp *interp; /* The current interpreter */
233 int objc; /* Number of arguments */
234 Tcl_Obj *const objv[]; /* Argument objects */
235 {
236 struct GeoTime_Jul jul; /* Time from command line */
237 double dt; /* Time increment */
238
239 if (objc != 4) {
240 Tcl_WrongNumArgs(interp, 1, objv,
241 "{year month day hour minute second} seconds");
242 return TCL_ERROR;
243 }
244 if (Tclgeomap_GetGeoTimeFromObj(interp, objv[2], &jul)) {
245 return TCL_ERROR;
246 }
247 if (Tcl_GetDoubleFromObj(interp, objv[3], &dt)) {
248 return TCL_ERROR;
249 }
250 GeoTime_Incr(&jul, dt);
251 Tcl_SetObjResult(interp, Tclgeomap_NewGeoTimeObj(jul));
252 return TCL_OK;
253 }
254
255 /*
256 *------------------------------------------------------------------------
257 *
258 * cmp --
259 *
260 * This is the callback for the "geomap::time cmp" command.
261 *
262 * Results:
263 * A standard Tcl result.
264 *
265 * Side effects:
266 * Interpreter result will be set. See the user documentation.
267 *
268 *------------------------------------------------------------------------
269 */
270
271 int
cmp(clientData,interp,objc,objv)272 cmp(clientData, interp, objc, objv)
273 ClientData clientData; /* Not used */
274 Tcl_Interp *interp; /* The current interpreter */
275 int objc; /* Number of arguments */
276 Tcl_Obj *const objv[]; /* Argument objects */
277 {
278 struct GeoTime_Jul jul1, jul2; /* Times from command line */
279
280 if (objc != 4) {
281 Tcl_WrongNumArgs(interp, 1, objv,
282 "{year1 month1 day1 hour1 minute1 second1} "
283 "{year2 month2 day2 hour2 minute2 second2}");
284 return TCL_ERROR;
285 }
286 if (Tclgeomap_GetGeoTimeFromObj(interp, objv[2], &jul1)) {
287 return TCL_ERROR;
288 }
289 if (Tclgeomap_GetGeoTimeFromObj(interp, objv[3], &jul2)) {
290 return TCL_ERROR;
291 }
292 Tcl_SetObjResult(interp, Tcl_NewIntObj(GeoTime_Cmp(jul1, jul2)));
293 return TCL_OK;
294 }
295
296 /*
297 *------------------------------------------------------------------------
298 *
299 * diff --
300 *
301 * This is the callback for the "geomap::time diff" command.
302 *
303 * Results:
304 * A standard Tcl result.
305 *
306 * Side effects:
307 * Interpreter result will be set. See the user documentation.
308 *
309 *------------------------------------------------------------------------
310 */
311
312 int
diff(clientData,interp,objc,objv)313 diff(clientData, interp, objc, objv)
314 ClientData clientData; /* Not used */
315 Tcl_Interp *interp; /* The current interpreter */
316 int objc; /* Number of arguments */
317 Tcl_Obj *const objv[]; /* Argument objects */
318 {
319 struct GeoTime_Jul jul1, jul2; /* Times from command line */
320
321 if (objc != 4) {
322 Tcl_WrongNumArgs(interp, 1, objv,
323 "{year1 month1 day1 hour1 minute1 second1} "
324 "{year2 month2 day2 hour2 minute2 second2}");
325 return TCL_ERROR;
326 }
327 if (Tclgeomap_GetGeoTimeFromObj(interp, objv[2], &jul1)) {
328 return TCL_ERROR;
329 }
330 if (Tclgeomap_GetGeoTimeFromObj(interp, objv[3], &jul2)) {
331 return TCL_ERROR;
332 }
333 Tcl_SetObjResult(interp, Tcl_NewDoubleObj(GeoTime_Diff(jul1, jul2)));
334 return TCL_OK;
335 }
336