diff options
| -rw-r--r-- | doc/misc/pdp_forth.html | 94 | ||||
| -rw-r--r-- | guile/Makefile | 24 | ||||
| -rw-r--r-- | guile/README | 73 | ||||
| -rw-r--r-- | guile/example.pd | 36 | ||||
| -rw-r--r-- | guile/example.scm | 12 | ||||
| -rw-r--r-- | guile/pdp_guile.c | 705 | ||||
| -rw-r--r-- | guile/pdp_guile.scm | 37 | ||||
| -rw-r--r-- | guile/testguile.pd | 38 |
8 files changed, 0 insertions, 1019 deletions
diff --git a/doc/misc/pdp_forth.html b/doc/misc/pdp_forth.html deleted file mode 100644 index 0f39fd2..0000000 --- a/doc/misc/pdp_forth.html +++ /dev/null @@ -1,94 +0,0 @@ -<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"> -<html> - <head> - <title>PDP Forth Scripting</title> - </head> - - <body> - <h1>PDP Forth Scripting</h1> - <h2>Introduction</h2> - - <p> This document describes the rationale behind the pdp forth scripting - language, aka "pdp's rpn calculator". - - - <p>The point is to be able to decouple the packet processors from the pd - object model, in order to be able to port the functional part of pdp to other - systems. Therefore pdp needs its own processor model. - - <p>A requirement for this is that it is both flexible and simple. pd's object - model is very flexible, but it is hard to port to other architextures, because - of the tight bindings to the pd kernel. What is needed is a way to abstract the - functionality of a packet processor in such a way that a pd class can be - generated from the pdp processor model. - - <p>There are a lot of ways to solve this problem. One is to extend a packet - class to support methods. This seems like a very clean solution, however - when a processor has more than one packet as internal state, this poses - a problem. It would require to define an operation like biquad (which has 1 input - packet and 2 extra state packets) as a method of a packet collection. To - do this properly requires a much more advanced object model, or a separate - object model for processors. - - - <p>In short: it is not always clear if a packet processor can be seen as a metod - 'of' or an operation 'on' a single packet, so extending a packet with methods - would require a separate packet processor class anyway. Therefore we do not - define packet operations as methods of packets. (no object oriented solution) - - <p>Another approach is to write operators in a pure functional way: a processor - accepts a list of arguments and returns a new list of arguments. To do this - cleanly it would require the calling style to be pass by value: i.e. the arguments - passed will not be modified themselves. Since most of the image processors in - pdp all use in place processing for performance reasons, this would require - a lot of workarounds or a big kludge mixing const and non const references - (like it would be done in C++). - - <p>Since one of the goals is to automate - the generation of wrappers of pdp processors (i.e. pd classes, python classes, - scheme functions, ...) the interface can best be kept as simple as possible. - (no pure functional solution) - - <p>The most natural solution, given the underlying code base, seems to be to embrace - an in place processing approach. What comes to mind is to use a data stack to solve - the communication problem. I.e. the forth language model. A packet operation is then - a forth word that manipulates a data stack. A data stack is nothing more than a list - of atoms containing the basic data building blocks: floats, ints, symbols and packets. - - <p>An additional advantage is that dataflow and forth mix very well. This would enable - the possibility to create new words by chaining old ones, without the disadvantage - that pd abstractions using pdp objects have: passive packets are contained in internal processor - registers longer than necessary, leading to inefficient memory usage. - - <p>Several practical problems need to be solved to implement this. The first being - description of the stack effect. Each primitive word has a mandatory description of - the number of stack elements it consumes and produces. - - <P>The forth words will support - polymorphy: each word has a type template to describe the type of atoms it can operate - on. The type is determined by some word on the stack, or a symbol indicating the type for - generators. - - <p>To solve the additional problem of mapping forth words to processors, the concept - of a forth process is introduced. A forth process has a stack (representing it's - state), an init method that constructs a stack, a process method that operates - on the stack and some description of how to map inputs to stack and stack to output. - - <p>There is one last class of objects that don't fit the forth description - very well: it is the input/output classes. These will probably stay as special - cases, since they really need an internal state represented as an object, - incorporating them into the system would require them to be defined as an - object (quicktime packet, v4l packet, xv packet, ...). More later. - - <h2>Implementation</h2> - Have a look at <code>pdp_forth.h</code> - - - <hr> - <address><a href="mailto:no@spam">Tom Schouten</a></address> -<!-- Created: Sun Jun 8 17:42:50 CEST 2003 --> -<!-- hhmts start --> -Last modified: Mon Jun 9 13:41:09 CEST 2003 -<!-- hhmts end --> - </body> -</html> diff --git a/guile/Makefile b/guile/Makefile deleted file mode 100644 index 269f339..0000000 --- a/guile/Makefile +++ /dev/null @@ -1,24 +0,0 @@ -current: pd_linux - -pd_linux: pdp_guile.pd_linux - -.SUFFIXES: .pd_linux - -LINUXCFLAGS = -DPD -O2 -funroll-loops -fomit-frame-pointer \ - -Wall -W -Wstrict-prototypes -Werror \ - -Wno-unused -Wno-parentheses -Wno-switch # -Wshadow - -LINUXINCLUDE = -I../distro/pd/src -Idbot -I../include - -.c.pd_linux: - gcc $(LINUXCFLAGS) $(LINUXINCLUDE) -o $*.o -c $*.c - gcc -export_dynamic -shared -o $*.pd_linux $*.o -lm \ - -lguile #-lguile-ltdl -lqthreads -lpthread -lcrypt - - strip --strip-unneeded $*.pd_linux - rm $*.o - -clean: - rm -f *.pd_linux - rm -f *~ - diff --git a/guile/README b/guile/README deleted file mode 100644 index 8a90cd9..0000000 --- a/guile/README +++ /dev/null @@ -1,73 +0,0 @@ -PDP_GUILE - a scheme interpreter for pd/pdp - -Copyright (c) by Tom Schouten <pdp@zzz.kotnet.org> - -This program is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 2 of the License, or -(at your option) any later version. - -This program is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -You should have received a copy of the GNU General Public License -along with this program; if not, write to the Free Software -Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - -The GNU Public Licence can be found in the file COPYING - ---- - -pdp_guile starts a scheme interpreter is started on pd's standard io. -there is a simple send/receive interface in pd to communicate with the -running scheme interpreter trough an input and output queue. pd can -send messages, including pdp packets, to guile with the [ss tag] object. - -guile can read using the (in) fuction, which returs a two element list: -the tag and the object (a float, a symbol, a list or a packet) i.e. if -you connect a [pdp_v4l] object to a [ss some-tag-symbol] object and bang -the v4l object, you can retreive the packet in guile using something -like this: - -(in) -=> (some-tag-symbol #<pdp 0 image/YCrCb/320x240>) - -(in) retreives the oldest message from the input queue. if there are no -more messages, (in) returns #f - -guile can write using the (out tag object) function, which will send the -object to a [r tag] pd reciever. i.e. if you connect a -[r some-tag-symbol] object to a [pdp_xv] object, you can display a -packet (here contained in variable p) by doing: - -(out 'some-tag-symbol p) - - -guile is connected to pdp's forth scripting language (pdp's "rpn -calculator") using the (forth stack wordlist) statement. it returns the -processed stack. i.e.: - -(define p0 (make-pdp 'image/grey/320x240)) -(define p1 (make-pdp 'image/grey/320x240)) -(forth `(,p0 ,p1) '(add)) -=> (#<pdp 2 image/grey/320x240>) - - -see pdp_guile.scm and pdp_guile.pd for an example of how pdp_guile -could be used. - -this is mainly for experimental interactive work and testing pdp's forth -scripting. there's no documentation, apart from this file, the example -and the source code. if you like to have more info, just drop me a -line. - -if you want to write externals in scheme, this is probably not for you. - -requirements: libguile 1.6.x - - -enjoy, - -tom diff --git a/guile/example.pd b/guile/example.pd deleted file mode 100644 index ee545e5..0000000 --- a/guile/example.pd +++ /dev/null @@ -1,36 +0,0 @@ -#N canvas 135 3 467 427 10; -#X obj 90 309 pdp_xv; -#X obj 90 170 bng 15 250 50 0 empty empty empty 0 -6 0 8 -262144 -1 --1; -#X obj 90 202 pdp_v4l; -#X obj 169 128 metro 10; -#X obj 90 285 r out-vid; -#X obj 90 237 ss in-vid; -#X obj 250 206 ss control; -#X msg 248 177 stop; -#X msg 292 177 gc; -#X obj 293 142 metro 1000; -#X msg 304 48 stop; -#X msg 162 80 1; -#X msg 193 80 0; -#X obj 101 48 r start; -#X text 283 29 pd controls stop; -#X text 233 229 scheme control port; -#X text 29 28 scheme interpreter controls start; -#X text 20 372 load "example.scm" in the guile dir to use this patch -; -#X text 82 262 scheme code; -#X connect 1 0 2 0; -#X connect 2 0 5 0; -#X connect 3 0 2 0; -#X connect 4 0 0 0; -#X connect 7 0 6 0; -#X connect 8 0 6 0; -#X connect 9 0 8 0; -#X connect 10 0 7 0; -#X connect 10 0 12 0; -#X connect 11 0 3 0; -#X connect 11 0 9 0; -#X connect 12 0 3 0; -#X connect 12 0 9 0; -#X connect 13 0 11 0; diff --git a/guile/example.scm b/guile/example.scm deleted file mode 100644 index 3963c76..0000000 --- a/guile/example.scm +++ /dev/null @@ -1,12 +0,0 @@ -; load event handler -(load "pdp_guile.scm") - - -; input - output video plug -(add-input! 'in-vid - (lambda (thing) - (out 'out-vid thing))) - - -; start the input loop -(start) diff --git a/guile/pdp_guile.c b/guile/pdp_guile.c deleted file mode 100644 index 34ca8da..0000000 --- a/guile/pdp_guile.c +++ /dev/null @@ -1,705 +0,0 @@ -/* - * Pure Data Packet module: Guile Interpreter for pd/pdp - * Copyright (c) by Tom Schouten <pdp@zzz.kotnet.org> - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - * - */ - - -#include <pthread.h> -#include <libguile.h> -#include <stdio.h> -#include "pdp.h" -#include "pdp_forth.h" - -#define D if(0) - - - -/* communication stuff */ - -static t_class *guile_class; - -pthread_mutex_t guile_mux; - -t_pdp_list *guile_inlist; -t_pdp_list *guile_outlist; -t_clock *guile_clock; -t_float guile_clock_deltime; - - -/* GUILE GLUE CODE */ - -static scm_t_bits pdp_tag; - -typedef struct _pdp_scm_wrapper -{ - int packet; - SCM update_func; - //char dummy[1000000]; -} t_pdp_scm_wrapper; - - -/* list (comm queue) utility stuff */ - -static void guile_list_send(t_pdp_list *list, t_pdp_symbol *tag, t_pdp_word_type type, t_pdp_word word) -{ - pthread_mutex_lock(&guile_mux); - pdp_list_add_back(list, a_symbol, (t_pdp_word)tag); - pdp_list_add_back(list, type, word); - pthread_mutex_unlock(&guile_mux); -} - -static int guile_list_receive(t_pdp_list *list, t_pdp_symbol **tag, t_pdp_word_type *type, t_pdp_word *word) -{ - int success = 0; - if (pdp_list_size(list)){ - pthread_mutex_lock(&guile_mux); - *tag = pdp_list_pop(list).w_symbol; - *type = list->first->t; - *word = pdp_list_pop(list); - pthread_mutex_unlock(&guile_mux); - success = 1; - } - return success; - -} - -/* pdp list <-> scm list conversion */ - -/* any packets contained in the pdp list are copied ro */ - -static SCM pdp_to_scm (t_pdp_list *l) -{ - SCM pair = SCM_EOL; //temporary pair - SCM thing; //thing to add to the list - t_pdp_list *cl = pdp_list_copy_reverse(l); //make a reverse copy of the list - t_pdp_atom *a; - t_pdp_scm_wrapper *pg; - - for(a=cl->first;a;a=a->next){ - - // convert the atom to a lisp scalar - switch (a->t){ - case a_list: - thing = pdp_to_scm(a->w.w_list); break; - case a_int: - thing = SCM_MAKINUM(a->w.w_int); break; - case a_symbol: - thing = scm_str2symbol(a->w.w_symbol->s_name); break; - case a_float: - thing = scm_make_real (a->w.w_float); break; - case a_packet: - //post("ATTENTION: pdp_to_scm copies packets"); - pg = (t_pdp_scm_wrapper *) scm_must_malloc (sizeof (t_pdp_scm_wrapper), "pdp"); - pg->packet = pdp_packet_copy_ro(a->w.w_packet); - pg->update_func = SCM_BOOL_F; - SCM_NEWSMOB (thing, pdp_tag, pg); - break; - default: - thing = scm_str2symbol("undef"); break; - } - - // add the atom to the list - pair = scm_cons(thing, pair); // add thing - - } - - // - - // return the list - return pair; -} - -/* any packets contained in the list are copied ro */ -static t_pdp_list *scm_to_pdp (SCM pair) -{ - t_pdp_list *l = pdp_list_new(0); - SCM rest = pair; - SCM head; - while (1){ - if (!SCM_CONSP(rest)){ - head = rest; - rest = SCM_EOL; - } - else { - head = SCM_CAR(rest); - rest = SCM_CDR(rest); - } - if (SCM_NULLP(head)) break; - - else if (SCM_CONSP(head)){ - pdp_list_add_back(l, a_list, (t_pdp_word)scm_to_pdp(head)); - } - else if (SCM_SMOB_PREDICATE(pdp_tag, head)){ - t_pdp_scm_wrapper *pg = (t_pdp_scm_wrapper *) SCM_SMOB_DATA (head); - //post("ATTENTION: scm_to_pdp copies packets"); - pdp_list_add_back(l, a_packet, - (t_pdp_word)(pdp_packet_copy_ro(pg->packet))); - } - else if (SCM_INUMP(head)){ - int i = SCM_INUM(head); - pdp_list_add_back(l, a_int, (t_pdp_word)i); - } - else if (SCM_REALP(head)){ - float f = (float)SCM_REAL_VALUE(head); - pdp_list_add_back(l, a_float, (t_pdp_word)f); - } - else if (SCM_SYMBOLP(head)){ - pdp_list_add_back(l, a_symbol, - (t_pdp_word)pdp_gensym(SCM_SYMBOL_CHARS(head))); - } - else { - pdp_list_add_back(l, a_undef, (t_pdp_word)0); - } - } - return l; -} - - - - -/* smob callbacks */ - -static SCM mark_pdp (SCM pdp_smob) -{ - /* Mark the image's name and update function. */ - t_pdp_scm_wrapper *pg = (t_pdp_scm_wrapper *) SCM_SMOB_DATA (pdp_smob); - scm_gc_mark (pg->update_func); - D post("mark_pdp called"); - return SCM_BOOL_F; -} - -static size_t free_pdp (SCM pdp_smob) -{ - t_pdp_scm_wrapper *pg = (t_pdp_scm_wrapper *) SCM_SMOB_DATA (pdp_smob); - pdp_packet_mark_unused(pg->packet); - scm_must_free(pg); - D post("free_pdp called"); - return sizeof(t_pdp_scm_wrapper); -} - - -static int -print_pdp (SCM pdp_smob, SCM port, scm_print_state *pstate) -{ - t_pdp_scm_wrapper *pg = (t_pdp_scm_wrapper *) SCM_SMOB_DATA (pdp_smob); - char tmp[1000]; - t_pdp *h = pdp_packet_header(pg->packet); - tmp[999] = 0; - snprintf(tmp, 999, "#<pdp %d %s>", pg->packet, - h && h->desc ? h->desc->s_name : "unknown"); - scm_puts(tmp, port); - D post ("print_pdp called"); - return 1; -} - - -/* extension functions */ - - -static SCM -forth_pdp (SCM stack, SCM program) -{ - t_pdp_word_error e; - t_pdp_list *s = scm_to_pdp (stack); - t_pdp_list *p = scm_to_pdp (program); - e = pdp_forth_execute_def(s, p); - stack = pdp_to_scm(s); - - if (e){ - post("ERROR: program evaluation aborted with error %d.", e); - } - pdp_tree_strip_packets(s); - pdp_tree_strip_packets(p); - - return stack; - -} - -static SCM -define_forth_word_pdp (SCM word, SCM in, SCM out, SCM program) -{ - t_pdp_word_error e; - t_pdp_list *p; - t_pdp_symbol *s; - SCM_ASSERT (SCM_SYMBOLP(word), word, SCM_ARG1, "define-forth-word"); - SCM_ASSERT (SCM_INUMP(in), word, SCM_ARG2, "define-forth-word"); - SCM_ASSERT (SCM_INUMP(out), word, SCM_ARG3, "define-forth-word"); - p = scm_to_pdp (program); - s = pdp_gensym(SCM_SYMBOL_CHARS(word)); - pdp_forthdict_add_word(s, p, SCM_INUM(in), SCM_INUM(out), -1, 0); - - return SCM_UNSPECIFIED; - -} - - -static SCM -unmark_pdp (SCM pdp_smob) -{ - t_pdp_scm_wrapper *pg; - SCM_ASSERT (SCM_SMOB_PREDICATE (pdp_tag, pdp_smob), - pdp_smob, SCM_ARG1, "mark-unused"); - pg = (t_pdp_scm_wrapper *) SCM_SMOB_DATA (pdp_smob); - pdp_packet_mark_unused(pg->packet); - pg->packet = -1; - return SCM_UNSPECIFIED; -} - - - - -static SCM -is_writable_pdp (SCM pdp_smob) -{ - t_pdp_scm_wrapper *pg; - SCM_ASSERT (SCM_SMOB_PREDICATE (pdp_tag, pdp_smob), - pdp_smob, SCM_ARG1, "writable?"); - pg = (t_pdp_scm_wrapper *) SCM_SMOB_DATA (pdp_smob); - if (pdp_packet_writable(pg->packet)) return SCM_BOOL_T; - else return SCM_BOOL_F; - return SCM_UNSPECIFIED; -} - -static SCM -make_pdp (SCM type) -{ - int p; - t_pdp_scm_wrapper *pg; - char *t; - - /* construct with type */ - if (SCM_SYMBOLP(type)){ - t = SCM_SYMBOL_CHARS(type); - p = pdp_factory_newpacket(pdp_gensym(t)); - } - /* copy construct from packet id */ - else if (SCM_INUMP(type)){ - int i = SCM_INUM(type); - p = pdp_packet_copy_ro(i); - } - else { - SCM_ASSERT (0, type, SCM_ARG1, "make-pdp"); - } - - /* check if valid packet */ - SCM_ASSERT (p != -1, type, SCM_ARG1, "make-pdp"); - - /* build smob */ - pg = (t_pdp_scm_wrapper *) scm_must_malloc (sizeof (t_pdp_scm_wrapper), "pdp"); - pg->packet = p; - pg->update_func = SCM_BOOL_F; - SCM_RETURN_NEWSMOB (pdp_tag, pg); -} - -static SCM -_in (void) -{ - - t_pdp_scm_wrapper *pg; - t_pdp_word w; - t_pdp_symbol *stag; - t_pdp_word_type type = a_undef; - int skip = 1; - - SCM tag; - SCM thing; - SCM pair; - - D post("receiving pdp packet"); - - if (!guile_list_receive(guile_inlist, &stag, &type, &w)) goto exit; - tag = scm_str2symbol(stag->s_name); - - switch(type){ - case a_packet: - pg = (t_pdp_scm_wrapper *) scm_must_malloc (sizeof (t_pdp_scm_wrapper), "pdp"); - pg->packet = w.w_packet; - pg->update_func = SCM_BOOL_F; - SCM_NEWSMOB (thing, pdp_tag, pg); - break; - case a_symbol: - thing = scm_str2symbol(w.w_symbol->s_name); - break; - case a_float: - thing = scm_make_real (w.w_float); - break; - - default: - goto exit; - - } - pair = scm_cons2(tag, thing, SCM_EOL); - return pair; - - - exit: - return SCM_BOOL_F; -} - -static SCM -_out (SCM tag, SCM thing) -{ - t_pdp_symbol *stag; - SCM_ASSERT (SCM_SYMBOLP (tag), tag, SCM_ARG1, "out"); - stag = pdp_gensym(SCM_SYMBOL_CHARS(tag)); - - if (SCM_SMOB_PREDICATE(pdp_tag, thing)){ - t_pdp_scm_wrapper *pg = (t_pdp_scm_wrapper *) SCM_SMOB_DATA (thing); - guile_list_send(guile_outlist, stag, a_packet, - (t_pdp_word)(pdp_packet_copy_ro(pg->packet))); - } - else if (SCM_INUMP(thing)){ - int i = SCM_INUM(thing); - guile_list_send(guile_outlist, stag, a_int, (t_pdp_word)i); - } - else if (SCM_REALP(thing)){ - float f = (float)SCM_REAL_VALUE(thing); - guile_list_send(guile_outlist, stag, a_float, (t_pdp_word)f); - } - else if (SCM_SYMBOLP(thing)){ - char *s = SCM_SYMBOL_CHARS(thing); - guile_list_send(guile_outlist, stag, a_symbol, (t_pdp_word)(pdp_gensym(s))); - } - else if (SCM_CONSP(thing)){ - t_pdp_list *l = scm_to_pdp(thing); - guile_list_send(guile_outlist, stag, a_list, (t_pdp_word)l); - } - else{ - SCM_ASSERT (0, thing, SCM_ARG2, "out"); - } - - return SCM_BOOL_T; - -} - - -static SCM -test_pdp (SCM thing) -{ - if (SCM_SMOB_PREDICATE(pdp_tag, thing)) return SCM_BOOL_T; - else return SCM_BOOL_F; -} -static SCM -printdebugforthword_pdp (SCM thing) -{ - t_pdp_symbol *s; - t_pdp_atom *a; - SCM_ASSERT (SCM_SYMBOLP(thing), thing, SCM_ARG1, "pdp-debug-forth-word"); - s = pdp_gensym(SCM_SYMBOL_CHARS(thing)); - - pdp_forth_word_print_debug(s); - - return SCM_UNSPECIFIED; - -} - -static SCM -printdebug_pdp (SCM thing) -{ - if (SCM_INUMP(thing)){ - int p = SCM_INUM(thing); - pdp_packet_print_debug(p); - return SCM_UNSPECIFIED; - } - - SCM_ASSERT (SCM_SMOB_PREDICATE(pdp_tag, thing), thing, SCM_ARG1, "pdp-debug-packet"); - pdp_packet_print_debug(((t_pdp_scm_wrapper *) SCM_SMOB_DATA (thing))->packet); - return SCM_UNSPECIFIED; - -} -/* the inner main function. when this is called, guile - is initialized. when this function returns, exit(0) - is called. */ -static void guile_inner_main(void *closure, int argv, char **argc) -{ - /* initialize data types and functions */ - pdp_tag = scm_make_smob_type ("pdp", sizeof(t_pdp_scm_wrapper)); - scm_set_smob_free (pdp_tag, free_pdp); - scm_set_smob_print (pdp_tag, print_pdp); - scm_set_smob_mark (pdp_tag, mark_pdp); - - /* pdp stuff */ - scm_c_define_gsubr ("make-pdp", 1, 0, 0, make_pdp); - scm_c_define_gsubr ("writable?", 1, 0, 0, is_writable_pdp); - scm_c_define_gsubr ("pdp?", 1, 0, 0, test_pdp); - - /* communication */ - scm_c_define_gsubr ("in", 0, 0, 0, _in); - scm_c_define_gsubr ("out", 2, 0, 0, _out); - - /* pdp forth link */ - scm_c_define_gsubr ("forth", 2, 0, 0, forth_pdp); - scm_c_define_gsubr ("define-forth-word", 4, 0, 0, define_forth_word_pdp); - - /* debug methods */ - scm_c_define_gsubr ("mark-unused", 1, 0, 0, unmark_pdp); - scm_c_define_gsubr ("pdp-debug-packet", 1, 0, 0, printdebug_pdp); - scm_c_define_gsubr ("pdp-debug-forth-word", 1, 0, 0, printdebugforthword_pdp); - - /* start the shell */ - scm_c_eval_string("(set! scm-repl-prompt \"pdp> \")"); - - //scm_c_eval_string("(load \"/home/tom/.guile\")"); - //while(1) { - //post("read evaluate print loop"); - //scm_c_eval_string("(display scm-repl-prompt)(display (eval (read) (current-module)))(newline)"); - //} - - scm_shell(0,0); -} - - -/* the outer main function for booting the guile system - this is a separate thread */ -static void *guile_main(void *x) -{ - scm_boot_guile(0,0,guile_inner_main,0); - return 0; -} - - -/* start the thread that boots the guile system */ -static void guile_boot_in_thread(void) -{ - pthread_t thread; - pthread_attr_t attr; - - pthread_attr_init(&attr); - pthread_attr_setschedpolicy(&attr, SCHED_OTHER); - pthread_create(&thread, &attr, guile_main, 0); - -} - - -/* some restrictions on the pdp -> pd list conversion: - - - due to the nature of the pdp protocol in pd (3 phase) - a packet can not appear in a pd list. it will be sent out - as a pdp packet to the receiver corresponding to the tag. - the legal way to send a packet from guile is (out 'tag packet) - - - pd lists cannot be recursive, so pdp trees will need to be - flattened first. -*/ - -/* this sends a (flat pdp list) to a pd receiver - the list cannot contain pdp packets */ -static void pd_pdplist(void *thing, t_symbol *tag, t_pdp_list *l, int elements){ - t_atom pd_atom[elements]; - int i; - t_pdp_atom *a = l->first; - for (i=0; i<elements; i++,a=a->next){ - switch(a->t){ - case a_float: - SETFLOAT(pd_atom+i, a->w.w_float); break; - case a_int: - SETFLOAT(pd_atom+i, (float)a->w.w_int); break; - case a_pointer: - SETPOINTER(pd_atom+i, a->w.w_pointer); break; - case a_symbol: - SETSYMBOL(pd_atom+i, gensym(a->w.w_symbol->s_name)); break; - case a_packet: - post("ERROR: can't put packet %d inside a pd list (not a pd atom)", - a->w.w_packet); - SETSYMBOL(pd_atom+i, gensym("deadpacket")); break; - case a_list: - post("ERROR: can't put a list inside a pd list (not a pd atom):"); - pdp_list_print(a->w.w_list); - SETSYMBOL(pd_atom+i, gensym("deadlist")); break; - default: - SETSYMBOL(pd_atom+i, gensym("undef")); break; - - } - } - typedmess(thing, tag, elements, pd_atom); - - - pdp_tree_strip_packets(l); - pdp_tree_free(l); -} - - - -static void guile_callback(void *dummy) -{ - int skip = 1; - t_pdp_symbol *s = 0; - t_pdp_word_type type = a_undef; - t_pdp_word w; - t_atom atom[3]; - void *thing; - - t_symbol *tag_sym; - - if (!guile_list_receive(guile_outlist, &s, &type, &w)) goto exit; - - tag_sym = gensym(s->s_name); - thing = tag_sym->s_thing; - - //post("got something from guile"); - - if (!thing) goto exit; - - - - /* send to outlet */ - switch(type){ - case a_packet: - SETFLOAT(atom+1, (float)w.w_packet); - SETSYMBOL(atom+0, pdp_sym_rro()); - typedmess(thing, pdp_sym_pdp(), 2, atom); - SETSYMBOL(atom+0, pdp_sym_rrw()); - typedmess(thing, pdp_sym_pdp(), 2, atom); - SETSYMBOL(atom+0, pdp_sym_prc()); - typedmess(thing, pdp_sym_pdp(), 2, atom); - pdp_packet_mark_unused(w.w_packet); - break; - - case a_float: - pd_float(thing, w.w_float); - break; - - case a_int: - pd_float(thing, (float)w.w_int); - break; - - case a_symbol: - pd_symbol(thing, gensym(w.w_symbol->s_name)); - break; - - case a_list:{ - int elements = w.w_list->elements; - t_symbol *tag; - - if (elements){ - /* if first element is a symbol, we use it to tag the list */ - if (w.w_list->first->t == a_symbol){ - tag = gensym(w.w_list->first->w.w_symbol->s_name); - elements--; - pdp_list_pop(w.w_list); - pd_pdplist(thing, tag, w.w_list, elements); - } - /* else tag it as "list" */ - else { - pd_pdplist(thing, gensym("list"), w.w_list, elements); - - } - } - else{ //an empty list is a bang - pd_bang(thing); - } - break; - } - - default: - break; - } - - exit: - clock_delay(guile_clock, guile_clock_deltime); -} - - - -/* PD INTERFACE OBJECT */ - -t_class *scheme_send_class; - -typedef struct _scheme_send -{ - t_object x_obj; - t_outlet *x_outlet; - t_pdp_symbol *x_tag; -} t_scheme_send; - - -static void *scheme_send_new(t_symbol *s) -{ - t_scheme_send *x = 0; - x = (t_scheme_send *)pd_new(scheme_send_class); - - x->x_tag = (s == gensym("")) ? - x->x_tag = pdp_gensym("dummy") : pdp_gensym(s->s_name); - - return (void*)x; -} - -static void scheme_send_anything(t_scheme_send *x, t_symbol *s, int argc, t_atom *argv) -{ - void *thing = 0; - - if (s == &s_float && argc == 1 && argv[0].a_type == A_FLOAT){ - guile_list_send(guile_inlist, x->x_tag, a_float, - (t_pdp_word)argv[1].a_w.w_float); - } - - else if (s == &s_symbol && argc == 1 && argv[0].a_type == A_SYMBOL){ - guile_list_send(guile_inlist, x->x_tag, a_symbol, - (t_pdp_word)pdp_gensym(argv[0].a_w.w_symbol->s_name)); - } - - else if (argc == 0){ - guile_list_send(guile_inlist, x->x_tag, a_symbol, - (t_pdp_word)pdp_gensym(s->s_name)); - } - - else if (s == gensym("pdp") - && argc == 2 - && argv[0].a_type == A_SYMBOL - && argv[0].a_w.w_symbol == gensym("register_ro") - && argv[1].a_type == A_FLOAT){ - - guile_list_send(guile_inlist, x->x_tag, a_packet, - (t_pdp_word)pdp_packet_copy_ro((int)argv[1].a_w.w_float)); - } - -} - - - - -static void scheme_send_free(t_scheme_send *x) -{ -} - -void pdp_guile_setup(void) -{ - - post("PDP: scheme extension"); - - /* setup guile interpreter */ - guile_boot_in_thread(); - - /* setup communication stuff */ - guile_inlist = pdp_list_new(0); - guile_outlist = pdp_list_new(0); - - pthread_mutex_init(&guile_mux, NULL); - guile_clock_deltime = 1.0f; - guile_clock = clock_new(0, (t_method)guile_callback); - clock_delay(guile_clock, guile_clock_deltime); - - - - /* create interface class */ - scheme_send_class = class_new(gensym("ss"), (t_newmethod)scheme_send_new, - (t_method)scheme_send_free, sizeof(t_scheme_send), 0, A_DEFSYMBOL, A_NULL); - - class_addanything(scheme_send_class, scheme_send_anything); -} - diff --git a/guile/pdp_guile.scm b/guile/pdp_guile.scm deleted file mode 100644 index 8ca17f2..0000000 --- a/guile/pdp_guile.scm +++ /dev/null @@ -1,37 +0,0 @@ -; pdp_guile.scm - a simple event dispatcher to be used with pdp_guile - -; some global variables -(define input-hash (make-hash-table 31)) -(define input-loop-flag #t) -(define input-loop-interval-ms 10) - -; add an input handler -(define (add-input! tag handler) - (hashq-create-handle! input-hash tag handler)) - -; the main input dispatcher loop -(define (input-loop) - (while input-loop-flag - (usleep (* input-loop-interval-ms 1000)) - (let nextmsg ((msg (in))) - (if msg - (begin - (let ((fn (hashq-ref input-hash (car msg)))) - (if fn (fn (cadr msg)))) - (nextmsg (in))))))) - -(define (start) - (set! input-loop-flag #t) - (out 'start 'bang) - (input-loop)) - - -; the control message handler -(add-input! 'control - (lambda (thing) - (case thing - ('stop (set! input-loop-flag #f)) ; stop the input loop and return to interpreter - ('gc (gc))))) ; call the garbage collector - - - diff --git a/guile/testguile.pd b/guile/testguile.pd deleted file mode 100644 index 0ddb253..0000000 --- a/guile/testguile.pd +++ /dev/null @@ -1,38 +0,0 @@ -#N canvas 197 59 766 427 10; -#X obj 158 49 metro 1000; -#X obj 161 77 bng 15 250 50 0 empty empty empty 0 -6 0 8 -262144 -1 --1; -#X obj 160 23 loadbang; -#X obj 128 235 pdp_xv; -#X obj 293 39 bng 15 250 50 0 empty empty empty 0 -6 0 8 -262144 -1 --1; -#X obj 293 71 pdp_v4l; -#X obj 347 35 metro 10; -#X obj 345 12 bng 15 250 50 0 empty empty empty 0 -6 0 8 -262144 -1 --1; -#X obj 72 210 r iet; -#X floatatom 72 238 5 0 0 0 - - -; -#X obj 128 211 r out-vid; -#X obj 293 106 ss in-vid; -#X obj 352 144 ss test; -#X obj 479 193 ss control; -#X msg 477 164 stop; -#X msg 521 164 gc; -#X obj 522 129 metro 1000; -#X obj 523 106 tgl 15 0 empty empty empty 0 -6 0 8 -262144 -1 -1 1 -1; -#X obj 522 81 loadbang; -#X connect 0 0 1 0; -#X connect 2 0 0 0; -#X connect 4 0 5 0; -#X connect 5 0 11 0; -#X connect 5 0 12 0; -#X connect 6 0 5 0; -#X connect 7 0 6 0; -#X connect 8 0 9 0; -#X connect 10 0 3 0; -#X connect 14 0 13 0; -#X connect 15 0 13 0; -#X connect 16 0 15 0; -#X connect 17 0 16 0; -#X connect 18 0 17 0; |