x_list.c 24.1 KB
Newer Older
Miller Puckette's avatar
Miller Puckette committed
1 2 3 4
/* Copyright (c) 1997- Miller Puckette and others.
* For information on usage and redistribution, and for a DISCLAIMER OF ALL
* WARRANTIES, see the file, "LICENSE.txt," in this distribution.  */

Hans-Christoph Steiner's avatar
Hans-Christoph Steiner committed
5 6
#include "config.h"

Miller Puckette's avatar
Miller Puckette committed
7
#include "m_pd.h"
8
#include "s_stuff.h"
9
#include <string.h>
Hans-Christoph Steiner's avatar
Hans-Christoph Steiner committed
10 11

#ifdef HAVE_MALLOC_H
Miller Puckette's avatar
Miller Puckette committed
12
#include <malloc.h>
Hans-Christoph Steiner's avatar
Hans-Christoph Steiner committed
13 14 15
#endif

#ifdef HAVE_ALLOCA_H
Miller Puckette's avatar
Miller Puckette committed
16 17 18 19 20
#include <alloca.h>
#endif

extern t_pd *newest;

21 22 23 24
#ifndef HAVE_ALLOCA     /* can work without alloca() but we never need it */
#define HAVE_ALLOCA 1
#endif

Miller Puckette's avatar
Miller Puckette committed
25 26 27 28 29 30
#define LIST_NGETBYTE 100 /* bigger that this we use alloc, not alloca */

/* the "list" object family.

    list append - append a list to another
    list prepend - prepend a list to another
31
    list split - first n elements to first outlet, rest to second outlet
Miller Puckette's avatar
Miller Puckette committed
32 33
    list trim - trim off "list" selector
    list length - output number of items in list
34
    list fromsymbol - "explode" a symbol into a list of character codes
Ivica Bukvic's avatar
Ivica Bukvic committed
35
    list cat - build a list by accumulating elements
Miller Puckette's avatar
Miller Puckette committed
36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51

Need to think more about:
    list foreach - spit out elements of a list one by one (also in reverse?)
    list array - get items from a named array as a list
    list reverse - permute elements of a list back to front
    list pack - synonym for 'pack'
    list unpack - synonym for 'unpack'

Probably don't need:
    list first - output first n elements.
    list last - output last n elements
    list nth - nth item in list, counting from zero
*/

/* -------------- utility functions: storage, copying  -------------- */

52 53 54 55 56 57 58 59 60 61
#if HAVE_ALLOCA
#define ATOMS_ALLOCA(x, n) ((x) = (t_atom *)((n) < LIST_NGETBYTE ?  \
        alloca((n) * sizeof(t_atom)) : getbytes((n) * sizeof(t_atom))))
#define ATOMS_FREEA(x, n) ( \
    ((n) < LIST_NGETBYTE || (freebytes((x), (n) * sizeof(t_atom)), 0)))
#else
#define ATOMS_ALLOCA(x, n) ((x) = (t_atom *)getbytes((n) * sizeof(t_atom)))
#define ATOMS_FREEA(x, n) (freebytes((x), (n) * sizeof(t_atom)))
#endif

62
void atoms_copy(int argc, t_atom *from, t_atom *to)
Miller Puckette's avatar
Miller Puckette committed
63 64 65 66 67 68 69 70 71 72
{
    int i;
    for (i = 0; i < argc; i++)
        to[i] = from[i];
}

/* ------------- fake class to divert inlets to ----------------- */

t_class *alist_class;

73
void alist_init(t_alist *x)
Miller Puckette's avatar
Miller Puckette committed
74 75 76 77 78 79
{
    x->l_pd = alist_class;
    x->l_n = x->l_npointer = 0;
    x->l_vec = 0;
}

80
void alist_clear(t_alist *x)
Miller Puckette's avatar
Miller Puckette committed
81
{
Jonathan Wilkes's avatar
Jonathan Wilkes committed
82 83
    int i;
    for (i = 0; i < x->l_n; i++)
84
    {
Jonathan Wilkes's avatar
Jonathan Wilkes committed
85 86 87 88 89 90 91 92 93 94 95 96 97 98 99
        if (x->l_vec[i].l_a.a_type == A_POINTER)
            gpointer_unset(x->l_vec[i].l_a.a_w.w_gpointer);
    }
    if (x->l_vec)
        freebytes(x->l_vec, x->l_n * sizeof(*x->l_vec));
}

static void alist_copyin(t_alist *x, t_symbol *s, int argc, t_atom *argv,
    int where)
{
    int i, j;
    for (i = 0, j = where; i < argc; i++, j++)
    {
        x->l_vec[j].l_a = argv[i];
        if (x->l_vec[j].l_a.a_type == A_POINTER)
100
        {
Jonathan Wilkes's avatar
Jonathan Wilkes committed
101 102 103
            x->l_npointer++;
            gpointer_copy(x->l_vec[j].l_a.a_w.w_gpointer, &x->l_vec[j].l_p);
            x->l_vec[j].l_a.a_w.w_gpointer = &x->l_vec[j].l_p;
104 105
        }
    }
Miller Puckette's avatar
Miller Puckette committed
106 107
}

