[PD-cvs] externals/k_guile Makefile,NONE,1.1 README,NONE,1.1 add.scm,NONE,1.1 gen_c_scheme.py,NONE,1.1 global.scm,NONE,1.1 help-k_guile.pd,NONE,1.1 inout.scm,NONE,1.1 k_guile.c,NONE,1.1 local.scm,NONE,1.1 mozilla.scm,NONE,1.1 send_receive.scm,NONE,1.1
ksvalast at users.sourceforge.net
ksvalast at users.sourceforge.net
Thu Jan 8 15:55:26 CET 2004
- Previous message: [PD-cvs] externals/k_cext Makefile,NONE,1.1 README,NONE,1.1 help-do.pd,NONE,1.1 help-fibonacci.pd,NONE,1.1 help-gcd.pd,NONE,1.1 help-k_cext.pd,NONE,1.1 help-k_cext2.pd,NONE,1.1 help-k_cfunc.pd,NONE,1.1 help-markov.pd,NONE,1.1 help-rangeifelifelse.pd,NONE,1.1 help-send.pd,NONE,1.1 help-sort.pd,NONE,1.1 k_cext.c,NONE,1.1 k_cext.h,NONE,1.1 k_cext_funchandler.c,NONE,1.1 k_cext_generatecode.c,NONE,1.1 k_cext_macosx.c,NONE,1.1 k_cext_unix.c,NONE,1.1 k_cext_win.c,NONE,1.1 test.pd,NONE,1.1
- Next message: [PD-cvs] externals/k_vst~ Makefile,NONE,1.1 README,NONE,1.1 abyss.pd,NONE,1.1 config.h,NONE,1.1 help-k_vst~.pd,NONE,1.1 help2-k_vst~.pd,NONE,1.1 k_vst~.c,NONE,1.1 plugin~.h,NONE,1.1 plugin~_ladspa.h,NONE,1.1 plugin~_vst.c,NONE,1.1 plugin~_vst.h,NONE,1.1 version.h,NONE,1.1 vstutils.h,NONE,1.1
- Messages sorted by:
[ date ]
[ thread ]
[ subject ]
[ author ]
Update of /cvsroot/pure-data/externals/k_guile
In directory sc8-pr-cvs1:/tmp/cvs-serv12055/k_guile
Added Files:
Makefile README add.scm gen_c_scheme.py global.scm
help-k_guile.pd inout.scm k_guile.c local.scm mozilla.scm
send_receive.scm
Log Message:
First commit of k_vst~, k_guile and k_cext
--- NEW FILE: Makefile ---
NAME=k_guile
CSYM=k_guile
DIR=k_guile
current: pd_linux
# ----------------------- NT -----------------------
pd_nt: $(NAME).dll
.SUFFIXES: .dll
PDNTCFLAGS = /W3 /WX /DNT /DPD /nologo /DINCLUDEPATH=\"c:\\pd\"
VC="C:\Programme\Microsoft Visual Studio\Vc98"
PDNTINCLUDE = /I. /I\tcl\include /Ic:\pd\src /I$(VC)\include
PDNTLDIR = $(VC)\lib
PDNTLIB = $(PDNTLDIR)\libc.lib \
$(PDNTLDIR)\oldnames.lib \
$(PDNTLDIR)\kernel32.lib \
c:\pd\bin\pd.lib
.c.dll:
cl $(PDNTCFLAGS) $(PDNTINCLUDE) /c k_guile_win.c
cl $(PDNTCFLAGS) $(PDNTINCLUDE) /c $*.c
link /dll /export:$(CSYM)_setup $*.obj k_guile_win.obj $(PDNTLIB)
# ----------------------- IRIX 5.x -----------------------
pd_irix5: $(NAME).pd_irix5
.SUFFIXES: .pd_irix5
SGICFLAGS5 = -o32 -DPD -DUNIX -DIRIX -O2
SGIINCLUDE = -I../../src
.c.pd_irix5:
cc $(SGICFLAGS5) $(SGIINCLUDE) -o $*.o -c $*.c
ld -elf -shared -rdata_shared -o $*.pd_irix5 $*.o
rm $*.o
# ----------------------- IRIX 6.x -----------------------
pd_irix6: $(NAME).pd_irix6
.SUFFIXES: .pd_irix6
SGICFLAGS6 = -n32 -DPD -DUNIX -DIRIX -DN32 -woff 1080,1064,1185 \
-OPT:roundoff=3 -OPT:IEEE_arithmetic=3 -OPT:cray_ivdep=true \
-Ofast=ip32
.c.pd_irix6:
cc $(SGICFLAGS6) $(SGIINCLUDE) -o $*.o -c $*.c
ld -n32 -IPA -shared -rdata_shared -o $*.pd_irix6 $*.o
rm $*.o
# ----------------------- LINUX i386 -----------------------
pd_linux: $(NAME).pd_linux
.SUFFIXES: .pd_linux
LINUXCFLAGS = -DPD -DUNIX -DICECAST -O2 -funroll-loops -fomit-frame-pointer \
-Wall -W -Wno-shadow -Wstrict-prototypes \
-Wno-unused -Wno-parentheses -Wno-switch #-Werror
LINUXINCLUDEPATH=../../src
LINUXINCLUDE = -I$(LINUXINCLUDEPATH)
$(NAME).pd_linux: $(NAME).o
ld -export_dynamic -shared -o $(NAME).pd_linux k_guile.o -lc -lm -lguile
strip --strip-unneeded $*.pd_linux
rm -f $*.o ../$*.pd_linux
ln -s $(DIR)/$*.pd_linux ..
$(NAME).o: $(NAME).c global_scm.txt local_scm.txt
cc $(LINUXCFLAGS) $(LINUXINCLUDE) -o $(NAME).o -c $(NAME).c
# ----------------------- Mac OSX -----------------------
pd_darwin: $(NAME).pd_darwin k_guile.c
.SUFFIXES: .pd_darwin
DARWINCFLAGS = -DPD -O2 -Wall -W -Wshadow -Wstrict-prototypes \
-Wno-unused -Wno-parentheses -Wno-switch
.c.pd_darwin: global_scm.txt local_scm.txt
cc $(DARWINCFLAGS) $(LINUXINCLUDE) -DINCLUDEPATH=\""`pwd`"\" -DLINUXINCLUDE=\""$(LINUXINCLUDEPATH)"\ -o $*.o -c k_guile.c
cc -bundle -undefined suppress -flat_namespace -o $*.pd_darwin $*.o
rm -f $*.o ../$*.pd_darwin
ln -s $*/$*.pd_darwin ..
# ----------------------------------------------------------
global_scm.txt: global.scm gen_c_scheme.py
./gen_c_scheme.py global.scm >global_scm.txt
local_scm.txt: local.scm gen_c_scheme.py
./gen_c_scheme.py local.scm >local_scm.txt
install:
cp help-*.pd ../../doc/5.reference
clean:
rm -f *.o *.pd_* so_locations *~ core global_scm.txt local_scm.txt
--- NEW FILE: README ---
k_guile PD external
--------------------------------------------
V0.0.1
-This external makes you able to use guile as an extension language for
PD. Guile is a scheme interpreter. The API is inspired by
the python pyext external made by Thomas Grill, and a small part of
the code is made by looking at the flext source.
-To be able to use it, you should first know the lisp programming language,
then check out the help-k_guile.pd example patch and read the small
example-scripts that the patch loads.
API
-------------------------------------------
k_guile provides the following functions:
* (pd-inlets num-inlets)
- Sets number of inlets for the object.
- add.scm, inout.scm
- Local function.
* (pd-outlets num-outlets)
- Sets number of outlets for the object.
- add.scm, inout.scm
- Local function.
* (pd-inlet inlet-num type func)
- "func" is a function that is called when the object
receives a message to the inlet "inlet-num" of type
"type". Normal values for "type" are 'float, 'list,
'bang, etc.
- add.scm, inout.scm
- Local function.
* (pd-outlet outlet-num arg0 arg1 ...)
- Sends value(s) to outlet "outlet-num".
The argument(s) can be of any kind.
- add.scm, inout.scm
- Local function.
* (pd-bind symbol func)
- Pd messages sent to "symbol" arrives at the "func" function.
- send_receive.scm
- Both local and global
* (pd-unbind symbol)
- Stop receiving messages sent to "symbol".
- Both local and global. For the local version, all bindings
are automatically unbinded when the object is destroyed or
reloaded.
* (pd-send symbol arg0 arg1 ...)
- Sends value(s) to receivers for "symbol". "Symbol" can either
be a scheme or a pd symbol.
- send_receive.scm
- Global function.
* (pd-get-symbol symbol)
- Returns the pd symbol for the scheme symbol "symbol".
pd-send works faster when a pd symbol is used instead of a scheme symbol.
- send_receive.scm
- Global function.
* (pd-set-destroy-func thunk)
- "thunk" is called before the object is destroyed or reloaded.
- Local function.
Scheme programming with the k_guile object.
--------------------------------------------------
-The code executed lives in its own local namespace
spesific for the pd object. If you need or want to
break out of the local namespace, simply just use
(load ) to let another script run in the global
namespace.
-If you need to call pd-inlets or pd-outlets, they
should/must be the first functions to call in the
script. The default number of inlets is 1,
and the default number of outlets is 0.
-Some global debugging options are set at the top
of the global.scm file. You might want to edit
those values _before compiling_ the k_guile external.
-None of the functions have been made with
thread-safety in mind.
-Backtracing doesn't work properly. Don't know why.
--------------------------------------------------
Kjetil S. Matheussen, k.s.matheussen at notam02.no
last updated 4.1.2004
--- NEW FILE: add.scm ---
(pd-inlets 2)
(pd-outlets 1)
(let ((inlet1 0))
(pd-inlet 1 'float
(lambda (x)
(set! inlet1 x)))
(pd-inlet 0 'float
(lambda (x)
(pd-outlet 0 (+ inlet1 x)))))
--- NEW FILE: gen_c_scheme.py ---
#!/usr/bin/env python
import sys,string
file=open(sys.argv[1],"r")
while 1:
line=""
while line=="" or line=="\n" or line[0:1]==";":
line=file.readline()
if line=="":
file.close()
sys.exit(0)
line=string.replace(line[:-1],'\\','\\\\')
sys.stdout.write('"'+string.replace(line,'"','\\"')+'\\n"\n')
--- NEW FILE: global.scm ---
;; These functions are global functions available for all guile scripts loaded into PD.
;; Kjetil S. Matheussen, 2004.
;;/* 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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
;;/* */
(debug-enable 'debug)
(debug-enable 'trace)
(debug-enable 'backtrace)
(use-modules (ice-9 stack-catch))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Misc. functions
;;
;;
(define (pd-display . args)
(if (not (null? args))
(begin
(display (car args))
(apply pd-display (cdr args)))
(newline)))
(define (pd-filter proc list)
(if (null? list)
'()
(if (proc (car list))
(cons (car list) (pd-filter proc (cdr list)))
(pd-filter proc (cdr list)))))
(define (pd-for init pred least add proc)
(if (pred init least)
(begin
(proc init)
(pd-for (+ add init) pred least add proc))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Argument checking
;;
;;
(define (pd-check-number number message)
(if (number? number)
#t
(begin
(pd-display message ": " number " is not a number")
#f)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Bindings
;;
;;
(define pd-global-bindings '())
(define (pd-bind-do symbol func bindings)
(if (or (not (symbol? symbol))
(not (procedure? func)))
(begin
(pd-display "Wrong arguments for pd-bind")
bindings)
(cons (list symbol
func
(pd-c-bind symbol func))
bindings)))
(define (pd-unbind-do symbol bindings)
(if (not (symbol? symbol))
(begin
(pd-display "Wrong arguments for pd-unbind")
bindings)
(let ((binding (assq symbol bindings)))
(pd-c-unbind (caddr binding) symbol)
(pd-filter (lambda (x) (not (eq? symbol (car x))))
bindings))))
(define (pd-bind symbol func)
(set! pd-global-bindings (pd-bind-do symbol func pd-global-bindings)))
(define (pd-unbind symbol)
(set! pd-global-bindings (pd-unbind-do symbol pd-global-bindings)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Sending
;;
;;
(define (pd-send symbol firstarg . args)
(if (or (symbol? symbol)
(number? symbol))
(cond ((> (length args) 0) (pd-c-send-list symbol (cons firstarg args)))
((list? firstarg) (pd-c-send-list symbol firstarg))
((number? firstarg) (pd-c-send-number symbol firstarg))
((string? firstarg) (pd-c-send-string symbol firstarg))
((eq? 'bang firstarg) (pd-c-send-bang symbol))
((symbol? firstarg) (pd-c-send-symbol symbol firstarg))
(else
(pd-display "Unknown argument to pd-outlet-or-send:" firstarg)))))
(define (pd-get-symbol sym)
(if (not (symbol? sym))
(pd-display sym " is not a scheme symbol")
(pd-c-get-symbol sym)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Backtrace (does not work properly)
;;
;;
(define (pd-display-errorfunc key . args)
(let ((dasstack (make-stack #t)))
(display-backtrace dasstack (current-output-port) #f #f)
;(display (stack-ref (make-stack #t) 1))
;(display (stack-length (make-stack #t)))
(display key)(newline)
(display args)
(newline))
0)
(define (pd-backtrace-run thunk)
(stack-catch #t
thunk
pd-display-errorfunc))
(define (pd-backtrace-run1 func arg1)
(stack-catch #t
(lambda ()
(func arg1))
pd-display-errorfunc))
(define (pd-backtrace-run2 func arg1 arg2)
(stack-catch #t
(lambda ()
(func arg1 arg2))
pd-display-errorfunc))
(define (pd-backtrace-run3 func arg1 arg2 arg3)
(stack-catch #t
(lambda ()
(func arg1 arg2 arg3))
pd-display-errorfunc))
(define (pd-backtrace-run4 func arg1 arg2 arg3 arg4)
(stack-catch #t
(lambda ()
(func arg1 arg2 arg3 arg4))
pd-display-errorfunc))
--- NEW FILE: help-k_guile.pd ---
#N canvas 372 11 707 547 10;
#X obj 101 135 nbx 5 14 -1e+37 1e+37 0 0 empty empty empty 0 -6 0 10
-262144 -1 -1 93 256;
#X obj 101 162 k_guile add.scm;
#X obj 101 195 nbx 5 14 -1e+37 1e+37 0 0 empty empty empty 0 -6 0 10
-262144 -1 -1 220 256;
#X obj 201 137 nbx 5 14 -1e+37 1e+37 0 0 empty empty empty 0 -6 0 10
-262144 -1 -1 127 256;
#X msg 38 134 reload;
#X obj 341 157 k_guile send_receive.scm;
#X msg 341 127 reload;
#X obj 483 130 s in;
#X obj 512 97 nbx 5 14 -1e+37 1e+37 0 0 empty empty empty 0 -6 0 10
-262144 -1 -1 6 256;
#X obj 475 186 r out;
#X msg 468 95 gakk;
#X obj 475 215 print;
#X obj 580 95 bng 15 250 50 0 empty empty empty 0 -6 0 8 -262144 -1
-1;
#X msg 608 96 list 2 3 4;
#X text 27 19 k_guile - guile external for PD.;
#X text 26 36 Kjetil S. Matheussen \, 2004;
#X obj 130 301 nbx 5 14 -1e+37 1e+37 0 0 empty empty empty 0 -6 0 10
-262144 -1 -1 62 256;
#X obj 255 300 nbx 5 14 -1e+37 1e+37 0 0 empty empty empty 0 -6 0 10
-262144 -1 -1 82 256;
#X obj 71 301 nbx 5 14 -1e+37 1e+37 0 0 empty empty empty 0 -6 0 10
-262144 -1 -1 22 256;
#X obj 71 388 nbx 5 14 -1e+37 1e+37 0 0 empty empty empty 0 -6 0 10
-262144 -1 -1 95 256;
#X obj 146 389 nbx 5 14 -1e+37 1e+37 0 0 empty empty empty 0 -6 0 10
-262144 -1 -1 267 256;
#X obj 213 390 nbx 5 14 -1e+37 1e+37 0 0 empty empty empty 0 -6 0 10
-262144 -1 -1 428 256;
#X msg 17 300 reload;
#X obj 75 341 k_guile inout.scm;
#X obj 436 346 k_guile mozilla.scm;
#X msg 436 301 start;
#X text 300 496 Note \; you can not change the number of inlets and
outlets by sending "reload".;
#X msg 316 299 testing;
#X msg 190 299 testing;
#X msg 409 95 we 3 2;
#X connect 0 0 1 0;
#X connect 1 0 2 0;
#X connect 3 0 1 1;
#X connect 4 0 1 0;
#X connect 6 0 5 0;
#X connect 8 0 7 0;
#X connect 9 0 11 0;
#X connect 10 0 7 0;
#X connect 12 0 7 0;
#X connect 13 0 7 0;
#X connect 16 0 23 152;
#X connect 17 0 23 323;
#X connect 18 0 23 9;
#X connect 22 0 23 0;
#X connect 23 13 19 0;
#X connect 23 185 20 0;
#X connect 23 346 21 0;
#X connect 25 0 24 0;
#X connect 27 0 23 396;
#X connect 28 0 23 284;
#X connect 29 0 7 0;
--- NEW FILE: inout.scm ---
(define num-inouts 400)
(pd-inlets num-inouts)
(pd-outlets num-inouts)
(pd-for 0 < num-inouts 1
(lambda (i)
(pd-inlet i 'float
(lambda (x)
(pd-display "Got " x " to inlet " i)
(pd-for 0 < num-inouts 1
(lambda (i2)
(pd-outlet i2 (+ i2 x))))))))
(pd-inlet 284 'testing
(lambda ()
(pd-display "This is a function for handling 'testing sent to inlet 284.")))
--- NEW FILE: k_guile.c ---
/* --------------------------- k_guile ----------------------------------- */
/* ;; Kjetil S. Matheussen, 2004. */
/* */
/* 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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
/* */
/* ---------------------------------------------------------------------------- */
#include "libguile.h"
/* Need some more macros. */
#define POINTER_P(x) (((int) (x) & 3) == 0)
#define INTEGER_P(x) (! POINTER_P (x))
#define GET_INTEGER SCM_INUM
#define MAKE_INTEGER SCM_MAKINUM
#define MAKE_STRING(a) scm_mem2string(a,strlen(a))
#define EVAL(a) scm_eval_string(MAKE_STRING(a))
#define EVALINT(a) do{char tempstring[500];sprintf(tempstring,"%d",a);EVAL(tempstring);}while(0)
#define MAKE_SYM(a) gensym(SCM_SYMBOL_CHARS(a))
#define MAKE_POINTER(a) scm_ulong2num((unsigned long)a)
#define GET_POINTER(a) (void *)scm_num2ulong(a,0,"GET_POINTER()")
#define GET_X(a) ((t_k_guile *)GET_POINTER(a))
#define RU_ return SCM_UNSPECIFIED
#include "m_pd.h"
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <math.h>
#include <stdbool.h>
#include <stdarg.h>
struct k_guile_workaround;
typedef struct k_guile
{
t_object x_ob;
int num_ins;
int num_outs;
struct k_guile_workaround **inlets;
t_outlet **outlets;
SCM inlet_func;
SCM cleanup_func;
char *filename;
bool isinited;
} t_k_guile;
typedef struct k_guile_workaround{
t_object x_ob;
t_k_guile *x;
t_inlet *inlet;
int index;
SCM func;
} t_k_guile_workaround;
#define KG_MAX(a,b) (((a)>(b))?(a):(b))
#define KG_MIN(a,b) (((a)<(b))?(a):(b))
static char *version =
"k_guile v0.0.1, written by Kjetil S. Matheussen, k.s.matheussen at notam02.no";
static t_class *k_guile_class, *k_guile_workaroundclass;
static SCM pd_backtrace_run;
static SCM pd_backtrace_run1;
static SCM pd_backtrace_run2;
static SCM pd_backtrace_run3;
static SCM pd_backtrace_run4;
/*****************************************************************************************************
*****************************************************************************************************
* Functions to evaluate large amount of scheme code from C.
*****************************************************************************************************
*****************************************************************************************************/
static char *evalstring=NULL;
static void eval2(char *string){
char *new;
if(evalstring==NULL){
new=malloc(strlen(string)+1);
sprintf(new,"%s",string);
}else{
new=malloc(strlen(evalstring)+strlen(string)+1);
sprintf(new,"%s%s",evalstring,string);
free(evalstring);
}
evalstring=new;
}
static void eval_file(FILE *file){
char line[50000];
for(;;){
int c=fgetc(file);
if(c==EOF) break;
ungetc(c,file);
fgets(line,49999,file);
eval2(line);
}
}
static SCM eval_do(void){
//post(evalstring);
SCM ret=EVAL(evalstring);
free(evalstring);
evalstring=NULL;
return ret;
}
/*****************************************************************************************************
*****************************************************************************************************
* Sending data to the guile side. Called either via bind or an inlet.
*****************************************************************************************************
*****************************************************************************************************/
static void k_guile_anything_do(t_k_guile *x,int index,SCM func,t_symbol *s, t_int argc, t_atom* argv){
int lokke;
SCM applyarg=SCM_EOL;
for(lokke=argc-1;lokke>=0;lokke--){
SCM to=SCM_BOOL_F;
switch(argv[lokke].a_type){
case A_NULL:
to=SCM_EOL;
break;
case A_FLOAT:
to=scm_make_real(atom_getfloatarg(lokke,argc,argv));
break;
case A_SYMBOL:
to=scm_string_to_symbol(MAKE_STRING(atom_getsymbolarg(lokke,argc,argv)->s_name));
break;
default:
post("Strange");
break;
}
applyarg=scm_cons(to,applyarg);
}
if(index>=0){
// Inlet
scm_call_4(pd_backtrace_run3,x->inlet_func,MAKE_INTEGER(index),scm_string_to_symbol(MAKE_STRING(s->s_name)),applyarg);
}else{
// Binding
if(s!=&s_float && s!=&s_list && s!=&s_symbol){
applyarg=scm_cons(scm_string_to_symbol(MAKE_STRING(s->s_name)),applyarg);
}
if(s!=&s_list && GET_INTEGER(scm_length(applyarg))==1)
applyarg=SCM_CAR(applyarg);
scm_call_2(pd_backtrace_run1,func,applyarg);
}
}
// Handles inlet>0 and bindings
static void k_guile_anything(t_k_guile_workaround *x2,t_symbol *s, t_int argc, t_atom* argv){
if(x2->index>=0){
// Inlet
k_guile_anything_do(x2->x,x2->index,0,s,argc,argv);
}else{
// Binding
k_guile_anything_do(NULL,x2->index,x2->func,s,argc,argv);
}
}
// Handles first inlet
static void k_guile_anything_first(t_k_guile *x,t_symbol *s, t_int argc, t_atom* argv){
k_guile_anything_do(x,0,0,s,argc,argv);
}
/*****************************************************************************************************
*****************************************************************************************************
* Initialization, called from the guile side.
*****************************************************************************************************
*****************************************************************************************************/
static SCM gpd_set_inlet_func(SCM instance,SCM func){
t_k_guile *x=GET_X(instance);
x->inlet_func=func;
scm_gc_protect_object(x->inlet_func);
RU_;
}
static SCM gpd_set_cleanup_func(SCM instance,SCM func){
t_k_guile *x=GET_X(instance);
x->cleanup_func=func;
scm_gc_protect_object(x->cleanup_func);
RU_;
}
static SCM gpd_inlets(SCM instance,SCM num_ins){
int lokke;
t_k_guile *x=GET_X(instance);
if(x->isinited==true) goto exit;
x->num_ins=GET_INTEGER(num_ins);
x->inlets=calloc(sizeof(t_k_guile_workaround*),x->num_ins);
for(lokke=1;lokke<x->num_ins;lokke++){
t_k_guile_workaround *x2;
x2=(t_k_guile_workaround*)pd_new(k_guile_workaroundclass);
x->inlets[lokke]=x2;
x2->x=x;
x2->index=lokke;
x2->inlet=inlet_new(&x->x_ob,(t_pd*)x2,0,0);
}
exit:
RU_;
}
static SCM gpd_outlets(SCM instance,SCM num_outs){
int lokke;
t_k_guile *x=GET_X(instance);
if(x->isinited==true) goto exit;
x->num_outs=GET_INTEGER(num_outs);
x->outlets=calloc(sizeof(t_outlet*),x->num_outs);
for(lokke=0;lokke<x->num_outs;lokke++){
x->outlets[lokke] = outlet_new(&x->x_ob, gensym("anything"));
}
exit:
RU_;
}
static SCM gpd_inited_p(SCM instance){
t_k_guile *x=GET_X(instance);
if(x->isinited==true) return SCM_BOOL_T;
return SCM_BOOL_F;
}
static SCM gpd_get_num_inlets(SCM instance){
t_k_guile *x=GET_X(instance);
return MAKE_INTEGER(x->num_ins);
}
static SCM gpd_get_num_outlets(SCM instance){
t_k_guile *x=GET_X(instance);
return MAKE_INTEGER(x->num_outs);
}
/*****************************************************************************************************
*****************************************************************************************************
* Binding and unbinding. Called from the guile side.
*****************************************************************************************************
*****************************************************************************************************/
static SCM gpd_bind(SCM symname,SCM func){
t_k_guile_workaround *x2;
x2=(t_k_guile_workaround*)pd_new(k_guile_workaroundclass);
x2->index=-1;
x2->func=func;
scm_protect_object(x2->func);
pd_bind((t_pd *)x2, MAKE_SYM(symname));
return MAKE_POINTER(x2);
}
static SCM gpd_unbind(SCM scm_x2,SCM symname){
t_k_guile_workaround *x2=GET_POINTER(scm_x2);
pd_unbind((t_pd *)x2,MAKE_SYM(symname));
scm_unprotect_object(x2->func);
pd_free((t_pd*)x2);
RU_;
}
/*****************************************************************************************************
*****************************************************************************************************
* Got data from the guile side. Distributing to outlets or receivers.
* The guile side is responsible for checking that the arguments are correct.
*****************************************************************************************************
*****************************************************************************************************/
#define GET_CLASS() (INTEGER_P(symbol)?(t_symbol*)GET_POINTER(symbol):MAKE_SYM(symbol))->s_thing
#define CLASS_INIT t_class **s=GET_CLASS();if(s==NULL) post("no receiver"); else
#define GET_OUTLET() GET_X(instance)->outlets[GET_INTEGER(outlet)]
/* Number -> float */
static SCM gpd_outlet_number(SCM instance,SCM outlet,SCM val){
outlet_float(GET_OUTLET(),scm_num2dbl(val,"gpd_outlet"));
RU_;
}
static SCM gpd_send_number(SCM symbol,SCM val){
CLASS_INIT
pd_float(s,scm_num2dbl(val,"gpd_send_number"));
RU_;
}
/* List -> list */
static t_atom *make_list(t_atom *atom,SCM val){
int lokke;
int length=GET_INTEGER(scm_length(val));
for(lokke=0;lokke<length;lokke++){
SCM el=scm_list_ref(val,MAKE_INTEGER(lokke));
t_atom *to=&atom[lokke];
if(SCM_INUMP(el)){
SETFLOAT(to,(float)GET_INTEGER(el));
}else{
if(SCM_UNBNDP(el)){
SETSYMBOL(to,gensym("undefined"));
}else{
if(SCM_STRINGP(el)){
SETSYMBOL(to,gensym(SCM_STRING_CHARS(el)));
}else{
if(SCM_SYMBOLP(el)){
SETSYMBOL(to,MAKE_SYM(el));
}else{
if(scm_number_p(el)){
if(scm_real_p(el)){
SETFLOAT(to,(float)scm_num2dbl(el,"gpd_outlet_or_send_list"));
}else{
post("Illegal argument to gdp_outlet_or_send_list. Setting atom to 0.");
SETFLOAT(to,0.0f);
}
}
}
}
}
}
}
return atom;
}
static SCM gpd_outlet_list(SCM instance,SCM outlet,SCM val){
int length=GET_INTEGER(scm_length(val));
t_atom atom[length];
outlet_list(GET_OUTLET(), &s_list,length,make_list(atom,val));
RU_;
}
static SCM gpd_send_list(SCM symbol,SCM val){
int length=GET_INTEGER(scm_length(val));
t_atom atom[length];
CLASS_INIT
pd_list(s, &s_list,length,make_list(atom,val));
RU_;
}
/* Symbol -> symbol */
static SCM gpd_outlet_symbol(SCM instance,SCM outlet,SCM val){
outlet_symbol(GET_OUTLET(),MAKE_SYM(val));
RU_;
}
static SCM gpd_send_symbol(SCM symbol,SCM val){
CLASS_INIT
pd_symbol(s,MAKE_SYM(val));
RU_;
}
/* String -> symbol */
static SCM gpd_outlet_string(SCM instance,SCM outlet,SCM val){
outlet_symbol(GET_OUTLET(),gensym(SCM_STRING_CHARS(val)));
RU_;
}
static SCM gpd_send_string(SCM symbol,SCM val){
CLASS_INIT
pd_symbol(s,gensym(SCM_STRING_CHARS(val)));
RU_;
}
/* Bang -> bang */
static SCM gpd_outlet_bang(SCM instance,SCM outlet){
outlet_bang(GET_OUTLET());
RU_;
}
static SCM gpd_send_bang(SCM symbol){
CLASS_INIT
pd_bang(s);
RU_;
}
/* <- symbol */
static SCM gpd_get_symbol(SCM symname){
return MAKE_POINTER(MAKE_SYM(symname));
}
/*****************************************************************************************************
*****************************************************************************************************
* Setting up global guile functions.
*****************************************************************************************************
*****************************************************************************************************/
static void k_guile_init(void){
char *command=
#include "global_scm.txt"
;
scm_init_guile();
scm_c_define_gsubr("pd-c-outlets",2,0,0,gpd_outlets);
scm_c_define_gsubr("pd-c-inlets",2,0,0,gpd_inlets);
scm_c_define_gsubr("pd-c-inited?",1,0,0,gpd_inited_p);
scm_c_define_gsubr("pd-c-get-num-inlets",1,0,0,gpd_get_num_inlets);
scm_c_define_gsubr("pd-c-get-num-outlets",1,0,0,gpd_get_num_outlets);
scm_c_define_gsubr("pd-c-set-inlet-func",2,0,0,gpd_set_inlet_func);
scm_c_define_gsubr("pd-c-set-cleanup-func",2,0,0,gpd_set_cleanup_func);
scm_c_define_gsubr("pd-c-bind",2,0,0,gpd_bind);
scm_c_define_gsubr("pd-c-unbind",2,0,0,gpd_unbind);
scm_c_define_gsubr("pd-c-outlet-number",3,0,0,gpd_outlet_number);
scm_c_define_gsubr("pd-c-outlet-list",3,0,0,gpd_outlet_list);
scm_c_define_gsubr("pd-c-outlet-symbol",3,0,0,gpd_outlet_symbol);
scm_c_define_gsubr("pd-c-outlet-string",3,0,0,gpd_outlet_string);
scm_c_define_gsubr("pd-c-outlet-bang",2,0,0,gpd_outlet_bang);
scm_c_define_gsubr("pd-c-send-number",2,0,0,gpd_send_number);
scm_c_define_gsubr("pd-c-send-list",2,0,0,gpd_send_list);
scm_c_define_gsubr("pd-c-send-symbol",2,0,0,gpd_send_symbol);
scm_c_define_gsubr("pd-c-send-string",2,0,0,gpd_send_string);
scm_c_define_gsubr("pd-c-send-bang",1,0,0,gpd_send_bang);
scm_c_define_gsubr("pd-c-get-symbol",1,0,0,gpd_get_symbol);
EVAL(command);
pd_backtrace_run=EVAL("pd-backtrace-run");
scm_permanent_object(pd_backtrace_run);
pd_backtrace_run1=EVAL("pd-backtrace-run1");
scm_permanent_object(pd_backtrace_run1);
pd_backtrace_run2=EVAL("pd-backtrace-run2");
scm_permanent_object(pd_backtrace_run2);
pd_backtrace_run3=EVAL("pd-backtrace-run3");
scm_permanent_object(pd_backtrace_run3);
pd_backtrace_run4=EVAL("pd-backtrace-run4");
scm_permanent_object(pd_backtrace_run4);
}
/*****************************************************************************************************
*****************************************************************************************************
* Starting and stopping new guile script
*****************************************************************************************************
*****************************************************************************************************/
static bool k_guile_load(t_k_guile *x,char *filename){
bool ret=true;
FILE *file=fopen(filename,"r");
if(file==NULL){
post("file \"%s\" not found.\n",filename);
return false;
}
// Let the file live in its own name-space, or something like that.
eval2("(define (pd-instance-func pd-instance)");
eval2(
#include "local_scm.txt"
);
eval_file(file);
eval2(" (pd-set-inlet-func)(pd-set-cleanup-func))");
eval2("1");
if(
1!=GET_INTEGER(eval_do())
|| 1!=GET_INTEGER(scm_call_2(pd_backtrace_run1,EVAL("pd-instance-func"),MAKE_POINTER(x)))
)
{
post("Failed.");
ret=false;
}
fclose(file);
return ret;
}
static void *k_guile_new(t_symbol *s){
int lokke;
t_k_guile *x = (t_k_guile *)pd_new(k_guile_class);
x->filename=s->s_name;
x->isinited=false;
if(k_guile_load(x,x->filename)==true){
x->isinited=true;
return x;
}
return NULL;
}
static void k_guile_free(t_k_guile *x){
int lokke;
scm_call_1(pd_backtrace_run,x->cleanup_func);
for(lokke=1;lokke<x->num_ins;lokke++){
inlet_free(x->inlets[lokke]->inlet);
pd_free((t_pd*)x->inlets[lokke]);
}
for(lokke=0;lokke<x->num_outs;lokke++){
outlet_free(x->outlets[lokke]);
}
scm_gc_unprotect_object(x->inlet_func);
scm_gc_unprotect_object(x->cleanup_func);
free(x->inlets);
free(x->outlets);
}
static void k_guile_reload(t_k_guile *x){
scm_call_1(pd_backtrace_run,x->cleanup_func);
scm_gc_unprotect_object(x->inlet_func);
scm_gc_unprotect_object(x->cleanup_func);
k_guile_load(x,x->filename);
}
/*****************************************************************************************************
*****************************************************************************************************
* Das setup
*****************************************************************************************************
*****************************************************************************************************/
void k_guile_setup(void){
k_guile_init();
k_guile_class = class_new(gensym("k_guile"), (t_newmethod)k_guile_new,
(t_method)k_guile_free, sizeof(t_k_guile), 0, A_DEFSYM, 0);
class_addanything(k_guile_class, (t_method)k_guile_anything_first);
class_addmethod(k_guile_class, (t_method)k_guile_reload, gensym("reload"), 0);
class_sethelpsymbol(k_guile_class, gensym("help-k_guile.pd"));
/* This trick(?) is taken from the flext source. (I don't understand what happens...) */
k_guile_workaroundclass=class_new(gensym("indexworkaround"),NULL,NULL,sizeof(t_k_guile_workaround),CLASS_PD|CLASS_NOINLET, A_NULL);
class_addanything(k_guile_workaroundclass,k_guile_anything);
post(version);
}
--- NEW FILE: local.scm ---
;; This file is evaluated (not (load)-ed) right before the file defined in the k_guile object in pd is evaluated or the
;; reload message has been sent. (see k_guile.c/k_guile_new)
;; Kjetil S. Matheussen, 2004.
;;
;;/* 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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
;;/* */
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Instance data
;;
;;
(define pd-num-inlets 1)
(define pd-num-outlets 0)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Argument checking
;;
;;
(define (pd-legaloutlet outlet-num)
(if (and (< outlet-num pd-num-outlets) (>= outlet-num 0))
#t
(begin
(pd-display "outlet-num out of range")
#f)))
(define (pd-legalinlet inlet-num)
(if (and (< inlet-num pd-num-inlets) (>= inlet-num 0))
#t
(begin
(pd-display "inlet-num out of range")
#f)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Inlets
;;
;;
(define pd-inlet-vector (make-vector 1 '()))
(define (pd-set-inlet-func)
(pd-c-set-inlet-func pd-instance
;; This function is called from the C side when the object receives something on an inlet.
(lambda (inlet-num symbol args)
(let ((inlet-func (assq symbol
(vector-ref pd-inlet-vector
inlet-num))))
(if inlet-func
(apply (cadr inlet-func) args)
(pd-display "No function defined for handling \'" symbol " to inlet " inlet-num))))))
(define (pd-inlet inlet-num symbol func)
(if (not (procedure? func))
(pd-display "Wrong argument to pd-inlet: " func " is not a procedure")
(if (and (pd-check-number inlet-num "pd-inlet")
(pd-legalinlet inlet-num))
(let ((inlet-funcs (vector-ref pd-inlet-vector inlet-num)))
(vector-set! pd-inlet-vector
inlet-num
(cons (list symbol func)
inlet-funcs))))))
(define (pd-inlets new-num-inlets)
(let ((num-inlets (if (pd-c-inited? pd-instance)
(pd-c-get-num-inlets pd-instance)
new-num-inlets)))
(if (pd-check-number num-inlets "pd-inlets")
(if (<= num-inlets 0)
(pd-display "num-inlets must be greater than 0, not " num-inlets)
(begin
(set! pd-num-inlets num-inlets)
(set! pd-inlet-vector (make-vector num-inlets '()))
(pd-c-inlets pd-instance num-inlets))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Outlets
;;
;;
(define (pd-outlets new-num-outlets)
(let ((num-outlets (if (pd-c-inited? pd-instance)
(pd-c-get-num-outlets pd-instance)
new-num-outlets)))
(if (pd-check-number num-outlets "pd-outlets")
(if (<= num-outlets 0)
(pd-display "num-outlets must be greater than 0, not " num-outlets)
(begin
(set! pd-num-outlets num-outlets)
(pd-c-outlets pd-instance num-outlets))))))
(define (pd-outlet outlet-num firstarg . args)
(if (pd-legaloutlet outlet-num)
(cond ((> (length args) 0) (pd-c-outlet-list pd-instance outlet-num issymbol (cons firstarg args)))
((list? firstarg) (pd-c-outlet-list pd-instance outlet-num firstarg))
((number? firstarg) (pd-c-outlet-number pd-instance outlet-num firstarg))
((string? firstarg) (pd-c-outlet-string pd-instance outlet-num firstarg))
((eq? 'bang firstarg) (pd-c-outlet-bang pd-instance outlet-num))
((symbol? firstarg) (pd-c-outlet-symbol pd-instance outlet-num firstarg))
(else
(pd-display "Unknown argument to pd-outlet-or-send:" firstarg)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Bindings
;;
;;
;; We must have our own local bind/unbind functions to be able to clean up automaticly.
(define pd-local-bindings '())
(define (pd-bind symbol func)
(set! pd-local-bindings (pd-bind-do symbol func pd-local-bindings)))
(define (pd-unbind symbol)
(set! pd-local-bindings (pd-unbind-do symbol pd-local-bindings)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Cleanup
;;
;;
(define pd-destroy-func #f)
(define (pd-set-destroy-func thunk)
(if (not (procedure? thunk))
(pd-display "Wrong argument to pd-set-destroy-func: " thunk " is not a procedure.")
(set! pd-destroy-func thunk)))
(define (pd-cleanup)
(if pd-destroy-func
(begin
(pd-destroy-func)
(set! pd-destroy-func #f)))
(if (not (null? pd-local-bindings))
(begin
(pd-unbind (car (car pd-local-bindings)))
(pd-cleanup))))
;; This one also returns the return-value for the pd-instance-func function, which is 1 for success.
(define (pd-set-cleanup-func)
(pd-c-set-cleanup-func pd-instance
pd-cleanup)
1)
--- NEW FILE: mozilla.scm ---
(pd-inlet 0 'start
(lambda x
(system "mozilla&")))
--- NEW FILE: send_receive.scm ---
;; Send out what comes in.
(pd-bind 'in
(lambda (arg)
(pd-send 'out arg)))
#!
;; This one does the same and is faster, but requires some more typing:
(let ((s-out (pd-get-symbol 'out)))
(pd-bind 'in
(lambda (arg)
(pd-send s-out arg))))
!#
#!
;; And the following example will (most probably) lead to a segmentation fault:
;; This is also the only way I can think of right now that will make pd segfault using the pd- interface.
(pd-send 5 arg)
!#
- Previous message: [PD-cvs] externals/k_cext Makefile,NONE,1.1 README,NONE,1.1 help-do.pd,NONE,1.1 help-fibonacci.pd,NONE,1.1 help-gcd.pd,NONE,1.1 help-k_cext.pd,NONE,1.1 help-k_cext2.pd,NONE,1.1 help-k_cfunc.pd,NONE,1.1 help-markov.pd,NONE,1.1 help-rangeifelifelse.pd,NONE,1.1 help-send.pd,NONE,1.1 help-sort.pd,NONE,1.1 k_cext.c,NONE,1.1 k_cext.h,NONE,1.1 k_cext_funchandler.c,NONE,1.1 k_cext_generatecode.c,NONE,1.1 k_cext_macosx.c,NONE,1.1 k_cext_unix.c,NONE,1.1 k_cext_win.c,NONE,1.1 test.pd,NONE,1.1
- Next message: [PD-cvs] externals/k_vst~ Makefile,NONE,1.1 README,NONE,1.1 abyss.pd,NONE,1.1 config.h,NONE,1.1 help-k_vst~.pd,NONE,1.1 help2-k_vst~.pd,NONE,1.1 k_vst~.c,NONE,1.1 plugin~.h,NONE,1.1 plugin~_ladspa.h,NONE,1.1 plugin~_vst.c,NONE,1.1 plugin~_vst.h,NONE,1.1 version.h,NONE,1.1 vstutils.h,NONE,1.1
- Messages sorted by:
[ date ]
[ thread ]
[ subject ]
[ author ]
More information about the Pd-cvs
mailing list