File: tcl_typemap.c

package info (click to toggle)
pd-tclpd 0.3.0-3
  • links: PTS, VCS
  • area: main
  • in suites: bullseye, buster, sid
  • size: 368 kB
  • sloc: tcl: 1,565; ansic: 1,190; makefile: 401
file content (194 lines) | stat: -rw-r--r-- 4,981 bytes parent folder | download | duplicates (2)
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
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
#include "tclpd.h"
#include <string.h>
#include <stdlib.h>

static const char *atomtype_map[] = {
  /* A_NULL */     "null",
  /* A_FLOAT */    "float",
  /* A_SYMBOL */   "symbol",
  /* A_POINTER */  "pointer",
  /* A_SEMI */     "semi",
  /* A_COMMA */    "comma",
  /* A_DEFFLOAT */ "deffloat",
  /* A_DEFSYM */   "defsym",
  /* A_DOLLAR */   "dollar",
  /* A_DOLLSYM */  "dollsym",
  /* A_GIMME */    "gimme",
  /* A_CANT */     "cant",
#ifdef A_BLOB
  /* A_BLOB */     "blob"
#endif
};

#define atomtype_map_size (sizeof(atomtype_map)/sizeof(atomtype_map[0]))

static const char * fwd_atomtype_map(t_atomtype t) {
    if(t >= atomtype_map_size) return atomtype_map[A_NULL];
    return atomtype_map[t];
}

static t_atomtype rev_atomtype_map(const char *s) {
    for(t_atomtype i = 0; i < atomtype_map_size; i++) {
        if(strcmp(s, atomtype_map[i]) == 0) return i;
    }
    return A_NULL;
}

int tcl_to_pdatom(Tcl_Obj *input, t_atom *output) {
    int llength;
    if(Tcl_ListObjLength(tclpd_interp, input, &llength) == TCL_ERROR)
        return TCL_ERROR;
    if(llength != 2)
        return TCL_ERROR;

    int i;
    Tcl_Obj *obj[2];
    for(i = 0; i < 2; i++) Tcl_ListObjIndex(tclpd_interp, input, i, &obj[i]);
    char *argv0 = Tcl_GetStringFromObj(obj[0], 0);

    t_atomtype a_type = rev_atomtype_map(argv0);

    switch(a_type) {
        case A_FLOAT:
        case A_DEFFLOAT:
        {
            double dbl;
            if(Tcl_GetDoubleFromObj(tclpd_interp, obj[1], &dbl) == TCL_ERROR)
                return TCL_ERROR;
            SETFLOAT(output, dbl);
            break;
        }
        case A_SYMBOL:
        case A_DEFSYM:
        {
            SETSYMBOL(output, gensym(Tcl_GetStringFromObj(obj[1], 0)));
            break;
        }
        case A_POINTER:
        {
            long gpointer;
            if(Tcl_GetLongFromObj(tclpd_interp, obj[1], &gpointer) == TCL_ERROR)
                return TCL_ERROR;
            SETPOINTER(output, (t_gpointer *)gpointer);
            break;
        }
        case A_SEMI:
        {
            SETSEMI(output);
            break;
        }
        case A_COMMA:
        {
            SETCOMMA(output);
            break;
        }
        case A_DOLLAR:
        {
            char *str = Tcl_GetStringFromObj(obj[1], 0);
            if(!str) {
                return TCL_ERROR;
            }
            if(*str == '$') str++;
            int ii = atoi(str);
            SETDOLLAR(output, ii);
            break;
        }
        case A_DOLLSYM:
        {
            SETSYMBOL(output, gensym(Tcl_GetStringFromObj(obj[1], 0)));
            break;
        }
        // case A_GIMME:
        // case A_CANT:
        // case A_BLOB:
        // case A_NULL:
        default:
        {
            // TODO: set error result
            return TCL_ERROR;
        }
    }

    return TCL_OK;
}

int tcl_to_pdsymbol(Tcl_Obj *input, t_symbol **output) {
    char *s = Tcl_GetStringFromObj(input, 0);
    *output = gensym(s);
    return TCL_OK;
}

int pdatom_to_tcl(t_atom *input, Tcl_Obj **output) {
    Tcl_Obj *tcl_t_atom[2];
    tcl_t_atom[0] = Tcl_NewStringObj(fwd_atomtype_map(input->a_type), -1);
    switch (input->a_type) {
        case A_FLOAT:
        case A_DEFFLOAT:
        {
            tcl_t_atom[1] = Tcl_NewDoubleObj(input->a_w.w_float);
            break;
        }
        case A_SYMBOL:
        case A_DEFSYM:
        case A_DOLLSYM:
        {
            tcl_t_atom[1] = Tcl_NewStringObj(input->a_w.w_symbol->s_name, strlen(input->a_w.w_symbol->s_name));
            break;
        }
        case A_POINTER:
        {
            tcl_t_atom[1] = Tcl_NewDoubleObj((long)input->a_w.w_gpointer);
            break;
        }
        case A_DOLLAR:
        {
            char dolbuf[8];
            snprintf(dolbuf, 8, "$%d", (int)input->a_w.w_index);
            tcl_t_atom[1] = Tcl_NewStringObj(dolbuf, -1);
            break;
        }
        case A_SEMI:
        {
            tcl_t_atom[1] = Tcl_NewStringObj(";", 1);
            break;
        }
        case A_COMMA:
        {
            tcl_t_atom[1] = Tcl_NewStringObj(",", 1);
            break;
        }
        case A_GIMME:
        case A_CANT:
#ifdef A_BLOB
        case A_BLOB:
#endif
        case A_NULL:
        default:
        {
            tcl_t_atom[1] = Tcl_NewStringObj("?", 1);
            break;
        }
    }
#if 0
    verbose(-1, "tclpd: pdatom_to_tcl: atom [type = %s, value = %s]",
        Tcl_GetStringFromObj(tcl_t_atom[0], 0),
        Tcl_GetStringFromObj(tcl_t_atom[1], 0));
#endif
    *output = Tcl_NewListObj(2, &tcl_t_atom[0]);
    Tcl_IncrRefCount(*output);
    return TCL_OK;
}

int pdsymbol_to_tcl(t_symbol *input, Tcl_Obj **output) {
#if 0
    Tcl_Obj *s[2];
    s[0] = Tcl_NewStringObj("symbol", -1);
    s[1] = Tcl_NewStringObj(input->s_name, -1);
    *output = Tcl_NewListObj(2, &s[0]);
#else
    *output = Tcl_NewStringObj(input->s_name, -1);
#endif
    Tcl_IncrRefCount(*output);
    return TCL_OK;
}