Jonathan Wilkes's avatar
Jonathan Wilkes committed
108
    /* set contents to a list */
109
void alist_list(t_alist *x, t_symbol *s, int argc, t_atom *argv)
Miller Puckette's avatar
Miller Puckette committed
110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132
{
    int i;
    alist_clear(x);
    if (!(x->l_vec = (t_listelem *)getbytes(argc * sizeof(*x->l_vec))))
    {
        x->l_n = 0;
        error("list_alloc: out of memory");
        return;
    }
    x->l_n = argc;
    x->l_npointer = 0;
    for (i = 0; i < argc; i++)
    {
        x->l_vec[i].l_a = argv[i];
        if (x->l_vec[i].l_a.a_type == A_POINTER)
        {
            x->l_npointer++;
            gpointer_copy(x->l_vec[i].l_a.a_w.w_gpointer, &x->l_vec[i].l_p);
            x->l_vec[i].l_a.a_w.w_gpointer = &x->l_vec[i].l_p;
        }
    }
}

Jonathan Wilkes's avatar
Jonathan Wilkes committed
133
    /* set contents to an arbitrary non-list message */
134
void alist_anything(t_alist *x, t_symbol *s, int argc, t_atom *argv)
Miller Puckette's avatar
Miller Puckette committed
135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153
{
    int i;
    alist_clear(x);
    if (!(x->l_vec = (t_listelem *)getbytes((argc+1) * sizeof(*x->l_vec))))
    {
        x->l_n = 0;
        error("list_alloc: out of memory");
        return;
    }
    x->l_n = argc+1;
    x->l_npointer = 0;
    SETSYMBOL(&x->l_vec[0].l_a, s);
    for (i = 0; i < argc; i++)
    {
        x->l_vec[i+1].l_a = argv[i];
        if (x->l_vec[i+1].l_a.a_type == A_POINTER)
        {
            x->l_npointer++;            
            gpointer_copy(x->l_vec[i+1].l_a.a_w.w_gpointer, &x->l_vec[i+1].l_p);
154
            x->l_vec[i+1].l_a.a_w.w_gpointer = &x->l_vec[i+1].l_p;
Miller Puckette's avatar
Miller Puckette committed
155 156 157 158
        }
    }
}

Jonathan Wilkes's avatar
Jonathan Wilkes committed
159
void alist_toatoms(t_alist *x, t_atom *to, int onset, int count)
Miller Puckette's avatar
Miller Puckette committed
160 161
{
    int i;
Jonathan Wilkes's avatar
Jonathan Wilkes committed
162 163
    for (i = 0; i < count; i++)
        to[i] = x->l_vec[onset + i].l_a;
Miller Puckette's avatar
Miller Puckette committed
164 165
}

Jonathan Wilkes's avatar
Jonathan Wilkes committed
166
void alist_clone(t_alist *x, t_alist *y, int onset, int count)
Miller Puckette's avatar
Miller Puckette committed
167 168 169
{
    int i;
    y->l_pd = alist_class;
Jonathan Wilkes's avatar
Jonathan Wilkes committed
170 171
    y->l_n = count;
    y->l_npointer = 0;
Miller Puckette's avatar
Miller Puckette committed
172 173 174 175 176
    if (!(y->l_vec = (t_listelem *)getbytes(y->l_n * sizeof(*y->l_vec))))
    {
        y->l_n = 0;
        error("list_alloc: out of memory");
    }
Jonathan Wilkes's avatar
Jonathan Wilkes committed
177
    else for (i = 0; i < count; i++)
Miller Puckette's avatar
Miller Puckette committed
178
    {
Jonathan Wilkes's avatar
Jonathan Wilkes committed
179
        y->l_vec[i].l_a = x->l_vec[onset + i].l_a;
Miller Puckette's avatar
Miller Puckette committed
180 181 182 183
        if (y->l_vec[i].l_a.a_type == A_POINTER)
        {
            gpointer_copy(y->l_vec[i].l_a.a_w.w_gpointer, &y->l_vec[i].l_p);
            y->l_vec[i].l_a.a_w.w_gpointer = &y->l_vec[i].l_p;
Jonathan Wilkes's avatar
Jonathan Wilkes committed
184
            y->l_npointer++;
Miller Puckette's avatar
Miller Puckette committed
185 186 187 188
        }
    }
}

189
void alist_setup(void)
Miller Puckette's avatar
Miller Puckette committed
190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220
{
    alist_class = class_new(gensym("list inlet"),
        0, 0, sizeof(t_alist), 0, 0);
    class_addlist(alist_class, alist_list);
    class_addanything(alist_class, alist_anything);
}

/* ------------- list append --------------------- */

t_class *list_append_class;

