static Expr* eq(Expr* args) {
assert(args);
if(scm_list_len(args) != 2) return scm_mk_error("eq? expects 2 args");
return scm_car(args) == scm_cadr(args) ? TRUE : FALSE;
}
VISIBLE void
scm_c_anchor_point_coords (SCM anchor_point, SCM *x, SCM *y)
{
SCM coords = scm_anchor_point_coords_2 (anchor_point);
*x = scm_car (coords);
*y = scm_cadr (coords);
}
SCM Display::scm_draw_image(SCM image, SCM pos) {
#ifdef WITH_SDL
struct image *img = (struct image *) SCM_SMOB_DATA(image);
SDL_Rect p;
p.x = scm_to_int(scm_car(pos));
p.y = scm_to_int(scm_cadr(pos));
printf("%d, %d", img->surface, NULL);
SDL_BlitSurface(img->surface, NULL, get()->m_pScreen, &p);
#endif
}
static Expr* env_names(Expr* args) {
assert(args);
if(args == EMPTY_LIST) return scm_mk_error("env-names expects an argument");
if(scm_cdr(args) != EMPTY_LIST) return scm_mk_error("env-names expects only 1 argument");
Expr* fst = scm_car(args);
if(fst == FALSE) return EMPTY_LIST;
if(!scm_is_env(fst)) return scm_mk_error("env-names expects an environment");
return scm_cadr(fst);
}
SCM mjpeg_to_yuv420p(SCM scm_source_ptr, SCM scm_shape, SCM scm_dest_ptr, SCM scm_offsets)
{
unsigned char *source_ptr = scm_to_pointer(scm_source_ptr);
unsigned char *dest_ptr = scm_to_pointer(scm_dest_ptr);
int width = scm_to_int(scm_cadr(scm_shape));
int height = scm_to_int(scm_car(scm_shape));
int64_t offsets[3];
memset(offsets, 0, sizeof(offsets));
scm_to_long_array(scm_offsets, offsets);
decode_jpeg_raw(source_ptr, width * height * 2, Y4M_ILACE_NONE, 0, width, height,
dest_ptr + offsets[0], dest_ptr + offsets[2], dest_ptr + offsets[1]);
return SCM_UNSPECIFIED;
}
static Expr* set_cdr(Expr* args) {
assert(args);
if(scm_list_len(args) != 2) return scm_mk_error("set-cdr! expects 2 arguments");
Expr* arg = scm_car(args);
if(!scm_is_pair(arg)) return scm_mk_error("first arg to set-cdr! must be a pair");
Expr* val = scm_cadr(args);
arg->pair.cdr = val;
return EMPTY_LIST;
}
static Expr* eqv(Expr* args) {
assert(args);
if(scm_list_len(args) != 2) return scm_mk_error("eqv? expects 2 args");
Expr* fst = scm_car(args);
Expr* snd = scm_cadr(args);
if(fst == snd) return TRUE;
if(scm_is_pair(fst) || scm_is_pair(snd)) return FALSE;
if(scm_is_closure(fst) || scm_is_closure(snd)) return FALSE;
if(scm_is_num(fst) && scm_is_num(snd)) return num_eq(args);
if(scm_is_string(fst) && scm_is_string(snd) && strcmp(scm_sval(fst), scm_sval(snd)) == 0) return TRUE;
return FALSE;
}
SCM Display::scm_init_graphics(SCM size) {
#ifdef WITH_SDL
SDL_Init(SDL_INIT_VIDEO);
SDL_Surface *screen = NULL;
screen = SDL_SetVideoMode(scm_to_uint(scm_car(size)),
scm_to_uint(scm_cadr(size)), 32,
SDL_DEFAULT_FLAGS);
if (screen == NULL) {
/* TODO: handle errors like this */
std::cout << "Can't init SDL\n";
exit(0);
}
get()->m_pScreen = screen;
SDL_FillRect(screen, NULL, SDL_MapRGB(screen->format, 0, 0, 0));
#endif
}
static Expr* str_ref(Expr* args) {
assert(args);
if(scm_list_len(args) != 2) return scm_mk_error("string-ref expects 2 args");
Expr* a = scm_car(args);
if(!scm_is_string(a)) return scm_mk_error("string-ref expects a string as its 1st arg");
Expr* i = scm_cadr(args);
if(!scm_is_int(i)) return scm_mk_error("string-ref expects an int as its 2nd arg");
Expr* toRet = scm_mk_char(scm_sval(a)[scm_ival(i)]);
return toRet ? toRet : OOM;
}
static Expr* cons(Expr* args) {
assert(args);
if(scm_list_len(args) != 2) return scm_mk_error("cons expects 2 args");
Expr* es[2] = { scm_car(args), scm_cadr(args) };
scm_stack_push(&es[0]);
scm_stack_push(&es[1]);
Expr* toRet = scm_mk_pair(es[0], es[1]);
scm_stack_pop(&es[1]);
scm_stack_pop(&es[0]);
return toRet ? toRet : OOM;
}
static Expr* mk_str(Expr* args) {
assert(args);
int len = scm_list_len(args);
if(len < 0 || len > 2) return scm_mk_error("make-string expects 1 or 2 args");
Expr* l = scm_car(args);
if(!scm_is_int(l)) return scm_mk_error("make-string expects an int as its 1st arg");
long long size = scm_ival(l);
char* buf = malloc(size+1);
if(!buf) return OOM;
Expr* toRet = scm_alloc();
if(!toRet) {
free(buf);
return OOM;
}
char c = 'a';
if(len == 2) {
Expr* ca = scm_cadr(args);
if(!scm_is_char(ca)) {
free(buf);
return scm_mk_error("make-string expects a char as its 2nd arg");
}
c = scm_cval(ca);
}
memset(buf, c, size);
buf[size] = '\0';
toRet->tag = ATOM;
toRet->atom.type = STRING;
toRet->atom.sval = buf;
return toRet;
}
static Expr* str_set(Expr* args) {
assert(args);
if(scm_list_len(args) != 3) return scm_mk_error("string-set! expects 2 args");
Expr* a = scm_car(args);
if(!scm_is_string(a)) return scm_mk_error("string-set! expects a string as its 1st arg");
Expr* i = scm_cadr(args);
if(!scm_is_int(i)) return scm_mk_error("string-set! expects an int as its 2nd arg");
Expr* c = scm_caddr(args);
if(!scm_is_char(c)) return scm_mk_error("string-set! expects a char as its 3rd arg");
scm_sval(a)[scm_ival(i)] = scm_cval(c);
return EMPTY_LIST;
}
static AVCodecContext *configure_output_video_codec(AVStream *video_stream, enum AVCodecID video_codec_id,
SCM scm_video_bit_rate, SCM scm_shape, SCM scm_frame_rate, SCM scm_aspect_ratio)
{
// Get codec context
AVCodecContext *retval = video_stream->codec;
// Set codec id
retval->codec_id = video_codec_id;
retval->codec_type = AVMEDIA_TYPE_VIDEO;
// Set encoder bit rate
retval->bit_rate = scm_to_int(scm_video_bit_rate);
// Set video frame width and height
retval->width = scm_to_int(scm_cadr(scm_shape));
retval->height = scm_to_int(scm_car(scm_shape));
// Set video frame rate
video_stream->avg_frame_rate.num = scm_to_int(scm_numerator(scm_frame_rate));
video_stream->avg_frame_rate.den = scm_to_int(scm_denominator(scm_frame_rate));
video_stream->time_base.num = video_stream->avg_frame_rate.den;
video_stream->time_base.den = video_stream->avg_frame_rate.num;
retval->time_base = video_stream->time_base;
// Set intra frame lower limit
retval->gop_size = 12;
// Set pixel format
retval->pix_fmt = PIX_FMT;
if (retval->codec_id == AV_CODEC_ID_MPEG1VIDEO) retval->mb_decision = 2;
// Set aspect ratio
video_stream->sample_aspect_ratio.num = scm_to_int(scm_numerator(scm_aspect_ratio));
video_stream->sample_aspect_ratio.den = scm_to_int(scm_denominator(scm_aspect_ratio));
retval->sample_aspect_ratio = video_stream->sample_aspect_ratio;
return retval;
}
/* Actually carries out evaluation for protected eval */
static SCM protected_body_eval (void *data)
{
SCM args = *((SCM *)data);
return scm_eval (scm_car (args), scm_cadr (args));
}
SCM make_ffmpeg_output(SCM scm_file_name,
SCM scm_format_name,
SCM scm_video_parameters,
SCM scm_have_video,
SCM scm_audio_parameters,
SCM scm_have_audio,
SCM scm_debug)
{
SCM retval;
struct ffmpeg_t *self;
scm_dynwind_begin(0);
const char *file_name = scm_to_locale_string(scm_file_name);
scm_dynwind_free(file_name);
self = (struct ffmpeg_t *)scm_gc_calloc(sizeof(struct ffmpeg_t), "ffmpeg");
self->video_stream_idx = -1;
self->audio_stream_idx = -1;
SCM_NEWSMOB(retval, ffmpeg_tag, self);
int err;
const char *format_name = NULL;
if (!scm_is_false(scm_format_name)) {
format_name = scm_to_locale_string(scm_symbol_to_string(scm_format_name));
scm_dynwind_free(format_name);
};
#ifdef HAVE_AVFORMAT_ALLOC_OUTPUT_CONTEXT2
err = avformat_alloc_output_context2(&self->fmt_ctx, NULL, format_name, file_name);
if (!self->fmt_ctx) {
ffmpeg_destroy(retval);
scm_misc_error("make-ffmpeg-output", "Error initializing output format for file '~a': ~a",
scm_list_2(scm_file_name, get_error_text(err)));
};
#else
AVOutputFormat *format;
if (format_name)
format = av_guess_format(format_name, NULL, NULL);
else
format = av_guess_format(NULL, file_name, NULL);
if (!format) {
ffmpeg_destroy(retval);
scm_misc_error("make-ffmpeg-output", "Unable to determine file format for file '~a'",
scm_list_1(scm_file_name));
};
self->fmt_ctx = avformat_alloc_context();
if (!self->fmt_ctx) {
ffmpeg_destroy(retval);
scm_misc_error("make-ffmpeg-output", "Error initializing output format for file '~a'",
scm_list_1(scm_file_name));
};
self->fmt_ctx->oformat = format;
strncpy(self->fmt_ctx->filename, file_name, sizeof(self->fmt_ctx->filename));
#endif
char have_video = scm_is_true(scm_have_video);
if (have_video) {
// Open codec and video stream
enum AVCodecID video_codec_id = self->fmt_ctx->oformat->video_codec;
AVCodec *video_encoder = find_encoder(retval, video_codec_id, "video");
AVStream *video_stream = open_output_stream(retval, video_encoder, &self->video_stream_idx, "video", scm_file_name);
// Get video parameters
SCM scm_shape = scm_car(scm_video_parameters);
SCM scm_frame_rate = scm_cadr(scm_video_parameters);
SCM scm_video_bit_rate = scm_caddr(scm_video_parameters);
SCM scm_aspect_ratio = scm_cadddr(scm_video_parameters);
// Configure the output video codec
self->video_codec_ctx =
configure_output_video_codec(video_stream, video_codec_id, scm_video_bit_rate, scm_shape, scm_frame_rate, scm_aspect_ratio);
// Some formats want stream headers to be separate.
if (self->fmt_ctx->oformat->flags & AVFMT_GLOBALHEADER)
self->video_codec_ctx->flags |= AV_CODEC_FLAG_GLOBAL_HEADER;
// Open output video codec
open_codec(retval, self->video_codec_ctx, video_encoder, "video", scm_file_name);
// Allocate frame
self->video_target_frame = allocate_output_video_frame(retval, self->video_codec_ctx);
};
char have_audio = scm_is_true(scm_have_audio);
if (have_audio) {
// Open audio codec and stream
enum AVCodecID audio_codec_id = self->fmt_ctx->oformat->audio_codec;
AVCodec *audio_encoder = find_encoder(retval, audio_codec_id, "audio");
AVStream *audio_stream = open_output_stream(retval, audio_encoder, &self->audio_stream_idx, "audio", scm_file_name);
// Get audio parameters
SCM scm_select_rate = scm_car(scm_audio_parameters);
SCM scm_channels = scm_cadr(scm_audio_parameters);
SCM scm_audio_bit_rate = scm_caddr(scm_audio_parameters);
SCM scm_select_format = scm_cadddr(scm_audio_parameters);
// Configure the output audio codec
self->audio_codec_ctx =
configure_output_audio_codec(retval, audio_stream, audio_codec_id,
scm_select_rate, scm_channels, scm_audio_bit_rate, scm_select_format);
// Some formats want stream headers to be separate.
if (self->fmt_ctx->oformat->flags & AVFMT_GLOBALHEADER)
self->audio_codec_ctx->flags |= AV_CODEC_FLAG_GLOBAL_HEADER;
// Open output audio codec
open_codec(retval, self->audio_codec_ctx, audio_encoder, "audio", scm_file_name);
// Allocate audio frame
self->audio_target_frame =
allocate_output_audio_frame(retval, self->audio_codec_ctx, self->audio_codec_ctx->sample_fmt);
self->audio_packed_frame =
allocate_output_audio_frame(retval, self->audio_codec_ctx, av_get_packed_sample_fmt(self->audio_codec_ctx->sample_fmt));
// Initialise audio buffer
ringbuffer_init(&self->audio_buffer, 1024);
};
if (scm_is_true(scm_debug)) av_dump_format(self->fmt_ctx, 0, file_name, 1);
// Open the output file if needed
if (!(self->fmt_ctx->oformat->flags & AVFMT_NOFILE)) {
int err = avio_open(&self->fmt_ctx->pb, file_name, AVIO_FLAG_WRITE);
if (err < 0) {
ffmpeg_destroy(retval);
scm_misc_error("make-ffmpeg-output", "Could not open '~a': ~a",
scm_list_2(scm_file_name, get_error_text(err)));
}
self->output_file = 1;
}
// Write video file header
err = avformat_write_header(self->fmt_ctx, NULL);
if (err < 0) {
ffmpeg_destroy(retval);
scm_misc_error("make-ffmpeg-output", "Error writing header of video '~a': ~a",
scm_list_2(scm_file_name, get_error_text(err)));
};
self->header_written = 1;
scm_dynwind_end();
return retval;
}
