1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
|
## -*- tcl -*-
# ### ### ### ######### ######### #########
## Support declarations
# ### ### ### ######### ######### #########
## Type definitions
critcl::resulttype point {
Tcl_SetObjResult(interp, point_box (interp, &rv));
return TCL_OK;
} point
critcl::argtype point {
if (point_unbox (interp, @@, &@A) != TCL_OK) return TCL_ERROR;
} point point
# ### ### ### ######### ######### #########
## Support implementation
critcl::ccode {
#include <stdio.h>
typedef struct point {
double y;
double x;
} point;
static int
point_unbox (Tcl_Interp* interp, Tcl_Obj* obj, point* p)
{
Tcl_Size lc;
Tcl_Obj** lv;
if (Tcl_ListObjGetElements (interp, obj, &lc, &lv) != TCL_OK) /* OK tcl9 */
return TCL_ERROR;
if (lc != 2) {
Tcl_SetErrorCode (interp, "MAP", "SLIPPY", "INVALID", "POINT", NULL);
Tcl_AppendResult (interp, "Bad point, expected list of 2", NULL);
return TCL_ERROR;
}
double y;
double x;
if (Tcl_GetDoubleFromObj (interp, lv[0], &x) != TCL_OK) return TCL_ERROR;
if (Tcl_GetDoubleFromObj (interp, lv[1], &y) != TCL_OK) return TCL_ERROR;
p->y = y;
p->x = x;
return TCL_OK;
}
static Tcl_Obj*
point_box (Tcl_Interp* interp, point* p)
{
Tcl_Obj* cl[2];
cl [0] = Tcl_NewDoubleObj (p->x);
cl [1] = Tcl_NewDoubleObj (p->y);
return Tcl_NewListObj(2, cl); /* OK tcl9 */
}
static Tcl_Obj*
point_box_list (int release, Tcl_Interp* interp, Tcl_Size c, point* points)
{
Tcl_Obj** cl = (Tcl_Obj**) ckalloc (c * sizeof(Tcl_Obj*));
unsigned int k;
for (k = 0; k < c; k++) \
cl[k] = point_box (interp, &points[k]);
Tcl_Obj* r = Tcl_NewListObj(c, cl); /* OK tcl9 */
ckfree (cl);
if (release) { ckfree (points); }
return r;
}
}
# ### ### ### ######### ######### #########
return
|