typedef struct _list_append
{
    t_object x_obj;
    t_alist x_alist;
} t_list_append;

static void *list_append_new(t_symbol *s, int argc, t_atom *argv)
{
    t_list_append *x = (t_list_append *)pd_new(list_append_class);
    alist_init(&x->x_alist);
    alist_list(&x->x_alist, 0, argc, argv);
    outlet_new(&x->x_obj, &s_list);
    inlet_new(&x->x_obj, &x->x_alist.l_pd, 0, 0);
    return (x);
}

static void list_append_list(t_list_append *x, t_symbol *s,
    int argc, t_atom *argv)
{
    t_atom *outv;
Jonathan Wilkes's avatar
Jonathan Wilkes committed
221 222 223
    int n, outc;
    n = x->x_alist.l_n;
    outc = n + argc;
224
    XL_ATOMS_ALLOCA(outv, outc);
Miller Puckette's avatar
Miller Puckette committed
225 226 227 228
    atoms_copy(argc, argv, outv);
    if (x->x_alist.l_npointer)
    {
        t_alist y;
Jonathan Wilkes's avatar
Jonathan Wilkes committed
229 230
        alist_clone(&x->x_alist, &y, 0, n);
        alist_toatoms(&y, outv+argc, 0, n);
Miller Puckette's avatar
Miller Puckette committed
231 232 233 234 235
        outlet_list(x->x_obj.ob_outlet, &s_list, outc, outv);
        alist_clear(&y);
    }
    else
    {
Jonathan Wilkes's avatar
Jonathan Wilkes committed
236
        alist_toatoms(&x->x_alist, outv+argc, 0, n);
Miller Puckette's avatar
Miller Puckette committed
237 238
        outlet_list(x->x_obj.ob_outlet, &s_list, outc, outv);
    }
239
    XL_ATOMS_FREEA(outv, outc);
Miller Puckette's avatar
Miller Puckette committed
240 241 242 243 244 245
}

static void list_append_anything(t_list_append *x, t_symbol *s,
    int argc, t_atom *argv)
{
    t_atom *outv;
Jonathan Wilkes's avatar
Jonathan Wilkes committed
246 247 248
    int n, outc;
    n = x->x_alist.l_n;
    outc = n + argc + 1;
249
    XL_ATOMS_ALLOCA(outv, outc);
Miller Puckette's avatar
Miller Puckette committed
250 251 252 253 254
    SETSYMBOL(outv, s);
    atoms_copy(argc, argv, outv + 1);
    if (x->x_alist.l_npointer)
    {
        t_alist y;
Jonathan Wilkes's avatar
Jonathan Wilkes committed
255 256
        alist_clone(&x->x_alist, &y, 0, n);
        alist_toatoms(&y, outv + 1 + argc, 0, n);
Miller Puckette's avatar
Miller Puckette committed
257 258 259 260 261
        outlet_list(x->x_obj.ob_outlet, &s_list, outc, outv);
        alist_clear(&y);
    }
    else
    {
Jonathan Wilkes's avatar
Jonathan Wilkes committed
262
        alist_toatoms(&x->x_alist, outv + 1 + argc, 0, n);
Miller Puckette's avatar
Miller Puckette committed
263 264
        outlet_list(x->x_obj.ob_outlet, &s_list, outc, outv);
    }
265
    XL_ATOMS_FREEA(outv, outc);
Miller Puckette's avatar
Miller Puckette committed
266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282
}

static void list_append_free(t_list_append *x)
{
    alist_clear(&x->x_alist);
}

static void list_append_setup(void)
{
    list_append_class = class_new(gensym("list append"),
        (t_newmethod)list_append_new, (t_method)list_append_free,
        sizeof(t_list_append), 0, A_GIMME, 0);
    class_addlist(list_append_class, list_append_list);
    class_addanything(list_append_class, list_append_anything);
    class_sethelpsymbol(list_append_class, &s_list);
}

Ivica Bukvic's avatar
Ivica Bukvic committed
283 284 285 286 287 288 289 290 291 292 293 294 295 296 297
/* ------------- list cat --------------------- */

t_class *list_cat_class;
t_class *list_cat_proxy_class;

typedef struct _list_cat_proxy
{
    t_pd l_pd;
    void *parent;
} t_list_cat_proxy;

typedef struct _list_cat
{
    t_object x_obj;
    t_alist x_alist;
298
    t_list_cat_proxy x_pxy;
Ivica Bukvic's avatar
Ivica Bukvic committed
299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328
} t_list_cat;

static void list_cat_clear(t_list_cat *x);

static void list_cat_proxy_init(t_list_cat_proxy *x, t_list_cat *p)
{
    x->l_pd = list_cat_proxy_class;
    x->parent = (void *)p;
}

static void list_cat_proxy_clear(t_list_cat_proxy *x)
{
    t_list_cat *p = (t_list_cat *)x->parent;
    list_cat_clear(p);
}

