/*
* (set-video-mode <width> <height> <bits per pixel>?) or
* (set-video-mode <width> <height> <bits per pixel> <mode flags>+)
*
* where <symbols> are:
* swsurface
* hwsurface
* asyncblit
* anyformat
* hwpalette
* doublebuf
* fullscreen
* opengl
* openglblit
* resizable
* noframe
*
*/
cons_t* set_video_mode(cons_t* p, environment_t*)
{
assert_length_min(p, 2);
assert_type(INTEGER, car(p));
assert_type(INTEGER, cadr(p));
// dimension
int x = car(p)->integer;
int y = cadr(p)->integer;
// default values
int bits = 32;
uint32_t mode = 0;
///////////////////
raise(runtime_exception("Testing"));
///////////////////
// bits per pixel
if ( integerp(caddr(p)) )
bits = caddr(p)->integer;
// options
cons_t *opts = symbolp(caddr(p))? cddr(p) :
symbolp(cadddr(p))? cdddr(p) : nil();;
for ( cons_t *s = opts; !nullp(s); s = cdr(s) ) {
assert_type(SYMBOL, car(s));
std::string sym = symbol_name(s);
int size = sizeof(sdl_flags) / sizeof(key_value_t<std::string, uint32_t>);
for ( int n=0; n < size; ++n )
if ( sym == sdl_flags[n].key ) {
///////////////////
printf("flag %s\n", sym.c_str());
printf("value %d and %d\n", sdl_flags[n].value, SDL_HWSURFACE);
///////////////////
mode |= sdl_flags[n].value;
goto NEXT_FLAG;
}
raise(runtime_exception("Unknown SDL video mode flag: " + sym));
NEXT_FLAG:
continue;
}
mode = SDL_HWSURFACE;
///////////////////
printf("video mode\n"); fflush(stdout);
///////////////////
SDL_Surface *screen = SDL_SetVideoMode(x, y, bits, mode);
if ( screen == NULL )
raise(runtime_exception(SDL_GetError()));
return pointer(new pointer_t("sdl-surface", (void*)screen));
}
cons_t* proc_import(cons_t* p, environment_t* e)
{
assert_length_min(p, 1);
assert_type(PAIR, car(p));
/*
* Handle all import sets in (import <import set> ...)
*/
for ( ; !nullp(p); p = cdr(p) ) {
environment_t *impenv = import_set(car(p));
/*
* Now we need to bring the imported environment to the environment,
* so that the new definitions are available there.
*
* We do this by copying the definitions.
*/
merge(e, impenv);
/*
* But we also need to connect the lower level imported environment to
* definitions found in its outer environment.
*
* This is because the exported functions in impenv must be able to see
* definitions in the toplevel, controlling, environment.
*
* Consider the (mickey environment) module, which has a "syntactic"
* procedure bound?.
*
* If we (import (scheme write)) then we get the procedure display. But
* if we now (import (mickey environment)) and call (bound? display)
* then bound? will not be able to see any definition of display, and
* will wrongly return #f.
*
* Note that I'm not entirely certain that this is the correct way of
* handling things, since closures must be evaluated in the environment
* they were defined in.
*
* TODO: Think hard about this and write some tests.
*
* Note that this behaviour might be different for libraries that are
* imported as scheme source code. They must be first evaluated in
* their own closed environment (to bind definitions) before being
* connected to the outer one.
*
* I think what we need is a global pointer to the ACTUAL top-level
* environment.
*
*/
impenv->outer = e;
}
/*
* TODO: Should we return the final environment, so we can easily run
* cond-expand on it from outside define-library? E.g., (cond-expand
* (import (foo bar)))
*/
return unspecified(nil());
}
/*
* (set-video-mode <width> <height> <bits per pixel>?) or
* (set-video-mode <width> <height> <bits per pixel> <mode flags>+)
*
* where <symbols> are:
* swsurface
* hwsurface
* asyncblit
* anyformat
* hwpalette
* doublebuf
* fullscreen
* opengl
* openglblit
* resizable
* noframe
*
*/
cons_t* set_video_mode(cons_t* p, environment_t*)
{
assert_length_min(p, 2);
assert_type(INTEGER, car(p));
assert_type(INTEGER, cadr(p));
// dimension
int x = intval(car(p));
int y = intval(cadr(p));
// default values
int bits = 32;
uint32_t mode = 0;
// bits per pixel
if ( length(p) > 2 && integerp(caddr(p)) )
bits = intval(caddr(p));
// mode options
if ( length(p) > 3 ) {
cons_t *opts = symbolp(caddr(p))? cddr(p) :
symbolp(cadddr(p))? cdddr(p) : nil();;
DPRINT(opts);
for ( cons_t *s = opts; !nullp(s); s = cdr(s) ) {
assert_type(SYMBOL, car(s));
std::string sym = symbol_name(car(s));
for ( size_t n=0; n < num_sdl_flags; ++n )
if ( sym == sdl_flags[n].key ) {
mode |= sdl_flags[n].value;
goto NEXT_FLAG;
}
raise(runtime_exception("Unknown SDL video mode flag: " + sym));
NEXT_FLAG:
continue;
}
}
SDL_Surface *screen = SDL_SetVideoMode(x, y, bits, mode);
if ( screen == NULL )
raise(runtime_exception(SDL_GetError()));
return pointer(
new pointer_t("sdl-surface",
reinterpret_cast<void*>(screen)));
}
cons_t* proc_environment(cons_t* p, environment_t*)
{
assert_length_min(p, 1);
environment_t *out = null_environment(7);
// Handle import sets
for ( ; !nullp(p); p = cdr(p) ) {
environment_t *impenv = import_set(car(p));
merge(out, impenv);
impenv->outer = out;
}
return environment(out);
}
cons_t* proc_max(cons_t* p, environment_t*)
{
assert_length_min(p, 1);
cons_t *max = car(p);
while ( !nullp(p) ) {
assert_number(car(p));
if ( number_to_real(car(p)) > number_to_real(max) )
max = car(p);
p = cdr(p);
}
return max;
}
cons_t* proc_min(cons_t* p, environment_t*)
{
assert_length_min(p, 1);
cons_t *min = car(p);
while ( !nullp(p) ) {
assert_number(car(p));
if ( number_to_real(car(p)) < number_to_real(min) )
min = car(p);
p = cdr(p);
}
return min;
}
/*
* True if number sequence is monotonically decreasing.
*/
cons_t* proc_greater(cons_t* p, environment_t*)
{
assert_length_min(p, 2);
for ( ; !nullp(cdr(p)); p = cdr(p) ) {
if ( nanp(car(p)) || nanp(cadr(p)) )
return boolean(false);
assert_number(car(p));
assert_number(cadr(p));
real_t x = integerp(car(p))? car(p)->number.integer :
car(p)->number.real;
real_t y = integerp(cadr(p))? cadr(p)->number.integer :
cadr(p)->number.real;
if ( !(x > y) )
return boolean(false);
}
return boolean(true);
}
