mirror of
https://github.com/cookiengineer/audacity
synced 2025-04-30 07:39:42 +02:00
arbitrary length computed sound. (So as before, sound after the selection is shifted in time if the replacement sound is shorter or longer than the original selection.) If stereo is computed and one channel is shorter than the other, the shorter channel is extended with zeros to match the length of the longer one.
1655 lines
39 KiB
C
1655 lines
39 KiB
C
/**********************************************************************
|
|
|
|
nyx.c
|
|
|
|
Nyx: A very simple external interface to Nyquist
|
|
|
|
Dominic Mazzoni
|
|
|
|
**********************************************************************/
|
|
|
|
/* system includes */
|
|
#include <stdint.h>
|
|
#include <stdio.h>
|
|
#include <stdlib.h>
|
|
#include <string.h>
|
|
#include <errno.h>
|
|
#include <math.h>
|
|
#include <stdbool.h>
|
|
|
|
#ifndef WIN32
|
|
#include <unistd.h>
|
|
#else
|
|
#include <windows.h>
|
|
#include <direct.h>
|
|
#endif
|
|
|
|
/* nyx includes */
|
|
#include "nyx.h"
|
|
|
|
/* xlisp includes */
|
|
#include "switches.h"
|
|
#include "xlisp.h"
|
|
#include "cext.h"
|
|
|
|
/* nyquist includes */
|
|
#include "sound.h"
|
|
#include "samples.h"
|
|
#include "falloc.h"
|
|
|
|
/* use full copy */
|
|
#define NYX_FULL_COPY 1
|
|
|
|
/* show memory stats */
|
|
// #define NYX_MEMORY_STATS 1
|
|
|
|
/* show details of obarray copy */
|
|
// #define NYX_DEBUG_COPY 1
|
|
|
|
/* macro to compute the size of a segment (taken from xldmem.h) */
|
|
#define segsize(n) (sizeof(SEGMENT)+((n)-1)*sizeof(struct node))
|
|
|
|
/* xldmem external variables */
|
|
extern long nnodes;
|
|
extern long nfree;
|
|
extern long total;
|
|
extern int nsegs;
|
|
extern SEGMENT *segs;
|
|
extern SEGMENT *lastseg;
|
|
extern LVAL fnodes;
|
|
|
|
/* nyquist externs */
|
|
extern LVAL a_sound;
|
|
extern snd_list_type zero_snd_list;
|
|
extern FILE *tfp; /* transcript file pointer */
|
|
|
|
/* globals */
|
|
LOCAL nyx_os_callback nyx_os_cb = NULL;
|
|
LOCAL void *nyx_os_ud;
|
|
LOCAL nyx_output_callback nyx_output_cb;
|
|
LOCAL void *nyx_output_ud;
|
|
LOCAL int nyx_expr_pos;
|
|
LOCAL int nyx_expr_len;
|
|
LOCAL const char *nyx_expr_string;
|
|
LOCAL LVAL nyx_result;
|
|
LOCAL nyx_rval nyx_result_type = nyx_error;
|
|
LOCAL XLCONTEXT nyx_cntxt;
|
|
LOCAL int nyx_first_time = 1;
|
|
LOCAL LVAL nyx_obarray;
|
|
LOCAL FLOTYPE nyx_warp_stretch;
|
|
LOCAL int64_t nyx_input_length = 0;
|
|
LOCAL char *nyx_audio_name = NULL;
|
|
|
|
/* Suspension node */
|
|
typedef struct nyx_susp_struct {
|
|
snd_susp_node susp; // Must be first
|
|
nyx_audio_callback callback;
|
|
void *userdata;
|
|
int64_t len;
|
|
int channel;
|
|
} nyx_susp_node, *nyx_susp_type;
|
|
|
|
#if defined(NYX_DEBUG_COPY) && NYX_DEBUG_COPY
|
|
static const char *_types_[] =
|
|
{
|
|
"FREE_NODE",
|
|
"SUBR",
|
|
"FSUBR",
|
|
"CONS",
|
|
"SYMBOL",
|
|
"FIXNUM",
|
|
"FLONUM",
|
|
"STRING",
|
|
"OBJECT",
|
|
"STREAM",
|
|
"VECTOR",
|
|
"CLOSURE",
|
|
"CHAR",
|
|
"USTREAM",
|
|
"EXTERN"
|
|
};
|
|
|
|
// Dump the contents of the obarray
|
|
LOCAL void nyx_show_obarray()
|
|
{
|
|
LVAL array = getvalue(obarray);
|
|
LVAL sym;
|
|
int i;
|
|
|
|
for (i = 0; i < HSIZE; i++) {
|
|
for (sym = getelement(array, i); sym; sym = cdr(sym)) {
|
|
LVAL syma = car(sym);
|
|
|
|
printf("_sym_ = ");
|
|
xlprint(getvalue(s_stdout), syma, TRUE);
|
|
|
|
if (getvalue(syma)) {
|
|
printf(" _type_ = %s _val_ = ", _types_[ntype(getvalue(syma))]);
|
|
xlprint(getvalue(s_stdout), getvalue(syma), TRUE);
|
|
}
|
|
|
|
if (getfunction(syma)) {
|
|
printf(" _type_ = %s _fun_ = ", _types_[ntype(getfunction(syma))]);
|
|
xlprint(getvalue(s_stdout), getfunction(syma), TRUE);
|
|
}
|
|
|
|
printf("\n");
|
|
}
|
|
}
|
|
}
|
|
#endif
|
|
|
|
//
|
|
// Free empty segments
|
|
//
|
|
LOCAL void freesegs()
|
|
{
|
|
SEGMENT *seg;
|
|
SEGMENT *next;
|
|
|
|
// Free up as many nodes as possible
|
|
gc();
|
|
|
|
// Reset free node tracking
|
|
fnodes = NIL;
|
|
nfree = 0L;
|
|
|
|
// Reset the last segment pointer
|
|
lastseg = NULL;
|
|
|
|
// Scan all segments
|
|
for (seg = segs; seg != NULL; seg = next) {
|
|
int n = seg->sg_size;
|
|
int empty = TRUE;
|
|
int i;
|
|
LVAL p;
|
|
|
|
// Check this segment for in-use nodes
|
|
p = &seg->sg_nodes[0];
|
|
for (i = n; --i >= 0; ++p) {
|
|
if (ntype(p) != FREE_NODE) {
|
|
empty = FALSE;
|
|
break;
|
|
}
|
|
}
|
|
|
|
// Retain pointer to next segment
|
|
next = seg->sg_next;
|
|
|
|
// Was the current segment empty?
|
|
if (empty) {
|
|
// Free the segment;
|
|
free((void *) seg);
|
|
|
|
// Unlink it from the list. No need to worry about a NULL lastseg
|
|
// pointer here since the fixnum and char segments will always exist
|
|
// at the head of the list and they will always have nodes. So, lastseg
|
|
// will have been set before we find any empty nodes.
|
|
lastseg->sg_next = next;
|
|
|
|
// Reduce the stats
|
|
total -= (long) segsize(n);
|
|
nsegs--;
|
|
nnodes -= n;
|
|
}
|
|
else {
|
|
// Not empty, so remember this node as the last segment
|
|
lastseg = seg;
|
|
|
|
// Add all of the free nodes in this segment to the free list
|
|
p = &seg->sg_nodes[0];
|
|
for (i = n; --i >= 0; ++p) {
|
|
if (ntype(p) == FREE_NODE) {
|
|
rplaca(p, NIL);
|
|
rplacd(p, fnodes);
|
|
fnodes = p;
|
|
nfree++;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
#if defined(NYX_FULL_COPY) && NYX_FULL_COPY
|
|
|
|
// Copy a node (recursively if appropriate)
|
|
LOCAL LVAL nyx_dup_value(LVAL val)
|
|
{
|
|
LVAL nval = val;
|
|
|
|
// Protect old and new values
|
|
xlprot1(val);
|
|
xlprot1(nval);
|
|
|
|
// Copy the node
|
|
if (val != NIL) {
|
|
switch (ntype(val))
|
|
{
|
|
case FIXNUM:
|
|
nval = cvfixnum(getfixnum(val));
|
|
break;
|
|
|
|
case FLONUM:
|
|
nval = cvflonum(getflonum(val));
|
|
break;
|
|
|
|
case CHAR:
|
|
nval = cvchar(getchcode(val));
|
|
break;
|
|
|
|
case STRING:
|
|
nval = cvstring((char *) getstring(val));
|
|
break;
|
|
|
|
case VECTOR:
|
|
{
|
|
int len = getsize(val);
|
|
int i;
|
|
|
|
nval = newvector(len);
|
|
nval->n_type = ntype(val);
|
|
|
|
for (i = 0; i < len; i++) {
|
|
if (getelement(val, i) == val) {
|
|
setelement(nval, i, val);
|
|
}
|
|
else {
|
|
setelement(nval, i, nyx_dup_value(getelement(val, i)));
|
|
}
|
|
}
|
|
}
|
|
break;
|
|
|
|
case CONS:
|
|
nval = nyx_dup_value(cdr(val));
|
|
nval = cons(nyx_dup_value(car(val)), nval);
|
|
break;
|
|
|
|
case SUBR:
|
|
case FSUBR:
|
|
nval = cvsubr(getsubr(val), ntype(val), getoffset(val));
|
|
break;
|
|
|
|
// Symbols should never be copied since their addresses are cached
|
|
// all over the place.
|
|
case SYMBOL:
|
|
nval = val;
|
|
break;
|
|
|
|
// Streams are not copied (although USTREAM could be) and reference
|
|
// the original value.
|
|
case USTREAM:
|
|
case STREAM:
|
|
nval = val;
|
|
break;
|
|
|
|
// Externals aren't copied because I'm not entirely certain they can be.
|
|
case EXTERN:
|
|
nval = val;
|
|
break;
|
|
|
|
// For all other types, just allow them to reference the original
|
|
// value. Probably not the right thing to do, but easier.
|
|
case OBJECT:
|
|
case CLOSURE:
|
|
default:
|
|
nval = val;
|
|
break;
|
|
}
|
|
}
|
|
|
|
xlpop();
|
|
xlpop();
|
|
|
|
return nval;
|
|
}
|
|
|
|
// Make a copy of the original obarray, leaving the original in place
|
|
LOCAL void nyx_save_obarray()
|
|
{
|
|
LVAL newarray;
|
|
int i;
|
|
|
|
// This provide permanent protection for nyx_obarray as we do not want it
|
|
// to be garbage-collected.
|
|
xlprot1(nyx_obarray);
|
|
nyx_obarray = getvalue(obarray);
|
|
|
|
// Create and set the new vector. This allows us to use xlenter() to
|
|
// properly add the new symbol. Probably slower than adding directly,
|
|
// but guarantees proper hashing.
|
|
newarray = newvector(HSIZE);
|
|
setvalue(obarray, newarray);
|
|
|
|
// Scan all obarray vectors
|
|
for (i = 0; i < HSIZE; i++) {
|
|
LVAL sym;
|
|
|
|
// Scan all elements
|
|
for (sym = getelement(nyx_obarray, i); sym; sym = cdr(sym)) {
|
|
LVAL syma = car(sym);
|
|
char *name = (char *) getstring(getpname(syma));
|
|
LVAL nsym = xlenter(name);
|
|
|
|
// Ignore *OBARRAY* since there's no need to copy it
|
|
if (strcmp(name, "*OBARRAY*") == 0) {
|
|
continue;
|
|
}
|
|
|
|
// Ignore *SCRATCH* since it's allowed to be updated
|
|
if (strcmp(name, "*SCRATCH*") == 0) {
|
|
continue;
|
|
}
|
|
|
|
// Duplicate the symbol's values
|
|
setvalue(nsym, nyx_dup_value(getvalue(syma)));
|
|
setplist(nsym, nyx_dup_value(getplist(syma)));
|
|
setfunction(nsym, nyx_dup_value(getfunction(syma)));
|
|
}
|
|
}
|
|
|
|
// Swap the obarrays, so that the original is put back into service
|
|
setvalue(obarray, nyx_obarray);
|
|
nyx_obarray = newarray;
|
|
}
|
|
|
|
// Restore the symbol values to their original value and remove any added
|
|
// symbols.
|
|
LOCAL void nyx_restore_obarray()
|
|
{
|
|
LVAL obvec = getvalue(obarray);
|
|
LVAL sscratch = xlenter("*SCRATCH*"); // one-time lookup
|
|
int i;
|
|
|
|
// Scan all obarray vectors
|
|
for (i = 0; i < HSIZE; i++) {
|
|
LVAL last = NULL;
|
|
LVAL dcon;
|
|
|
|
// Scan all elements
|
|
for (dcon = getelement(obvec, i); dcon; dcon = cdr(dcon)) {
|
|
LVAL dsym = car(dcon);
|
|
char *name = (char *)getstring(getpname(dsym));
|
|
LVAL scon;
|
|
|
|
// Ignore *OBARRAY* since setting it causes the input array to be
|
|
// truncated.
|
|
if (strcmp(name, "*OBARRAY*") == 0) {
|
|
continue;
|
|
}
|
|
|
|
// Ignore *SCRATCH* since it's allowed to be updated
|
|
if (strcmp(name, "*SCRATCH*") == 0) {
|
|
continue;
|
|
}
|
|
|
|
// Find the symbol in the original obarray.
|
|
for (scon = getelement(nyx_obarray, hash(name, HSIZE)); scon; scon = cdr(scon)) {
|
|
LVAL ssym = car(scon);
|
|
|
|
// If found, then set the current symbols value to the original.
|
|
if (strcmp(name, (char *)getstring(getpname(ssym))) == 0) {
|
|
setvalue(dsym, nyx_dup_value(getvalue(ssym)));
|
|
setplist(dsym, nyx_dup_value(getplist(ssym)));
|
|
setfunction(dsym, nyx_dup_value(getfunction(ssym)));
|
|
break;
|
|
}
|
|
}
|
|
|
|
// If we didn't find the symbol in the original obarray, then it
|
|
// must've been added and must be removed from the current obarray.
|
|
// Exception: if the new symbol is a property symbol of *scratch*,
|
|
// then allow the symbol to stay; otherwise, property lookups will
|
|
// fail.
|
|
if (scon == NULL) {
|
|
// check property list of scratch
|
|
if (findprop(sscratch, dsym) == NIL) {
|
|
if (last) {
|
|
rplacd(last, cdr(dcon));
|
|
}
|
|
else {
|
|
setelement(obvec, i, cdr(dcon));
|
|
}
|
|
} // otherwise, keep new property symbol
|
|
}
|
|
|
|
// Must track the last dcon for symbol removal
|
|
last = dcon;
|
|
}
|
|
}
|
|
}
|
|
|
|
#else
|
|
|
|
LOCAL LVAL copylist(LVAL from)
|
|
{
|
|
if (from == NULL) {
|
|
return NULL;
|
|
}
|
|
|
|
return cons(car(from), copylist(cdr(from)));
|
|
}
|
|
|
|
/* Make a copy of the obarray so that we can erase any
|
|
changes the user makes to global variables */
|
|
LOCAL void nyx_copy_obarray()
|
|
{
|
|
LVAL newarray;
|
|
int i;
|
|
|
|
// Create and set the new vector.
|
|
newarray = newvector(HSIZE);
|
|
setvalue(obarray, newarray);
|
|
|
|
for (i = 0; i < HSIZE; i++) {
|
|
LVAL from = getelement(nyx_obarray, i);
|
|
if (from) {
|
|
setelement(newarray, i, copylist(from));
|
|
}
|
|
}
|
|
}
|
|
|
|
#endif
|
|
|
|
void nyx_init()
|
|
{
|
|
if (nyx_first_time) {
|
|
char *argv[1];
|
|
argv[0] = "nyquist";
|
|
xlisp_main_init(1, argv);
|
|
|
|
nyx_audio_name = NULL;
|
|
nyx_os_cb = NULL;
|
|
nyx_output_cb = NULL;
|
|
|
|
nyx_first_time = 0;
|
|
|
|
#if defined(NYX_FULL_COPY) && NYX_FULL_COPY
|
|
// Save a copy of the original obarray's contents.
|
|
nyx_save_obarray();
|
|
#else
|
|
// Permanently protect the original obarray value. This is needed since
|
|
// it would be unreferenced in the new obarray and would be garbage
|
|
// collected. We want to keep it around so we can make copies of it to
|
|
// refresh the execution state.
|
|
xlprot1(nyx_obarray);
|
|
nyx_obarray = getvalue(obarray);
|
|
#endif
|
|
}
|
|
|
|
#if !defined(NYX_FULL_COPY) || !NYX_FULL_COPY
|
|
// Create a copy of the original obarray
|
|
nyx_copy_obarray();
|
|
#endif
|
|
|
|
// Keep nyx_result from being garbage-collected
|
|
xlprot1(nyx_result);
|
|
|
|
#if defined(NYX_MEMORY_STATS) && NYX_MEMORY_STATS
|
|
printf("\nnyx_init\n");
|
|
xmem();
|
|
#endif
|
|
}
|
|
|
|
void nyx_cleanup()
|
|
{
|
|
// Garbage-collect nyx_result
|
|
xlpop();
|
|
|
|
#if defined(NYX_FULL_COPY) && NYX_FULL_COPY
|
|
|
|
// Restore the original symbol values
|
|
nyx_restore_obarray();
|
|
|
|
#else
|
|
|
|
// Restore obarray to original state...but not the values
|
|
setvalue(obarray, nyx_obarray);
|
|
|
|
#endif
|
|
|
|
// Make sure the sound nodes can be garbage-collected. Sounds are EXTERN
|
|
// nodes whose value does not get copied during a full copy of the obarray.
|
|
setvalue(xlenter(nyx_get_audio_name()), NIL);
|
|
|
|
// Free excess memory segments - does a gc()
|
|
freesegs();
|
|
|
|
// Free unused memory pools
|
|
falloc_gc();
|
|
|
|
// No longer need the callbacks
|
|
nyx_output_cb = NULL;
|
|
nyx_os_cb = NULL;
|
|
|
|
// Reset vars
|
|
nyx_input_length = 0;
|
|
|
|
if (nyx_audio_name) {
|
|
free(nyx_audio_name);
|
|
nyx_audio_name = NULL;
|
|
}
|
|
|
|
#if defined(NYX_MEMORY_STATS) && NYX_MEMORY_STATS
|
|
printf("\nnyx_cleanup\n");
|
|
xmem();
|
|
#endif
|
|
}
|
|
|
|
void nyx_set_xlisp_path(const char *path)
|
|
{
|
|
set_xlisp_path(path);
|
|
}
|
|
|
|
LOCAL void nyx_susp_fetch(nyx_susp_type susp, snd_list_type snd_list)
|
|
{
|
|
sample_block_type out;
|
|
sample_block_values_type out_ptr;
|
|
int64_t n;
|
|
int err;
|
|
|
|
falloc_sample_block(out, "nyx_susp_fetch");
|
|
out_ptr = out->samples;
|
|
snd_list->block = out;
|
|
|
|
n = max_sample_block_len;
|
|
if (susp->susp.current + n > susp->len) {
|
|
n = susp->len - susp->susp.current;
|
|
}
|
|
|
|
err = susp->callback(out_ptr, susp->channel,
|
|
susp->susp.current, n, 0, susp->userdata);
|
|
if (err) {
|
|
// The user canceled or some other error occurred, so we use
|
|
// xlsignal() to jump back to our error handler.
|
|
xlsignal(NULL, NULL);
|
|
// never get here.
|
|
}
|
|
|
|
snd_list->block_len = (short)n;
|
|
susp->susp.current += n;
|
|
|
|
if (n == 0) {
|
|
/* we didn't read anything, but can't return length zero, so
|
|
convert snd_list to pointer to zero block */
|
|
snd_list_terminate(snd_list);
|
|
}
|
|
else if (n < max_sample_block_len) {
|
|
/* should free susp */
|
|
snd_list_unref(snd_list->u.next);
|
|
/* if something is in buffer, terminate by pointing to zero block */
|
|
snd_list->u.next = zero_snd_list;
|
|
}
|
|
}
|
|
|
|
LOCAL void nyx_susp_free(nyx_susp_type susp)
|
|
{
|
|
ffree_generic(susp, sizeof(nyx_susp_node), "nyx_susp_free");
|
|
}
|
|
|
|
LOCAL void nyx_susp_print_tree(nyx_susp_type susp, int n)
|
|
{
|
|
}
|
|
|
|
void nyx_capture_output(nyx_output_callback callback, void *userdata)
|
|
{
|
|
nyx_output_cb = callback;
|
|
nyx_output_ud = userdata;
|
|
}
|
|
|
|
char *nyx_get_audio_name()
|
|
{
|
|
if (!nyx_audio_name) {
|
|
nyx_audio_name = strdup("S");
|
|
}
|
|
|
|
return nyx_audio_name;
|
|
}
|
|
|
|
void nyx_set_audio_name(const char *name)
|
|
{
|
|
if (nyx_audio_name) {
|
|
free(nyx_audio_name);
|
|
nyx_audio_name = NULL;
|
|
}
|
|
|
|
nyx_audio_name = strdup(name);
|
|
}
|
|
|
|
void nyx_set_audio_params(double rate, int64_t len)
|
|
{
|
|
LVAL flo;
|
|
LVAL con;
|
|
|
|
xlstkcheck(2);
|
|
xlsave(flo);
|
|
xlsave(con);
|
|
|
|
/* Bind the sample rate to the "*sound-srate*" global */
|
|
flo = cvflonum(rate);
|
|
setvalue(xlenter("*DEFAULT-SOUND-SRATE*"), flo);
|
|
setvalue(xlenter("*SOUND-SRATE*"), flo);
|
|
|
|
/* Bind the control sample rate to "*control-srate*" globals */
|
|
flo = cvflonum((double) rate / 20.0);
|
|
setvalue(xlenter("*DEFAULT-CONTROL-SRATE*"), flo);
|
|
setvalue(xlenter("*CONTROL-SRATE*"), flo);
|
|
|
|
/* Bind selection len to "len" global */
|
|
nyx_input_length = len;
|
|
flo = cvflonum(len);
|
|
setvalue(xlenter("LEN"), flo);
|
|
|
|
/* Set the "*warp*" global based on the length of the audio */
|
|
con = cons(NULL, NULL);
|
|
flo = cvflonum(len > 0 ? (double) len / rate : 1.0);
|
|
con = cons(flo, con);
|
|
flo = cvflonum(0);
|
|
con = cons(flo, con);
|
|
setvalue(xlenter("*WARP*"), con);
|
|
|
|
xlpopn(2);
|
|
}
|
|
|
|
void nyx_set_input_audio(nyx_audio_callback callback,
|
|
void *userdata,
|
|
int num_channels,
|
|
int64_t len, double rate)
|
|
{
|
|
LVAL val;
|
|
int ch;
|
|
|
|
nyx_set_audio_params(rate, len);
|
|
|
|
if (num_channels > 1) {
|
|
val = newvector(num_channels);
|
|
}
|
|
|
|
xlprot1(val);
|
|
|
|
for (ch = 0; ch < num_channels; ch++) {
|
|
nyx_susp_type susp;
|
|
sound_type snd;
|
|
|
|
falloc_generic(susp, nyx_susp_node, "nyx_set_input_audio");
|
|
|
|
susp->callback = callback;
|
|
susp->userdata = userdata;
|
|
susp->len = len;
|
|
susp->channel = ch;
|
|
|
|
susp->susp.fetch = (snd_fetch_fn)nyx_susp_fetch;
|
|
susp->susp.keep_fetch = NULL;
|
|
susp->susp.free = (snd_free_fn)nyx_susp_free;
|
|
susp->susp.mark = NULL;
|
|
susp->susp.print_tree = (snd_print_tree_fn)nyx_susp_print_tree;
|
|
susp->susp.name = "nyx";
|
|
susp->susp.toss_cnt = 0;
|
|
susp->susp.current = 0;
|
|
susp->susp.sr = rate;
|
|
susp->susp.t0 = 0.0;
|
|
susp->susp.log_stop_cnt = 0;
|
|
|
|
snd = sound_create((snd_susp_type) susp, 0.0, rate, 1.0);
|
|
if (num_channels > 1) {
|
|
setelement(val, ch, cvsound(snd));
|
|
}
|
|
else {
|
|
val = cvsound(snd);
|
|
}
|
|
}
|
|
|
|
setvalue(xlenter(nyx_get_audio_name()), val);
|
|
|
|
xlpop();
|
|
}
|
|
|
|
LOCAL int nyx_is_labels(LVAL expr)
|
|
{
|
|
/* make sure that we have a list whose first element is a
|
|
list of the form (time "label") */
|
|
|
|
LVAL label;
|
|
LVAL first;
|
|
LVAL second;
|
|
LVAL third;
|
|
|
|
if (expr == NULL) {
|
|
return 0;
|
|
}
|
|
|
|
while (expr != NULL) {
|
|
if (!consp(expr)) {
|
|
return 0;
|
|
}
|
|
|
|
label = car(expr);
|
|
|
|
if (!consp(label)) {
|
|
return 0;
|
|
}
|
|
|
|
first = car(label);
|
|
if (!(floatp(first) || fixp(first))) {
|
|
return 0;
|
|
}
|
|
|
|
if (!consp(cdr(label))) {
|
|
return 0;
|
|
}
|
|
|
|
second = car(cdr(label));
|
|
|
|
if (floatp(second) || fixp(second)) {
|
|
if (!consp(cdr(cdr(label)))) {
|
|
return 0;
|
|
}
|
|
third = car(cdr(cdr(label)));
|
|
if (!(stringp(third))) {
|
|
return 0;
|
|
}
|
|
}
|
|
else {
|
|
if (!(stringp(second))) {
|
|
return 0;
|
|
}
|
|
}
|
|
|
|
expr = cdr(expr);
|
|
}
|
|
|
|
return 1;
|
|
}
|
|
|
|
nyx_rval nyx_get_type(LVAL expr)
|
|
{
|
|
if (nyx_result_type != nyx_error) {
|
|
return nyx_result_type;
|
|
}
|
|
|
|
nyx_result_type = nyx_error;
|
|
|
|
if (expr == NULL) {
|
|
return nyx_result_type;
|
|
}
|
|
|
|
switch (ntype(expr))
|
|
{
|
|
case FIXNUM:
|
|
nyx_result_type = nyx_int;
|
|
break;
|
|
|
|
case FLONUM:
|
|
nyx_result_type = nyx_double;
|
|
break;
|
|
|
|
case STRING:
|
|
nyx_result_type = nyx_string;
|
|
break;
|
|
|
|
case VECTOR:
|
|
{
|
|
/* make sure it's a vector of sounds */
|
|
int i;
|
|
nyx_result_type = nyx_audio;
|
|
for (i = 0; i < getsize(expr); i++) {
|
|
if (!soundp(getelement(expr, i))) {
|
|
nyx_result_type = nyx_error;
|
|
break;
|
|
}
|
|
}
|
|
}
|
|
break;
|
|
|
|
case CONS:
|
|
{
|
|
/* see if it's a list of time/string pairs representing a
|
|
label track */
|
|
if (nyx_is_labels(expr)) {
|
|
nyx_result_type = nyx_labels;
|
|
} else {
|
|
nyx_result_type = nyx_list;
|
|
}
|
|
}
|
|
break;
|
|
|
|
case EXTERN:
|
|
{
|
|
if (soundp(expr)) {
|
|
nyx_result_type = nyx_audio;
|
|
}
|
|
}
|
|
break;
|
|
} /* switch */
|
|
|
|
return nyx_result_type;
|
|
}
|
|
|
|
nyx_rval nyx_eval_expression(const char *expr_string)
|
|
{
|
|
LVAL expr = NULL;
|
|
|
|
#if defined(NYX_MEMORY_STATS) && NYX_MEMORY_STATS
|
|
printf("\nnyx_eval_expression before\n");
|
|
xmem();
|
|
#endif
|
|
|
|
nyx_result = NULL;
|
|
nyx_result_type = nyx_error;
|
|
|
|
// Check argument
|
|
if (!expr_string || !strlen(expr_string)) {
|
|
return nyx_get_type(nyx_result);
|
|
}
|
|
|
|
nyx_expr_string = expr_string;
|
|
nyx_expr_len = strlen(nyx_expr_string);
|
|
nyx_expr_pos = 0;
|
|
|
|
// Protect the expression from being garbage collected
|
|
xlprot1(expr);
|
|
|
|
// Setup a new context
|
|
xlbegin(&nyx_cntxt, CF_TOPLEVEL|CF_CLEANUP|CF_BRKLEVEL|CF_ERROR, s_true);
|
|
|
|
// Set the context jump destination
|
|
if (_setjmp(nyx_cntxt.c_jmpbuf)) {
|
|
// If the script is cancelled or some other condition occurs that causes
|
|
// the script to exit and return to this level, then we don't need to
|
|
// restore the previous context.
|
|
goto finish;
|
|
}
|
|
|
|
while (nyx_expr_pos < nyx_expr_len) {
|
|
expr = NULL;
|
|
|
|
// Simulate the prompt
|
|
if (tfp) {
|
|
ostputc('>');
|
|
ostputc(' ');
|
|
}
|
|
|
|
// Read an expression
|
|
if (!xlread(getvalue(s_stdin), &expr, FALSE)) {
|
|
break;
|
|
}
|
|
|
|
// Simulate the prompt
|
|
if (tfp) {
|
|
ostputc('\n');
|
|
}
|
|
|
|
#if 0
|
|
/* save the input expression (so the user can refer to it
|
|
as +, ++, or +++) */
|
|
xlrdsave(expr);
|
|
#endif
|
|
|
|
// Evaluate the expression
|
|
nyx_result = xleval(expr);
|
|
|
|
// Print it
|
|
if (tfp) {
|
|
stdprint(nyx_result);
|
|
}
|
|
}
|
|
|
|
// This will unwind the xlisp context and restore internals to a point just
|
|
// before we issued our xlbegin() above. This is important since the internal
|
|
// xlisp stacks will contain pointers to invalid objects otherwise.
|
|
//
|
|
// Also note that execution will jump back up to the statement following the
|
|
// _setjmp() above.
|
|
xljump(&nyx_cntxt, CF_TOPLEVEL, NIL);
|
|
// Never reached
|
|
|
|
finish:
|
|
|
|
xlflush();
|
|
|
|
xlpop(); // unprotect expr
|
|
|
|
setvalue(xlenter(nyx_get_audio_name()), NIL);
|
|
|
|
gc();
|
|
|
|
#if defined(NYX_MEMORY_STATS) && NYX_MEMORY_STATS
|
|
printf("\nnyx_eval_expression after\n");
|
|
xmem();
|
|
#endif
|
|
|
|
printf("nyx_eval_expression returns %d\n", nyx_get_type(nyx_result));
|
|
return nyx_get_type(nyx_result);
|
|
}
|
|
|
|
int nyx_get_audio_num_channels()
|
|
{
|
|
if (nyx_get_type(nyx_result) != nyx_audio) {
|
|
return 0;
|
|
}
|
|
|
|
if (vectorp(nyx_result)) {
|
|
if (getsize(nyx_result) == 1) {
|
|
return -1; // invalid number of channels in array
|
|
} else {
|
|
return getsize(nyx_result);
|
|
}
|
|
}
|
|
|
|
return 1;
|
|
}
|
|
|
|
// see sndwritepa.c for similar computation. This is a bit simpler
|
|
// because we are not writing interleaved samples.
|
|
typedef struct {
|
|
int cnt; // how many samples are in the current sample block
|
|
sample_block_values_type samps; // the next sample
|
|
bool terminated; // has the sound reached termination?
|
|
} sound_state_node, *sound_state_type;
|
|
|
|
|
|
int nyx_get_audio(nyx_audio_callback callback, void *userdata)
|
|
{
|
|
sound_state_type states; // tracks progress reading multiple channels
|
|
float *buffer = NULL; // samples to push to callback
|
|
int64_t total = 0; // total frames computed (samples per channel)
|
|
sound_type snd;
|
|
int result = 0;
|
|
int num_channels;
|
|
int ch;
|
|
|
|
// Any variable whose value is set between the _setjmp() and the "finish" label
|
|
// and that is used after the "finish" label, must be marked volatile since
|
|
// any routine outside of the current one that calls _longjmp() will cause values
|
|
// cached in registers to be lost.
|
|
volatile int success = FALSE;
|
|
|
|
printf("nyx_get_audio type %d\n", nyx_get_type(nyx_result));
|
|
if (nyx_get_type(nyx_result) != nyx_audio) {
|
|
return FALSE;
|
|
}
|
|
|
|
#if defined(NYX_MEMORY_STATS) && NYX_MEMORY_STATS
|
|
printf("\nnyx_get_audio before\n");
|
|
xmem();
|
|
#endif
|
|
|
|
num_channels = nyx_get_audio_num_channels();
|
|
|
|
buffer = (sample_type *) malloc(max_sample_block_len * sizeof(sample_type));
|
|
if (buffer == NULL) {
|
|
goto finish;
|
|
}
|
|
|
|
states = (sound_state_type) malloc(num_channels * sizeof(sound_state_node));
|
|
if (states == NULL) {
|
|
goto finish;
|
|
}
|
|
for (ch = 0; ch < num_channels; ch++) {
|
|
states[ch].cnt = 0; // force initial fetch
|
|
states[ch].samps = NULL; // unnecessary initialization
|
|
states[ch].terminated = false;
|
|
}
|
|
|
|
// Setup a new context
|
|
xlbegin(&nyx_cntxt, CF_TOPLEVEL|CF_CLEANUP|CF_BRKLEVEL|CF_ERROR, s_true);
|
|
|
|
// Set the context jump destination
|
|
if (_setjmp(nyx_cntxt.c_jmpbuf)) {
|
|
// If the script is cancelled or some other condition occurs that causes
|
|
// the script to exit and return to this level, then we don't need to
|
|
// restore the previous context.
|
|
goto finish;
|
|
}
|
|
|
|
// at this point, input sounds which were referenced by symbol S
|
|
// (or nyx_get_audio_name()) could be referenced by nyx_result, but
|
|
// S is now bound to NIL. nyx_result is a protected (garbage
|
|
// collected) LVAL bound to a sound or array of sounds, so we must
|
|
// either unbind nyx_result or read it destructively. We need the
|
|
// GC to know about sounds as we read them, so we might as well
|
|
// read nyx_result destructively. However, reading destructively
|
|
// will fail if nyx_result is (VECTOR S S) or has two references to
|
|
// the same sound. Therefore, we will replace each channel of
|
|
// nyx_result (except the first) with a copy. This may make
|
|
// needless copies, but if so, the GC will free the originals.
|
|
// Note: sound copies are just "readers" of the same underlying
|
|
// list of samples (snd_list_nodes) and lazy sample computation
|
|
// structure, so here, a sound copy is just one extra object of
|
|
// type sound_node.
|
|
// To unify single and multi-channel sounds, we'll create an array
|
|
// of one element for single-channel sounds.
|
|
|
|
if (num_channels == 1) {
|
|
LVAL array = newvector(1);
|
|
setelement(array, 0, nyx_result);
|
|
nyx_result = array;
|
|
}
|
|
for (ch = 0; ch < num_channels; ch++) {
|
|
if (ch > 0) { // no need to copy first channel
|
|
setelement(nyx_result, ch,
|
|
cvsound(sound_copy(getsound(getelement(nyx_result, ch)))));
|
|
}
|
|
}
|
|
|
|
// This is the "pump" that pulls samples from Nyquist and pushes samples
|
|
// out by calling the callback function. Every block boundary is a potential
|
|
// sound termination point, so we pull, scale, and write sample up to the
|
|
// next block boundary in any channel.
|
|
// First, we look at all channels to determine how many samples we have to
|
|
// compute in togo (how many "to go"). Then, we push togo samples from each
|
|
// channel to the callback, keeping all the channels in lock step.
|
|
|
|
while (result == 0) {
|
|
bool terminated = true;
|
|
// how many samples to compute before calling callback:
|
|
int64_t togo = max_sample_block_len;
|
|
for (ch = 0; ch < num_channels; ch++) {
|
|
sound_state_type state = &states[ch];
|
|
sound_type snd = getsound(getelement(nyx_result, ch));
|
|
sample_block_type block;
|
|
int cnt;
|
|
int i;
|
|
if (state->cnt == 0) {
|
|
state->samps = sound_get_next(snd, &state->cnt)->samples;
|
|
if (state->samps == zero_block->samples) {
|
|
state->terminated = true;
|
|
// Note: samps is a valid pointer to at least cnt zeros
|
|
// so we can process this channel as if it still has samples.
|
|
}
|
|
}
|
|
terminated &= state->terminated; // only terminated if ALL terminate
|
|
if (state->cnt < togo) togo = state->cnt;
|
|
// now togo is the minimum of: how much room is left in buffer and
|
|
// how many samples are available in samps
|
|
}
|
|
if (terminated || togo == 0) {
|
|
success = TRUE;
|
|
result = -1;
|
|
break; // no more samples in any channel
|
|
}
|
|
|
|
for (ch = 0; ch < num_channels; ch++) {
|
|
sound_state_type state = &states[ch];
|
|
sound_type snd = getsound(getelement(nyx_result, ch));
|
|
// Copy and scale the samples
|
|
for (int i = 0; i < togo; i++) {
|
|
buffer[i] = *(state->samps++) * (float) snd->scale;
|
|
}
|
|
state->cnt -= togo;
|
|
// TODO: What happens here when we don't know the total length,
|
|
// i.e. nyx_input_length == 0? Should we pass total+togo instead?
|
|
result = callback(buffer, ch, total, togo, nyx_input_length, userdata);
|
|
if (result != 0) {
|
|
result = -1;
|
|
break;
|
|
}
|
|
}
|
|
total += togo;
|
|
}
|
|
|
|
nyx_result = NULL; // unreference sound array so GC can free it
|
|
|
|
// This will unwind the xlisp context and restore internals to a point just
|
|
// before we issued our xlbegin() above. This is important since the internal
|
|
// xlisp stacks will contain pointers to invalid objects otherwise.
|
|
//
|
|
// Also note that execution will jump back up to the statement following the
|
|
// _setjmp() above.
|
|
xljump(&nyx_cntxt, CF_TOPLEVEL, NIL);
|
|
// Never reached
|
|
|
|
finish:
|
|
|
|
if (buffer) {
|
|
free(buffer);
|
|
}
|
|
|
|
if (states) {
|
|
free(states);
|
|
}
|
|
|
|
gc();
|
|
|
|
#if defined(NYX_MEMORY_STATS) && NYX_MEMORY_STATS
|
|
printf("\nnyx_get_audio after\n");
|
|
xmem();
|
|
#endif
|
|
|
|
return success;
|
|
}
|
|
|
|
int nyx_get_int()
|
|
{
|
|
if (nyx_get_type(nyx_result) != nyx_int) {
|
|
return -1;
|
|
}
|
|
|
|
return getfixnum(nyx_result);
|
|
}
|
|
|
|
double nyx_get_double()
|
|
{
|
|
if (nyx_get_type(nyx_result) != nyx_double) {
|
|
return -1.0;
|
|
}
|
|
|
|
return getflonum(nyx_result);
|
|
}
|
|
|
|
const char *nyx_get_string()
|
|
{
|
|
if (nyx_get_type(nyx_result) != nyx_string) {
|
|
return NULL;
|
|
}
|
|
|
|
return (const char *)getstring(nyx_result);
|
|
}
|
|
|
|
unsigned int nyx_get_num_labels()
|
|
{
|
|
LVAL s;
|
|
int count = 0;
|
|
|
|
if (nyx_get_type(nyx_result) != nyx_labels) {
|
|
return 0;
|
|
}
|
|
|
|
for (s = nyx_result; s; s = cdr(s)) {
|
|
count++;
|
|
}
|
|
|
|
return count;
|
|
}
|
|
|
|
void nyx_get_label(unsigned int index,
|
|
double *start_time,
|
|
double *end_time,
|
|
const char **label)
|
|
{
|
|
LVAL s = nyx_result;
|
|
LVAL label_expr;
|
|
LVAL t0_expr;
|
|
LVAL t1_expr;
|
|
LVAL str_expr;
|
|
|
|
if (nyx_get_type(nyx_result) != nyx_labels) {
|
|
return;
|
|
}
|
|
|
|
while (index) {
|
|
index--;
|
|
s = cdr(s);
|
|
if (s == NULL) {
|
|
// index was larger than number of labels
|
|
return;
|
|
}
|
|
}
|
|
|
|
/* We either have (t0 "label") or (t0 t1 "label") */
|
|
|
|
label_expr = car(s);
|
|
t0_expr = car(label_expr);
|
|
t1_expr = car(cdr(label_expr));
|
|
if (stringp(t1_expr)) {
|
|
str_expr = t1_expr;
|
|
t1_expr = t0_expr;
|
|
}
|
|
else {
|
|
str_expr = car(cdr(cdr(label_expr)));
|
|
}
|
|
|
|
if (floatp(t0_expr)) {
|
|
*start_time = getflonum(t0_expr);
|
|
}
|
|
else if (fixp(t0_expr)) {
|
|
*start_time = (double)getfixnum(t0_expr);
|
|
}
|
|
|
|
if (floatp(t1_expr)) {
|
|
*end_time = getflonum(t1_expr);
|
|
}
|
|
else if (fixp(t1_expr)) {
|
|
*end_time = (double)getfixnum(t1_expr);
|
|
}
|
|
|
|
*label = (const char *)getstring(str_expr);
|
|
}
|
|
|
|
const char *nyx_get_error_str()
|
|
{
|
|
return NULL;
|
|
}
|
|
|
|
void nyx_set_os_callback(nyx_os_callback callback, void *userdata)
|
|
{
|
|
nyx_os_cb = callback;
|
|
nyx_os_ud = userdata;
|
|
}
|
|
|
|
void nyx_stop()
|
|
{
|
|
xlflush();
|
|
xltoplevel();
|
|
}
|
|
|
|
void nyx_break()
|
|
{
|
|
xlflush();
|
|
xlbreak("BREAK", s_unbound);
|
|
}
|
|
|
|
void nyx_continue()
|
|
{
|
|
xlflush();
|
|
xlcontinue();
|
|
}
|
|
|
|
int ostgetc()
|
|
{
|
|
if (nyx_expr_pos < nyx_expr_len) {
|
|
fflush(stdout);
|
|
if (tfp && nyx_expr_string[nyx_expr_pos] != '\n') {
|
|
ostputc(nyx_expr_string[nyx_expr_pos]);
|
|
}
|
|
return (nyx_expr_string[nyx_expr_pos++]);
|
|
}
|
|
else if (nyx_expr_pos == nyx_expr_len) {
|
|
/* Add whitespace at the end so that the parser
|
|
knows that this is the end of the expression */
|
|
nyx_expr_pos++;
|
|
if (tfp) {
|
|
ostputc('\n');
|
|
}
|
|
return '\n';
|
|
}
|
|
|
|
return EOF;
|
|
}
|
|
|
|
/* osinit - initialize */
|
|
void osinit(const char *banner)
|
|
{
|
|
}
|
|
|
|
/* osfinish - clean up before returning to the operating system */
|
|
void osfinish(void)
|
|
{
|
|
}
|
|
|
|
/* oserror - print an error message */
|
|
void oserror(const char *msg)
|
|
{
|
|
errputstr(msg);
|
|
}
|
|
|
|
/* cd ..
|
|
open - open an ascii file */
|
|
FILE *osaopen(const char *name, const char *mode)
|
|
{
|
|
return fopen(name, mode);
|
|
}
|
|
|
|
/* osbopen - open a binary file */
|
|
FILE *osbopen(const char *name, const char *mode)
|
|
{
|
|
char bmode[10];
|
|
|
|
strncpy(bmode, mode, 8);
|
|
strcat(bmode, "b");
|
|
|
|
return fopen(name,bmode);
|
|
}
|
|
|
|
/* osclose - close a file */
|
|
int osclose(FILE *fp)
|
|
{
|
|
return fclose(fp);
|
|
}
|
|
|
|
/* osagetc - get a character from an ascii file */
|
|
int osagetc(FILE *fp)
|
|
{
|
|
return getc(fp);
|
|
}
|
|
|
|
/* osaputc - put a character to an ascii file */
|
|
int osaputc(int ch, FILE *fp)
|
|
{
|
|
return putc(ch,fp);
|
|
}
|
|
|
|
/* osoutflush - flush output to a file */
|
|
void osoutflush(FILE *fp)
|
|
{
|
|
fflush(fp);
|
|
}
|
|
|
|
/* osbgetc - get a character from a binary file */
|
|
int osbgetc(FILE *fp)
|
|
{
|
|
return getc(fp);
|
|
}
|
|
|
|
/* osbputc - put a character to a binary file */
|
|
int osbputc(int ch, FILE *fp)
|
|
{
|
|
return putc(ch, fp);
|
|
}
|
|
|
|
/* ostputc - put a character to the terminal */
|
|
void ostputc(int ch)
|
|
{
|
|
oscheck(); /* check for control characters */
|
|
|
|
if (nyx_output_cb) {
|
|
nyx_output_cb(ch, nyx_output_ud);
|
|
if (tfp) {
|
|
putc(ch, tfp);
|
|
}
|
|
}
|
|
else {
|
|
putchar((char) ch);
|
|
}
|
|
}
|
|
|
|
/* ostoutflush - flush output buffer */
|
|
void ostoutflush()
|
|
{
|
|
if (!nyx_output_cb) {
|
|
fflush(stdout);
|
|
}
|
|
}
|
|
|
|
/* osflush - flush the terminal input buffer */
|
|
void osflush(void)
|
|
{
|
|
}
|
|
|
|
/* oscheck - check for control characters during execution */
|
|
void oscheck(void)
|
|
{
|
|
if (nyx_os_cb) {
|
|
nyx_os_cb(nyx_os_ud);
|
|
}
|
|
/* if they hit control-c:
|
|
xflush(); xltoplevel(); return;
|
|
*/
|
|
}
|
|
|
|
/* xsystem - execute a system command */
|
|
LVAL xsystem()
|
|
{
|
|
if (moreargs()) {
|
|
unsigned char *cmd;
|
|
cmd = (unsigned char *)getstring(xlgastring());
|
|
fprintf(stderr, "Will not execute system command: %s\n", cmd);
|
|
}
|
|
return s_true;
|
|
}
|
|
|
|
/* xsetdir -- set current directory of the process */
|
|
LVAL xsetdir()
|
|
{
|
|
char *dir = (char *)getstring(xlgastring());
|
|
int result;
|
|
LVAL cwd = NULL;
|
|
int verbose = TRUE;
|
|
|
|
if (moreargs()) {
|
|
verbose = (xlgetarg() != NIL);
|
|
}
|
|
|
|
xllastarg();
|
|
|
|
result = chdir(dir);
|
|
if (result) {
|
|
/* perror("SETDIR"); -- Nyquist uses SETDIR to search for directories
|
|
* at startup, so failures are normal, and seeing error messages
|
|
* could be confusing, so don't print them. The NULL return indicates
|
|
* an error, but doesn't tell which one it is.
|
|
* But now, SETDIR has a second verbose parameter that is nil when
|
|
* searching for directories. -RBD
|
|
*/
|
|
if (verbose) perror("Directory Setting Error");
|
|
return NULL;
|
|
}
|
|
|
|
dir = getcwd(NULL, 1000);
|
|
if (dir) {
|
|
cwd = cvstring(dir);
|
|
free(dir);
|
|
}
|
|
|
|
return cwd;
|
|
}
|
|
|
|
/* xgetkey - get a key from the keyboard */
|
|
LVAL xgetkey()
|
|
{
|
|
xllastarg();
|
|
return (cvfixnum((FIXTYPE)getchar()));
|
|
}
|
|
|
|
/* ossymbols - enter os specific symbols */
|
|
void ossymbols(void)
|
|
{
|
|
}
|
|
|
|
/* xsetupconsole -- used to configure window in Win32 version */
|
|
LVAL xsetupconsole()
|
|
{
|
|
return NULL;
|
|
}
|
|
|
|
#if defined(WIN32)
|
|
const char os_pathchar = '\\';
|
|
const char os_sepchar = ',';
|
|
#else
|
|
const char os_pathchar = '/';
|
|
const char os_sepchar = ':';
|
|
#endif
|
|
|
|
/* control-C handling */
|
|
void ctcinit()
|
|
{
|
|
}
|
|
|
|
/* xechoenabled -- set/clear echo_enabled flag (unix only) */
|
|
LVAL xechoenabled()
|
|
{
|
|
return NULL;
|
|
}
|
|
|
|
#if defined(WIN32)
|
|
|
|
static WIN32_FIND_DATA FindFileData;
|
|
static HANDLE hFind = INVALID_HANDLE_VALUE;
|
|
#define OSDIR_LIST_READY 0
|
|
#define OSDIR_LIST_STARTED 1
|
|
#define OSDIR_LIST_DONE 2
|
|
static int osdir_list_status = OSDIR_LIST_READY;
|
|
#define OSDIR_MAX_PATH 256
|
|
static char osdir_path[OSDIR_MAX_PATH];
|
|
|
|
// osdir_list_start -- prepare to list a directory
|
|
int osdir_list_start(const char *path)
|
|
{
|
|
if (strlen(path) >= OSDIR_MAX_PATH - 2) {
|
|
xlcerror("LISTDIR path too big", "return nil", NULL);
|
|
return FALSE;
|
|
}
|
|
strcpy(osdir_path, path);
|
|
strcat(osdir_path, "/*"); // make a pattern to match all files
|
|
|
|
if (osdir_list_status != OSDIR_LIST_READY) {
|
|
osdir_list_finish(); // close previously interrupted listing
|
|
}
|
|
|
|
hFind = FindFirstFile(osdir_path, &FindFileData); // get the "."
|
|
if (hFind == INVALID_HANDLE_VALUE) {
|
|
return FALSE;
|
|
}
|
|
if (FindNextFile(hFind, &FindFileData) == 0) {
|
|
return FALSE; // get the ".."
|
|
}
|
|
|
|
osdir_list_status = OSDIR_LIST_STARTED;
|
|
|
|
return TRUE;
|
|
}
|
|
|
|
/* osdir_list_next -- read the next entry from a directory */
|
|
const char *osdir_list_next()
|
|
{
|
|
if (FindNextFile(hFind, &FindFileData) == 0) {
|
|
osdir_list_status = OSDIR_LIST_DONE;
|
|
return NULL;
|
|
}
|
|
return FindFileData.cFileName;
|
|
}
|
|
|
|
/* osdir_list_finish -- close an open directory */
|
|
void osdir_list_finish()
|
|
{
|
|
if (osdir_list_status != OSDIR_LIST_READY) {
|
|
FindClose(hFind);
|
|
}
|
|
osdir_list_status = OSDIR_LIST_READY;
|
|
}
|
|
|
|
#else
|
|
|
|
#include <dirent.h>
|
|
#define OSDIR_LIST_READY 0
|
|
#define OSDIR_LIST_STARTED 1
|
|
#define OSDIR_LIST_DONE 2
|
|
static int osdir_list_status = OSDIR_LIST_READY;
|
|
static DIR *osdir_dir;
|
|
|
|
/* osdir_list_start -- open a directory listing */
|
|
int osdir_list_start(const char *path)
|
|
{
|
|
if (osdir_list_status != OSDIR_LIST_READY) {
|
|
osdir_list_finish(); /* close current listing */
|
|
}
|
|
osdir_dir = opendir(path);
|
|
if (!osdir_dir) {
|
|
return FALSE;
|
|
}
|
|
osdir_list_status = OSDIR_LIST_STARTED;
|
|
return TRUE;
|
|
}
|
|
|
|
/* osdir_list_next -- read the next entry from a directory */
|
|
const char *osdir_list_next()
|
|
{
|
|
struct dirent *entry;
|
|
|
|
if (osdir_list_status != OSDIR_LIST_STARTED) {
|
|
return NULL;
|
|
}
|
|
|
|
entry = readdir(osdir_dir);
|
|
if (!entry) {
|
|
osdir_list_status = OSDIR_LIST_DONE;
|
|
return NULL;
|
|
}
|
|
return entry->d_name;
|
|
}
|
|
|
|
/* osdir_list_finish -- close an open directory */
|
|
void osdir_list_finish()
|
|
{
|
|
if (osdir_list_status != OSDIR_LIST_READY) {
|
|
closedir(osdir_dir);
|
|
}
|
|
osdir_list_status = OSDIR_LIST_READY;
|
|
}
|
|
|
|
#endif
|
|
|
|
/* xget_temp_path -- get a path to create temp files */
|
|
LVAL xget_temp_path()
|
|
{
|
|
char *tmp;
|
|
|
|
#if defined(WINDOWS)
|
|
tmp = getenv("TEMP");
|
|
#else
|
|
tmp = getenv("TMPDIR");
|
|
#endif
|
|
|
|
if (!tmp || !*tmp) {
|
|
tmp = getenv("TMP");
|
|
if (!tmp || !*tmp) {
|
|
#if defined(WINDOWS)
|
|
tmp = "/";
|
|
#else
|
|
tmp = "/tmp/";
|
|
#endif
|
|
}
|
|
}
|
|
|
|
return cvstring(tmp);
|
|
}
|
|
|
|
/* xget_user -- get a string identifying the user, for use in file names */
|
|
LVAL xget_user()
|
|
{
|
|
char *user = getenv("USER");
|
|
|
|
if (!user || !*user) {
|
|
user = getenv("USERNAME");
|
|
if (!user || !*user) {
|
|
errputstr("Warning: could not get user ID, using 'nyquist'\n");
|
|
user = "nyquist";
|
|
}
|
|
}
|
|
|
|
return cvstring(user);
|
|
}
|
|
|
|
#if defined(WINDOWS)
|
|
/* get_xlisp_path -- return path to xlisp */
|
|
void get_xlisp_path(char *p, long p_max)
|
|
{
|
|
char *paths = getenv("XLISPPATH");
|
|
|
|
if (!paths || !*paths) {
|
|
*p = 0;
|
|
return;
|
|
}
|
|
|
|
strncpy(p, paths, p_max);
|
|
p[p_max-1] = 0;
|
|
}
|
|
|
|
/* xgetrealtime - get current time in seconds */
|
|
LVAL xgetrealtime()
|
|
{
|
|
static const uint64_t EPOCH = ((uint64_t)116444736000000000ULL);
|
|
SYSTEMTIME system_time;
|
|
FILETIME file_time;
|
|
uint64_t time;
|
|
GetSystemTime(&system_time);
|
|
SystemTimeToFileTime(&system_time, &file_time);
|
|
time = (uint64_t) file_time.dwLowDateTime;
|
|
time += ((uint64_t) file_time.dwHighDateTime) << 32;
|
|
time -= EPOCH;
|
|
time /= 10000000L;
|
|
return cvflonum((double) time + system_time.wMilliseconds * 0.001);
|
|
}
|
|
#else
|
|
#include <sys/time.h>
|
|
|
|
/* xgetrealtime - get current time in seconds */
|
|
LVAL xgetrealtime(void)
|
|
{
|
|
struct timeval te;
|
|
gettimeofday(&te, NULL); // get current time
|
|
return cvflonum((double) te.tv_sec + (te.tv_usec * 1e-6));
|
|
}
|
|
#endif
|
|
|