static void *list_cat_new( void)
{
    t_list_cat *x = (t_list_cat *)pd_new(list_cat_class);
    alist_init(&x->x_alist);
    outlet_new(&x->x_obj, &s_list);
    list_cat_proxy_init(&x->x_pxy, x);
    inlet_new(&x->x_obj, &x->x_pxy.l_pd, 0, 0);
    return (x);
}

static void list_cat_list(t_list_cat *x, t_symbol *s,
    int argc, t_atom *argv)
{
    t_atom *outv;
Jonathan Wilkes's avatar
Jonathan Wilkes committed
329 330 331
    int n, outc;
    n = x->x_alist.l_n;
    outc = n + argc;
Ivica Bukvic's avatar
Ivica Bukvic committed
332 333 334 335 336
    XL_ATOMS_ALLOCA(outv, outc);
    atoms_copy(argc, argv, outv + x->x_alist.l_n);
    if (x->x_alist.l_npointer)
    {
        t_alist y;
Jonathan Wilkes's avatar
Jonathan Wilkes committed
337 338
        alist_clone(&x->x_alist, &y, 0, n);
        alist_toatoms(&y, outv, 0, n);
Ivica Bukvic's avatar
Ivica Bukvic committed
339 340 341 342 343
        outlet_list(x->x_obj.ob_outlet, &s_list, outc, outv);
        alist_clear(&y);
    }
    else
    {
Jonathan Wilkes's avatar
Jonathan Wilkes committed
344
        alist_toatoms(&x->x_alist, outv, 0, n);
Ivica Bukvic's avatar
Ivica Bukvic committed
345 346
        outlet_list(x->x_obj.ob_outlet, &s_list, outc, outv);
    }
347
    alist_list(&x->x_alist, s, outc, outv);
Ivica Bukvic's avatar
Ivica Bukvic committed
348 349 350 351 352 353
    XL_ATOMS_FREEA(outv, outc);
}

static void list_cat_anything(t_list_cat *x, t_symbol *s,
    int argc, t_atom *argv)
{
354
    t_atom *outv;
Jonathan Wilkes's avatar
Jonathan Wilkes committed
355 356 357
    int n, outc;
    n = x->x_alist.l_n;
    outc = n + argc + 1;
Ivica Bukvic's avatar
Ivica Bukvic committed
358 359 360 361 362 363
    XL_ATOMS_ALLOCA(outv, outc);
    SETSYMBOL(outv + x->x_alist.l_n, s);
    atoms_copy(argc, argv, outv + x->x_alist.l_n + 1);
    if (x->x_alist.l_npointer)
    {
        t_alist y;
Jonathan Wilkes's avatar
Jonathan Wilkes committed
364 365
        alist_clone(&x->x_alist, &y, 0, n);
        alist_toatoms(&y, outv, 0, n);
Ivica Bukvic's avatar
Ivica Bukvic committed
366 367 368 369 370
        outlet_list(x->x_obj.ob_outlet, &s_list, outc, outv);
        alist_clear(&y);
    }
    else
    {
Jonathan Wilkes's avatar
Jonathan Wilkes committed
371
        alist_toatoms(&x->x_alist, outv, 0, n);
Ivica Bukvic's avatar
Ivica Bukvic committed
372 373
        outlet_list(x->x_obj.ob_outlet, &s_list, outc, outv);
    }
374 375 376 377
    if (x->x_alist.l_n <= 1)
        alist_anything(&x->x_alist, s, outc, outv);
    else
        alist_list(&x->x_alist, s, outc, outv);
Ivica Bukvic's avatar
Ivica Bukvic committed
378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401
    XL_ATOMS_FREEA(outv, outc);
}

static void list_cat_clear(t_list_cat *x)
{
    alist_clear(&x->x_alist);
}

static void list_cat_free(t_list_cat *x)
{
    alist_clear(&x->x_alist);
}

static void list_cat_setup(void)
{
    list_cat_class = class_new(gensym("list cat"),
        (t_newmethod)list_cat_new, (t_method)list_cat_free,
        sizeof(t_list_cat), 0, 0);
    class_addlist(list_cat_class, list_cat_list);
    class_addanything(list_cat_class, list_cat_anything);
    class_sethelpsymbol(list_cat_class, &s_list);

    list_cat_proxy_class = class_new(gensym("list cat pxy"), 0, 0,
        sizeof(t_list_cat_proxy), 0, 0);
402 403
    class_addmethod(list_cat_proxy_class, (t_method)list_cat_proxy_clear,
        gensym("clear"), 0);
Ivica Bukvic's avatar
Ivica Bukvic committed
404 405
}

Miller Puckette's avatar
Miller Puckette committed
406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429
/* ------------- list prepend --------------------- */

t_class *list_prepend_class;

typedef struct _list_prepend
{
    t_object x_obj;
    t_alist x_alist;
} t_list_prepend;

static void *list_prepend_new(t_symbol *s, int argc, t_atom *argv)
{
    t_list_prepend *x = (t_list_prepend *)pd_new(list_prepend_class);
    alist_init(&x->x_alist);
    alist_list(&x->x_alist, 0, argc, argv);
    outlet_new(&x->x_obj, &s_list);
    inlet_new(&x->x_obj, &x->x_alist.l_pd, 0, 0);
    return (x);
}

static void list_prepend_list(t_list_prepend *x, t_symbol *s,
    int argc, t_atom *argv)
{
    t_atom *outv;
Jonathan Wilkes's avatar
Jonathan Wilkes committed
430 431 432
    int n, outc;
    n = x->x_alist.l_n;
    outc = n + argc;
433
    XL_ATOMS_ALLOCA(outv, outc);
Jonathan Wilkes's avatar
Jonathan Wilkes committed
434
    atoms_copy(argc, argv, outv + n);
Miller Puckette's avatar
Miller Puckette committed
435 436 437
    if (x->x_alist.l_npointer)
    {
        t_alist y;
Jonathan Wilkes's avatar
Jonathan Wilkes committed
438 439
        alist_clone(&x->x_alist, &y, 0, n);
        alist_toatoms(&y, outv, 0, n);
Miller Puckette's avatar
Miller Puckette committed
440 441 442 443 444
        outlet_list(x->x_obj.ob_outlet, &s_list, outc, outv);
        alist_clear(&y);
    }
    else
    {
Jonathan Wilkes's avatar
Jonathan Wilkes committed
445
        alist_toatoms(&x->x_alist, outv, 0, n);
Miller Puckette's avatar
Miller Puckette committed
446 447
        outlet_list(x->x_obj.ob_outlet, &s_list, outc, outv);
    }
448
    XL_ATOMS_FREEA(outv, outc);
Miller Puckette's avatar
Miller Puckette committed
449 450 451 452 453 454 455 456
}



static void list_prepend_anything(t_list_prepend *x, t_symbol *s,
    int argc, t_atom *argv)
{
    t_atom *outv;
Jonathan Wilkes's avatar
Jonathan Wilkes committed
457 458 459
    int n, outc;
    n = x->x_alist.l_n;
    outc = n + argc + 1;
460
    XL_ATOMS_ALLOCA(outv, outc);
Jonathan Wilkes's avatar
Jonathan Wilkes committed
461 462
    SETSYMBOL(outv + n, s);
    atoms_copy(argc, argv, outv + n + 1);
Miller Puckette's avatar
Miller Puckette committed
463 464 465
    if (x->x_alist.l_npointer)
    {
        t_alist y;
Jonathan Wilkes's avatar
Jonathan Wilkes committed
466 467
        alist_clone(&x->x_alist, &y, 0, n);
        alist_toatoms(&y, outv, 0, n);
Miller Puckette's avatar
Miller Puckette committed
468 469 470 471 472
        outlet_list(x->x_obj.ob_outlet, &s_list, outc, outv);
        alist_clear(&y);
    }
    else
    {
Jonathan Wilkes's avatar
Jonathan Wilkes committed
473
        alist_toatoms(&x->x_alist, outv, 0, n);
Miller Puckette's avatar
Miller Puckette committed
474 475
        outlet_list(x->x_obj.ob_outlet, &s_list, outc, outv);
    }
476
    XL_ATOMS_FREEA(outv, outc);
Miller Puckette's avatar
Miller Puckette committed
477 478 479 480 481 482 483 484 485 486 487 488 489 490 491
}

static void list_prepend_free(t_list_prepend *x)
{
    alist_clear(&x->x_alist);
}

static void list_prepend_setup(void)
{
    list_prepend_class = class_new(gensym("list prepend"),
        (t_newmethod)list_prepend_new, (t_method)list_prepend_free,
        sizeof(t_list_prepend), 0, A_GIMME, 0);
    class_addlist(list_prepend_class, list_prepend_list);
    class_addanything(list_prepend_class, list_prepend_anything);
    class_sethelpsymbol(list_prepend_class, &s_list);
Ivica Bukvic's avatar
Ivica Bukvic committed
492 493


Miller Puckette's avatar
Miller Puckette committed
494 495
}

Jonathan Wilkes's avatar
Jonathan Wilkes committed
496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651
/* ------------- list store --------------------- */

t_class *list_store_class;

typedef struct _list_store
{
    t_object x_obj;
    t_alist x_alist;
    t_outlet *x_out1;
    t_outlet *x_out2;
} t_list_store;

static void *list_store_new(t_symbol *s, int argc, t_atom *argv)
{
    t_list_store *x = (t_list_store *)pd_new(list_store_class);
    alist_init(&x->x_alist);
    alist_list(&x->x_alist, 0, argc, argv);
    x->x_out1 = outlet_new(&x->x_obj, &s_list);
    x->x_out2 = outlet_new(&x->x_obj, &s_bang);
    inlet_new(&x->x_obj, &x->x_alist.l_pd, 0, 0);
    return (x);
}

static void list_store_list(t_list_store *x, t_symbol *s,
    int argc, t_atom *argv)
{
    t_atom *outv;
    int n, outc;
    n = x->x_alist.l_n;
    outc = n + argc;
    ATOMS_ALLOCA(outv, outc);
    atoms_copy(argc, argv, outv);
    if (x->x_alist.l_npointer)
    {
        t_alist y;
        alist_clone(&x->x_alist, &y, 0, n);
        alist_toatoms(&y, outv+argc, 0, n);
        outlet_list(x->x_out1, &s_list, outc, outv);
        alist_clear(&y);
    }
    else
    {
        alist_toatoms(&x->x_alist, outv+argc, 0, n);
        outlet_list(x->x_out1, &s_list, outc, outv);
    }
    ATOMS_FREEA(outv, outc);
}

/* function to restore gpointers after the list has moved in memory */
static void list_store_restore_gpointers(t_list_store *x, int offset, int count)
{
    t_listelem *vec = x->x_alist.l_vec + offset;
    while (count--)
    {
        if (vec->l_a.a_type == A_POINTER)
            vec->l_a.a_w.w_gpointer = &vec->l_p;
        vec++;
    }
}

static void list_store_append(t_list_store *x, t_symbol *s,
    int argc, t_atom *argv)
{
    t_listelem *oldptr = x->x_alist.l_vec;

    if (!(x->x_alist.l_vec = (t_listelem *)resizebytes(x->x_alist.l_vec,
        (x->x_alist.l_n) * sizeof(*x->x_alist.l_vec),
        (x->x_alist.l_n + argc) * sizeof(*x->x_alist.l_vec))))
    {
        x->x_alist.l_n = 0;
        error("list: out of memory");
        return;
    }

        /* fix gpointers if resizebytes() has moved the alist in memory */
    if (x->x_alist.l_vec != oldptr && x->x_alist.l_npointer)
        list_store_restore_gpointers(x, 0, x->x_alist.l_n);

    alist_copyin(&x->x_alist, s, argc, argv, x->x_alist.l_n);
    x->x_alist.l_n += argc;
}

static void list_store_prepend(t_list_store *x, t_symbol *s,
    int argc, t_atom *argv)
{
    if (!(x->x_alist.l_vec = (t_listelem *)resizebytes(x->x_alist.l_vec,
    (x->x_alist.l_n) * sizeof(*x->x_alist.l_vec),
    (x->x_alist.l_n + argc) * sizeof(*x->x_alist.l_vec))))
    {
        x->x_alist.l_n = 0;
        error("list: out of memory");
        return;
    }

    memmove(x->x_alist.l_vec + argc, x->x_alist.l_vec,
        x->x_alist.l_n * sizeof(*x->x_alist.l_vec));

        /* we always have to fix gpointers because of memmove() */
    if (x->x_alist.l_npointer)
        list_store_restore_gpointers(x, argc, x->x_alist.l_n);

    alist_copyin(&x->x_alist, s, argc, argv, 0);
    x->x_alist.l_n += argc;
}

static void list_store_get(t_list_store *x, float f1, float f2)
{
    t_atom *outv;
    int onset = f1, outc = f2;
    if (onset < 0 || outc < 0)
    {
        pd_error(x, "list_store_get: negative range (%d %d)", onset, outc);
        return;
    }
    if (onset + outc > x->x_alist.l_n)
    {
        outlet_bang(x->x_out2);
        return;
    }
    ATOMS_ALLOCA(outv, outc);
    if (x->x_alist.l_npointer)
    {
        t_alist y;
        alist_clone(&x->x_alist, &y, onset, outc);
        alist_toatoms(&y, outv, 0, outc);
        outlet_list(x->x_out1, &s_list, outc, outv);
        alist_clear(&y);
    }
    else
    {
        alist_toatoms(&x->x_alist, outv, onset, outc);
        outlet_list(x->x_out1, &s_list, outc, outv);
    }
    ATOMS_FREEA(outv, outc);
}

static void list_store_free(t_list_store *x)
{
    alist_clear(&x->x_alist);
}

static void list_store_setup(void)
{
    list_store_class = class_new(gensym("list store"),
        (t_newmethod)list_store_new, (t_method)list_store_free,
        sizeof(t_list_store), 0, A_GIMME, 0);
    class_addlist(list_store_class, list_store_list);
    class_addmethod(list_store_class, (t_method)list_store_append,
        gensym("append"), A_GIMME, 0);
    class_addmethod(list_store_class, (t_method)list_store_prepend,
        gensym("prepend"), A_GIMME, 0);
    class_addmethod(list_store_class, (t_method)list_store_get,
        gensym("get"), A_FLOAT, A_FLOAT, 0);
    class_sethelpsymbol(list_store_class, &s_list);
}

Miller Puckette's avatar
Miller Puckette committed
652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693
/* ------------- list split --------------------- */

t_class *list_split_class;

typedef struct _list_split
{
    t_object x_obj;
    t_float x_f;
    t_outlet *x_out1;
    t_outlet *x_out2;
    t_outlet *x_out3;
} t_list_split;

static void *list_split_new(t_floatarg f)
{
    t_list_split *x = (t_list_split *)pd_new(list_split_class);
    x->x_out1 = outlet_new(&x->x_obj, &s_list);
    x->x_out2 = outlet_new(&x->x_obj, &s_list);
    x->x_out3 = outlet_new(&x->x_obj, &s_list);
    floatinlet_new(&x->x_obj, &x->x_f);
    x->x_f = f;
    return (x);
}

static void list_split_list(t_list_split *x, t_symbol *s,
    int argc, t_atom *argv)
{
    int n = x->x_f;
    if (n < 0)
        n = 0;
    if (argc >= n)
    {
        outlet_list(x->x_out2, &s_list, argc-n, argv+n);
        outlet_list(x->x_out1, &s_list, n, argv);
    }
    else outlet_list(x->x_out3, &s_list, argc, argv);
}

static void list_split_anything(t_list_split *x, t_symbol *s,
    int argc, t_atom *argv)
{
    t_atom *outv;
694
    XL_ATOMS_ALLOCA(outv, argc+1);
Miller Puckette's avatar
Miller Puckette committed
695 696 697
    SETSYMBOL(outv, s);
    atoms_copy(argc, argv, outv + 1);
    list_split_list(x, &s_list, argc+1, outv);
698
    XL_ATOMS_FREEA(outv, argc+1);
Miller Puckette's avatar
Miller Puckette committed
699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770
}

static void list_split_setup(void)
{
    list_split_class = class_new(gensym("list split"),
        (t_newmethod)list_split_new, 0,
        sizeof(t_list_split), 0, A_DEFFLOAT, 0);
    class_addlist(list_split_class, list_split_list);
    class_addanything(list_split_class, list_split_anything);
    class_sethelpsymbol(list_split_class, &s_list);
}

/* ------------- list trim --------------------- */

t_class *list_trim_class;

typedef struct _list_trim
{
    t_object x_obj;
} t_list_trim;

static void *list_trim_new( void)
{
    t_list_trim *x = (t_list_trim *)pd_new(list_trim_class);
    outlet_new(&x->x_obj, &s_list);
    return (x);
}

static void list_trim_list(t_list_trim *x, t_symbol *s,
    int argc, t_atom *argv)
{
    if (argc < 1 || argv[0].a_type != A_SYMBOL)
        outlet_list(x->x_obj.ob_outlet, &s_list, argc, argv);
    else outlet_anything(x->x_obj.ob_outlet, argv[0].a_w.w_symbol,
        argc-1, argv+1);
}

static void list_trim_anything(t_list_trim *x, t_symbol *s,
    int argc, t_atom *argv)
{
    outlet_anything(x->x_obj.ob_outlet, s, argc, argv);
}

static void list_trim_setup(void)
{
    list_trim_class = class_new(gensym("list trim"),
        (t_newmethod)list_trim_new, 0,
        sizeof(t_list_trim), 0, 0);
    class_addlist(list_trim_class, list_trim_list);
    class_addanything(list_trim_class, list_trim_anything);
    class_sethelpsymbol(list_trim_class, &s_list);
}

/* ------------- list length --------------------- */

t_class *list_length_class;

typedef struct _list_length
{
    t_object x_obj;
} t_list_length;

static void *list_length_new( void)
{
    t_list_length *x = (t_list_length *)pd_new(list_length_class);
    outlet_new(&x->x_obj, &s_float);
    return (x);
}

static void list_length_list(t_list_length *x, t_symbol *s,
    int argc, t_atom *argv)
{
771
    outlet_float(x->x_obj.ob_outlet, (t_float)argc);
Miller Puckette's avatar
Miller Puckette committed
772 773 774 775 776
}

static void list_length_anything(t_list_length *x, t_symbol *s,
    int argc, t_atom *argv)
{
777
    outlet_float(x->x_obj.ob_outlet, (t_float)argc+1);
Miller Puckette's avatar
Miller Puckette committed
778 779 780 781 782 783 784 785 786 787 788 789
}

static void list_length_setup(void)
{
    list_length_class = class_new(gensym("list length"),
        (t_newmethod)list_length_new, 0,
        sizeof(t_list_length), 0, 0);
    class_addlist(list_length_class, list_length_list);
    class_addanything(list_length_class, list_length_anything);
    class_sethelpsymbol(list_length_class, &s_list);
}

790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867
/* ------------- list fromsymbol --------------------- */

t_class *list_fromsymbol_class;

typedef struct _list_fromsymbol
{
    t_object x_obj;
} t_list_fromsymbol;

static void *list_fromsymbol_new( void)
{
    t_list_fromsymbol *x = (t_list_fromsymbol *)pd_new(list_fromsymbol_class);
    outlet_new(&x->x_obj, &s_list);
    return (x);
}

static void list_fromsymbol_symbol(t_list_fromsymbol *x, t_symbol *s)
{
    t_atom *outv;
    int n, outc = strlen(s->s_name);
    ATOMS_ALLOCA(outv, outc);
    for (n = 0; n < outc; n++)
        SETFLOAT(outv + n, (unsigned char)s->s_name[n]);
    outlet_list(x->x_obj.ob_outlet, &s_list, outc, outv);
    ATOMS_FREEA(outv, outc);
}

static void list_fromsymbol_setup(void)
{
    list_fromsymbol_class = class_new(gensym("list fromsymbol"),
        (t_newmethod)list_fromsymbol_new, 0, sizeof(t_list_fromsymbol), 0, 0);
    class_addsymbol(list_fromsymbol_class, list_fromsymbol_symbol);
    class_sethelpsymbol(list_fromsymbol_class, &s_list);
}

/* ------------- list tosymbol --------------------- */

t_class *list_tosymbol_class;

typedef struct _list_tosymbol
{
    t_object x_obj;
} t_list_tosymbol;

static void *list_tosymbol_new( void)
{
    t_list_tosymbol *x = (t_list_tosymbol *)pd_new(list_tosymbol_class);
    outlet_new(&x->x_obj, &s_symbol);
    return (x);
}

static void list_tosymbol_list(t_list_tosymbol *x, t_symbol *s,
    int argc, t_atom *argv)
{
    int i;
#if HAVE_ALLOCA
    char *str = alloca(argc + 1);
#else
    char *str = getbytes(argc + 1);
#endif
    for (i = 0; i < argc; i++)
        str[i] = (char)atom_getfloatarg(i, argc, argv);
    str[argc] = 0;
    outlet_symbol(x->x_obj.ob_outlet, gensym(str));
#if HAVE_ALLOCA
#else
    freebytes(str, argc+1);
#endif
}

static void list_tosymbol_setup(void)
{
    list_tosymbol_class = class_new(gensym("list tosymbol"),
        (t_newmethod)list_tosymbol_new, 0, sizeof(t_list_tosymbol), 0, 0);
    class_addlist(list_tosymbol_class, list_tosymbol_list);
    class_sethelpsymbol(list_tosymbol_class, &s_list);
}

Miller Puckette's avatar
Miller Puckette committed
868 869 870 871 872 873 874 875 876 877 878
/* ------------- list ------------------- */

static void *list_new(t_pd *dummy, t_symbol *s, int argc, t_atom *argv)
{
    if (!argc || argv[0].a_type != A_SYMBOL)
        newest = list_append_new(s, argc, argv);
    else
    {
        t_symbol *s2 = argv[0].a_w.w_symbol;
        if (s2 == gensym("append"))
            newest = list_append_new(s, argc-1, argv+1);
Ivica Bukvic's avatar
Ivica Bukvic committed
879 880
        else if (s2 == gensym("cat"))
            newest = list_cat_new();
Miller Puckette's avatar
Miller Puckette committed
881 882
        else if (s2 == gensym("prepend"))
            newest = list_prepend_new(s, argc-1, argv+1);
883
        else if (s2 == gensym("split"))
Miller Puckette's avatar
Miller Puckette committed
884
            newest = list_split_new(atom_getfloatarg(1, argc, argv));
885
        else if (s2 == gensym("trim"))
Miller Puckette's avatar
Miller Puckette committed
886
            newest = list_trim_new();
887
        else if (s2 == gensym("length"))
Miller Puckette's avatar
Miller Puckette committed
888
            newest = list_length_new();
889 890 891 892
        else if (s2 == gensym("fromsymbol"))
            newest = list_fromsymbol_new();
        else if (s2 == gensym("tosymbol"))
            newest = list_tosymbol_new();
Jonathan Wilkes's avatar
Jonathan Wilkes committed
893 894
        else if (s2 == gensym("store"))
            newest = list_store_new(s, argc-1, argv+1);
Miller Puckette's avatar
Miller Puckette committed
895 896 897 898 899 900 901 902 903 904 905 906 907
        else 
        {
            error("list %s: unknown function", s2->s_name);
            newest = 0;
        }
    }
    return (newest);
}

void x_list_setup(void)
{
    alist_setup();
    list_append_setup();
Ivica Bukvic's avatar
Ivica Bukvic committed
908
    list_cat_setup();
Miller Puckette's avatar
Miller Puckette committed
909
    list_prepend_setup();
Jonathan Wilkes's avatar
Jonathan Wilkes committed
910
    list_store_setup();
Miller Puckette's avatar
Miller Puckette committed
911 912 913
    list_split_setup();
    list_trim_setup();
    list_length_setup();
914 915
    list_fromsymbol_setup();
    list_tosymbol_setup();
Miller Puckette's avatar
Miller Puckette committed
916 917
    class_addcreator((t_newmethod)list_new, &s_list, A_GIMME, 0);
}