SCM scgi_session_alter_var (const SCM name, const SCM new_value)
{
/* todo: remove gh_scm2newstr when Guile 1.8 is released */
char *n;
char *v = gh_scm2newstr (new_value, NULL);
int retval;
if (SCM_SYMBOLP(name))
{
n = gh_symbol2newstr (name, NULL);
}
else
{
n = gh_scm2newstr (name, NULL);
}
retval = cgi_session_alter_var (n, v);
free (n);
free (v);
if (retval)
{
return SCM_BOOL_T;
}
else
{
return SCM_BOOL_F;
}
}
/**
** Parse missile-type.
**
** @param list List describing missile.
*/
local SCM CclMissileType(SCM list)
{
SCM value;
int type;
// Slot
value=gh_car(list);
type=gh_scm2int(value);
if( type>=MissileTypeMax ) {
fprintf(stderr,"Wrong type %d\n",type);
return list;
}
list=gh_cdr(list);
DebugLevel3("MissileType: %d\n",type);
// Name
value=gh_car(list);
MissileTypes[type].Name=gh_scm2newstr(value,NULL);
list=gh_cdr(list);
// File
value=gh_car(list);
MissileTypes[type].File=gh_scm2newstr(value,NULL);
list=gh_cdr(list);
// Width,Height
value=gh_car(list);
MissileTypes[type].Width=gh_scm2int(value);
list=gh_cdr(list);
value=gh_car(list);
MissileTypes[type].Height=gh_scm2int(value);
list=gh_cdr(list);
// Sound impact
value=gh_car(list);
#ifdef WITH_SOUND
if (ccl_sound_p(value)) {
MissileTypes[type].ImpactSound.Sound=ccl_sound_id(value);
} else
#endif
if (!gh_boolean_p(value) || gh_scm2bool(value) ) {
fprintf(stderr,"Wrong argument in MissileType\n");
}
list=gh_cdr(list);
// FIXME: class, speed not written!!!
return list;
}
char *gh_symbol2newstr(repv sym, size_t *lenp)
{
if (!rep_SYMBOLP (sym))
return NULL;
return gh_scm2newstr (rep_SYM (sym)->name, lenp);
}
/**
** Parse unit-type.
**
** @param list List describing missile.
*/
local SCM CclUnitType(SCM list)
{
SCM value;
int type;
return list;
// Slot
value=gh_car(list);
type=gh_scm2int(value);
list=gh_cdr(list);
DebugLevel3("UnitType: %d\n",type);
// Name
value=gh_car(list);
UnitTypes[type].Name=gh_scm2newstr(value,NULL);
list=gh_cdr(list);
// Graphics
value=gh_car(list);
// FIXME: more ...
return list;
}
void
GridMapData::parse_from_file (SCM desc)
{
/* GridMaps will always get a one pixel boarder with the base
enviroment */
char* str = gh_scm2newstr(gh_car (desc), 0);
std::cout << "Loading from: " << str << std::endl;
std::string filename = str;
#ifndef WIN32
free (str);
#endif
provider = CL_PNGProvider (path_manager.complete("missions/" + filename));
provider.lock ();
//FIXME:Display2 assert (provider.is_indexed ());
grid_width = provider.get_width () + 2;
grid_height = provider.get_height () + 2;
grid_data.resize (grid_width * grid_height);
for (int i = 0; i < grid_height * grid_width; ++i)
grid_data[i] = GT_SAND; // FIXME: should be variable not hardcoded!
unsigned char* buffer = static_cast<unsigned char*>(provider.get_data ());
for (int y = 0; y < provider.get_height (); ++y)
for (int x = 0; x < provider.get_width (); ++x)
grid_data[(x + 1) + ((y+1) * grid_width)]
= static_cast<GroundType>(buffer[x + (provider.get_width () * y)]);
provider.unlock ();
}
/**
** Define race mapping from original number to internal symbol
**
** @param list List of all names.
*/
local SCM CclDefineRaceWcNames(SCM list)
{
int i;
char** cp;
if( (cp=RaceWcNames) ) { // Free all old names
while( *cp ) {
free(*cp++);
}
free(RaceWcNames);
}
//
// Get new table.
//
i=gh_length(list);
RaceWcNames=cp=malloc((i+1)*sizeof(char*));
while( i-- ) {
*cp++=gh_scm2newstr(gh_car(list),NULL);
list=gh_cdr(list);
}
*cp=NULL;
return SCM_UNSPECIFIED;
}
/*
* This gets called if scm_apply throws an error.
*
* We use gh_scm2newstr to convert from Guile string to Scheme string. The
* GH interface is deprecated, but doing it in scm takes more code. We'll
* convert later if we have to.
*/
static SCM
gnm_guile_catcher (void *data, SCM tag, SCM throw_args)
{
char const *header = _("Guile error");
SCM smob;
SCM func;
SCM res;
char *guilestr = NULL;
char *msg;
GnmValue *v;
func = scm_c_eval_string ("gnm:error->string");
if (scm_procedure_p (func)) {
res = scm_apply (func, tag,
scm_cons (throw_args, scm_listofnull));
if (scm_string_p (res))
guilestr = gh_scm2newstr (res, NULL);
}
if (guilestr != NULL) {
char *buf = g_strdup_printf ("%s: %s", header, guilestr);
free (guilestr);
v = value_new_error (NULL, buf);
g_free (buf);
} else {
v = value_new_error (NULL, header);
}
smob = make_new_smob (v);
value_release (v);
return smob;
}
/**
** Load a pud.
**
** @param file filename of pud.
**
** @return FIXME: Nothing.
*/
local SCM CclLoadPud(SCM file)
{
char* name;
name=gh_scm2newstr(file,NULL);
LoadPud(name,&TheMap);
free(name);
// FIXME: LoadPud should return an error
return SCM_UNSPECIFIED;
}
/**
** Define health sprite.
**
** @param file Spell graphic file.
** @param x Spell X position.
** @param y Spell Y position.
** @param w Spell width.
** @param h Spell height.
*/
global SCM CclSpellSprite(SCM file,SCM x,SCM y,SCM w,SCM h)
{
free(SpellSprite.File);
SpellSprite.File=gh_scm2newstr(file,NULL);
SpellSprite.HotX=gh_scm2int(x);
SpellSprite.HotY=gh_scm2int(y);
SpellSprite.Width=gh_scm2int(w);
SpellSprite.Height=gh_scm2int(h);
return SCM_UNSPECIFIED;
}
/**
** Define the used fonts.
**
** @param type Type of the font (game,small,...)
** @param file File name of the graphic file
** @param width Font width in pixels
** @param height Font height in pixels
**
** @todo make the font name functions more general, support more fonts.
*/
local SCM CclDefineFont(SCM type, SCM file, SCM width, SCM height)
{
int i;
i = CclFontByIdentifier(type);
free(Fonts[i].File);
VideoSaveFree(Fonts[i].Graphic);
Fonts[i].Graphic=NULL;
Fonts[i].File = gh_scm2newstr(file, NULL);
Fonts[i].Width = gh_scm2int(width);
Fonts[i].Height = gh_scm2int(height);
return SCM_UNSPECIFIED;
}
/**
** Default title-screen.
**
** @param title SCM title. (nil reports only)
**
** @return Current title screen.
*/
local SCM CclTitleScreen(SCM title)
{
if( !gh_null_p(title) ) {
if( TitleScreen ) {
free(TitleScreen);
TitleScreen=NULL;
}
TitleScreen=gh_scm2newstr(title,NULL);
} else {
title=gh_str02scm(TitleScreen);
}
return title;
}
SCM scgi_session_save_path (SCM path)
{
/* todo: remove gh_scm2newstr when Guile 1.8 is released */
char *p;
if (SCM_SYMBOLP(path))
{
p = gh_symbol2newstr (path, NULL);
}
else
{
p = gh_scm2newstr (path, NULL);
}
cgi_session_save_path (p);
free (p);
return SCM_UNSPECIFIED;
}
SCM scgi_session_cookie_name (SCM name)
{
/* todo: remove gh_scm2newstr when Guile 1.8 is released */
char *n;
if (SCM_SYMBOLP(name))
{
n = gh_symbol2newstr (name, NULL);
}
else
{
n = gh_scm2newstr (name, NULL);
}
cgi_session_cookie_name (n);
free (n);
return SCM_UNSPECIFIED;
}
SCM scgi_session_var (SCM name)
{
/* todo: remove gh_scm2newstr when Guile 1.8 is released */
char *n;
char *retval;
if (SCM_SYMBOLP(name))
{
n = gh_symbol2newstr (name, NULL);
}
else
{
n = gh_scm2newstr (name, NULL);
}
retval = cgi_session_var (n);
free (n);
return scm_makfrom0str (retval);
}
SCM
perform_test (SCM clazz_scm_name)
{
char *clazz_name, *test_name, *result_name, *msg;
const char *utf;
jclass clazz;
jmethodID mid;
jobject test_obj, result_obj, test_name_obj, result_name_obj, msg_obj;
jboolean is_copy;
SCM scm_test_name, scm_result_name, scm_result_msg;
clazz_name = gh_scm2newstr (clazz_scm_name, NULL);
clazz = (*env)->FindClass (env, clazz_name);
if (clazz == NULL)
{
SCM clazz_err = gh_str02scm (clazz_name);
free (clazz_name);
return abort_test (clazz_err, "Unable to find class");
}
mid = (*env)->GetMethodID (env, clazz, "<init>", "()V");
test_obj = (*env)->NewObject (env, clazz, mid);
if ((*env)->IsInstanceOf (env, test_obj, test_class) == JNI_FALSE)
{
SCM clazz_err = gh_str02scm (clazz_name);
free (clazz_name);
return abort_test (clazz_err, "Not an instanceof gnu.test.Test");
}
free (clazz_name);
/* Call all the Java testing methods */
test_name_obj = (*env)->CallObjectMethod (env, test_obj, test_name_mid);
result_obj = (*env)->CallObjectMethod (env, test_obj, test_mid);
/* Handle an exception if one occurred */
if ((*env)->ExceptionOccurred (env))
return handle_test_exception (test_name_obj);
result_name_obj = (*env)->CallObjectMethod (env, result_obj,
result_name_mid);
msg_obj = (*env)->CallObjectMethod (env, result_obj, result_msg_mid);
/* Grab all the C result messages */
utf = (*env)->GetStringUTFChars (env, test_name_obj, &is_copy);
test_name = strdup (utf);
(*env)->ReleaseStringUTFChars (env, test_name_obj, utf);
utf = (*env)->GetStringUTFChars (env, result_name_obj, &is_copy);
result_name = strdup (utf);
(*env)->ReleaseStringUTFChars (env, result_name_obj, utf);
utf = (*env)->GetStringUTFChars (env, msg_obj, &is_copy);
msg = strdup (utf);
(*env)->ReleaseStringUTFChars (env, msg_obj, utf);
/* Convert the C result messages to Scheme */
scm_test_name = gh_str02scm (test_name);
scm_result_name = gh_symbol2scm (result_name);
scm_result_msg = gh_str02scm (msg);
/* Free up the C result messages */
free (test_name);
free (result_name);
free (msg);
return gh_list (scm_test_name,
scm_result_name,
scm_result_msg,
SCM_UNDEFINED);
}
/* get confinement from SCM
* in SCM, confinement is given by one of these:
* for spherical confinement,
* (define confinement '(
* 10.0 ;; LJ parameter epsilon in kT (so this is dimensionless value)
* 1.0 ;; LJ parameter r0 in "length" (so this is dimensionless value)
* "sphere"
* 10.0 ;; radius of the cavity at (0, 0, 0)
* ))
* for spherical confinement with a hole,
* (define confinement '(
* 10.0 ;; LJ parameter epsilon in kT (so this is dimensionless value)
* 1.0 ;; LJ parameter r0 in "length" (so this is dimensionless value)
* "sphere+hole"
* 10.0 ;; radius of the cavity at (0, 0, 0)
* 1.0 ;; radius of the hole at (0, 0, 1) direction
* ))
* for cylindrical confinement,
* (define confinement '(
* 10.0 ;; LJ parameter epsilon in kT (so this is dimensionless value)
* 1.0 ;; LJ parameter r0 in "length" (so this is dimensionless value)
* "cylinder" ;; the cylinder center goes through (0, 0, 0) and (x, y, z).
* 10.0 ;; radius of the cylinder
* 1.0 0.0 0.0 ;; direction vector (x, y, z) of the cylinder
* ))
* for dumbbell confinement,
* (define confinement '(
* 10.0 ;; LJ parameter epsilon in kT (so this is dimensionless value)
* 1.0 ;; LJ parameter r0 in "length" (so this is dimensionless value)
* "dumbbell" ;; the origin is at the center of the cylinder
* 10.0 ;; left cavity radius centered at (center1, 0, 0)
* 10.0 ;; right cavity radius centered at (center2, 0, 0)
* 2.0 ;; length of the cylinder
* 1.0 ;; cylinder radius
* ))
* for 2D hexagonal confinement with cylinder pipe,
* (define confinement '(
* 10.0 ;; LJ parameter epsilon in kT (so this is dimensionless value)
* 1.0 ;; LJ parameter r0 in "length" (so this is dimensionless value)
* "hex2d"
* 10.0 ;; cavity radius
* 1.0 ;; cylinder radius
* 12.0 ;; lattice spacing
* ))
* for porous media (outside of the 3D hexagonal particle array)
* (define confinement '(
* 10.0 ;; LJ parameter epsilon in kT (so this is dimensionless value)
* 1.0 ;; LJ parameter r0 in "length" (so this is dimensionless value)
* "porous"
* 10.0 ;; particle radius
* 20.0 ;; lattice spacing in x (2R for touching case)
* ))
* INPUT
* var : name of the variable.
* in the above example, set "confinement".
* OUTPUT
* returned value : struct confinement
* if NULL is returned, it failed (not defined)
*/
struct confinement *
CF_guile_get (const char *var)
{
if (guile_check_symbol (var) == 0)
{
fprintf (stderr, "CF_guile_get: %s is not defined\n", var);
return (NULL);
}
SCM scm_symbol
= scm_c_lookup (var);
SCM scm_confinement
= scm_variable_ref (scm_symbol);
if (!SCM_NFALSEP (scm_list_p (scm_confinement)))
{
fprintf (stderr, "CF_guile_get: %s is not a list\n", var);
return (NULL);
}
struct confinement *cf = NULL;
unsigned long len
= scm_num2ulong (scm_length (scm_confinement),
0, "CF_guile_get");
if (len == 0)
{
// no confinement
return (cf);
}
else if (len < 4)
{
fprintf (stderr, "CF_guile_get: %s is too short\n", var);
return (NULL);
}
double epsilon
= scm_num2dbl (scm_list_ref (scm_confinement, scm_int2num (0)),
"CF_guile_get");
double r0
= scm_num2dbl (scm_list_ref (scm_confinement, scm_int2num (1)),
"CF_guile_get");
// get the string
char *str_cf = NULL;
SCM scm_conf = scm_list_ref (scm_confinement, scm_int2num (2));
#ifdef GUILE16
size_t str_len;
if (gh_string_p (scm_conf))
{
str_cf = gh_scm2newstr (scm_conf, &str_len);
}
#else // !GUILE16
if (scm_is_string (scm_conf))
{
str_cf = scm_to_locale_string (scm_conf);
}
#endif // GUILE16
if (strcmp (str_cf, "sphere") == 0)
{
if (len != 4)
{
fprintf (stderr, "CF_guile_get:"
" for sphere, number of parameter must be 1\n");
}
else
{
double R
= scm_num2dbl (scm_list_ref (scm_confinement, scm_int2num (3)),
"CF_guile_get");
cf = CF_init (0, // sphere
R,
0.0, // r
0.0, 0.0, 0.0, // x, y, z
0.0, // R2
0.0, // L
0, // flag_LJ
epsilon,
r0);
CHECK_MALLOC (cf, "CF_guile_get");
}
}
else if (strcmp (str_cf, "sphere+hole") == 0)
{
if (len != 5)
{
fprintf (stderr, "CF_guile_get:"
" for sphere+hole, number of parameter must be 2\n");
}
else
{
double R
= scm_num2dbl (scm_list_ref (scm_confinement, scm_int2num (3)),
"CF_guile_get");
double r
= scm_num2dbl (scm_list_ref (scm_confinement, scm_int2num (4)),
"CF_guile_get");
cf = CF_init (1, // sphere+hole
R,
r,
0.0, 0.0, 0.0, // x, y, z
0.0, // R2
0.0, // L
0, // flag_LJ
epsilon,
r0);
CHECK_MALLOC (cf, "CF_guile_get");
}
}
else if (strcmp (str_cf, "cylinder") == 0)
{
if (len != 7)
{
fprintf (stderr, "CF_guile_get:"
" for cylinder, number of parameter must be 4\n");
}
else
{
double r
= scm_num2dbl (scm_list_ref (scm_confinement, scm_int2num (3)),
"CF_guile_get");
double x
= scm_num2dbl (scm_list_ref (scm_confinement, scm_int2num (4)),
"CF_guile_get");
double y
= scm_num2dbl (scm_list_ref (scm_confinement, scm_int2num (5)),
"CF_guile_get");
double z
= scm_num2dbl (scm_list_ref (scm_confinement, scm_int2num (6)),
"CF_guile_get");
cf = CF_init (2, // cylinder
0.0, // R,
r,
x, y, z,
0.0, // R2
0.0, // L
0, // flag_LJ
epsilon,
r0);
CHECK_MALLOC (cf, "CF_guile_get");
}
}
else if (strcmp (str_cf, "dumbbell") == 0)
{
if (len != 7)
{
fprintf (stderr, "CF_guile_get:"
" for dumbbell, number of parameter must be 4\n");
}
else
{
double R
= scm_num2dbl (scm_list_ref (scm_confinement, scm_int2num (3)),
"CF_guile_get");
double R2
= scm_num2dbl (scm_list_ref (scm_confinement, scm_int2num (4)),
"CF_guile_get");
double L
= scm_num2dbl (scm_list_ref (scm_confinement, scm_int2num (5)),
"CF_guile_get");
double r
= scm_num2dbl (scm_list_ref (scm_confinement, scm_int2num (6)),
"CF_guile_get");
cf = CF_init (3, // dumbbell
R,
r,
0.0, 0.0, 0.0, // x, y, z
R2,
L,
0, // flag_LJ
epsilon,
r0);
CHECK_MALLOC (cf, "CF_guile_get");
}
}
else if (strcmp (str_cf, "hex2d") == 0)
{
if (len != 6)
{
fprintf (stderr, "CF_guile_get:"
" for hex2d, number of parameter must be 3\n");
}
else
{
double R
= scm_num2dbl (scm_list_ref (scm_confinement, scm_int2num (3)),
"CF_guile_get");
double r
= scm_num2dbl (scm_list_ref (scm_confinement, scm_int2num (4)),
"CF_guile_get");
double L
= scm_num2dbl (scm_list_ref (scm_confinement, scm_int2num (5)),
"CF_guile_get");
cf = CF_init (4, // hex2d
R,
r,
0.0, 0.0, 0.0, // x, y, z
0.0, // R2
L,
0, // flag_LJ
epsilon,
r0);
CHECK_MALLOC (cf, "CF_guile_get");
}
}
else if (strcmp (str_cf, "porous") == 0)
{
if (len != 5)
{
fprintf (stderr, "CF_guile_get:"
" for hex2d, number of parameter must be 2\n");
}
else
{
double R
= scm_num2dbl (scm_list_ref (scm_confinement, scm_int2num (3)),
"CF_guile_get");
double L
= scm_num2dbl (scm_list_ref (scm_confinement, scm_int2num (4)),
"CF_guile_get");
cf = CF_init (5, // porous
R,
0.0,
0.0, 0.0, 0.0, // x, y, z
0.0, // R2
L,
0, // flag_LJ
epsilon,
r0);
CHECK_MALLOC (cf, "CF_guile_get");
}
}
else
{
fprintf (stderr, "CF_guile_get: invalid confinement %s\n",
str_cf);
}
free (str_cf);
return (cf); // success
}
/**
** Parse the construction.
**
** @param list List describing the construction.
**
** @note make this more flexible
*/
local SCM CclDefineConstruction(SCM list)
{
SCM value;
SCM sublist;
char* str;
Construction* construction;
Construction** cop;
int i;
// Slot identifier
str=gh_scm2newstr(gh_car(list),NULL);
list=gh_cdr(list);
for( i=0; ConstructionWcNames[i]; ++i ) {
if( !strcmp(ConstructionWcNames[i],str) ) {
break;
}
}
if( !ConstructionWcNames[i] ) {
DebugLevel0Fn("Construction not found.\n");
free(str);
return SCM_UNSPECIFIED;
}
if( (cop=Constructions)==NULL ) {
Constructions=malloc(2*sizeof(Construction*));
Constructions[0]=calloc(1,sizeof(Construction));
Constructions[1]=NULL;
construction=Constructions[0];
} else {
for( i=0; *cop; ++i,++cop ) {
}
Constructions=realloc(Constructions,(i+2)*sizeof(Construction*));
Constructions[i]=calloc(1,sizeof(Construction));
Constructions[i+1]=NULL;
construction=Constructions[i];
}
construction->OType=ConstructionType;
construction->Ident=str;
//
// Parse the arguments, in tagged format.
//
while( !gh_null_p(list) ) {
value=gh_car(list);
list=gh_cdr(list);
if( gh_eq_p(value,gh_symbol2scm("files")) ) {
sublist=gh_car(list);
//
// Parse the tilesets
//
while( !gh_null_p(sublist) ) {
str=gh_scm2newstr(gh_car(sublist),NULL);
// FIXME: use a general get tileset function here!
i=0;
if( strcmp(str,"default") ) {
for( ; i<NumTilesets; ++i ) {
if( !strcmp(str,Tilesets[i]->Ident) ) {
break;
}
if( !strcmp(str,Tilesets[i]->Class) ) {
break;
}
}
if( i==NumTilesets ) {
fprintf(stderr,"Tileset `%s' not available\n",str);
errl("tileset not available",gh_car(sublist));
}
}
sublist=gh_cdr(sublist);
free(str);
free(construction->File[i]);
construction->File[i]=gh_scm2newstr(gh_car(sublist),NULL);
sublist=gh_cdr(sublist);
}
} else if( gh_eq_p(value,gh_symbol2scm("size")) ) {
value=gh_car(list);
construction->Width=gh_scm2int(gh_car(value));
value=gh_cdr(value);
construction->Height=gh_scm2int(gh_car(value));
} else if( gh_eq_p(value,gh_symbol2scm("shadow")) ) {
sublist=gh_car(list);
while( !gh_null_p(sublist) ) {
value=gh_car(sublist);
sublist=gh_cdr(sublist);
if( gh_eq_p(value,gh_symbol2scm("file")) ) {
construction->ShadowFile=gh_scm2newstr(gh_car(sublist),NULL);
} else if( gh_eq_p(value,gh_symbol2scm("width")) ) {
construction->ShadowWidth=gh_scm2int(gh_car(sublist));
} else if( gh_eq_p(value,gh_symbol2scm("height")) ) {
construction->ShadowHeight=gh_scm2int(gh_car(sublist));
} else {
errl("Unsupported shadow tag",value);
}
sublist=gh_cdr(sublist);
}
} else {
// FIXME: this leaves a half initialized construction
errl("Unsupported tag",value);
}
list=gh_cdr(list);
}
return SCM_UNSPECIFIED;
}
/**
** Parse the player configuration.
**
** @param list Tagged list of all informations.
*/
local SCM CclPlayer(SCM list)
{
SCM value;
SCM sublist;
Player* player;
int i;
char* str;
i=gh_scm2int(gh_car(list));
player=&Players[i];
if( NumPlayers<=i ) {
NumPlayers=i+1;
}
player->Player = i;
player->Color=PlayerColors[i];
if( !(player->Units=(Unit**)calloc(UnitMax,sizeof(Unit*))) ) {
DebugLevel0("Not enough memory to create player %d.\n" _C_ i);
return SCM_UNSPECIFIED;
}
list=gh_cdr(list);
//
// Parse the list: (still everything could be changed!)
//
while( !gh_null_p(list) ) {
value=gh_car(list);
list=gh_cdr(list);
if( gh_eq_p(value,gh_symbol2scm("name")) ) {
player->Name=gh_scm2newstr(gh_car(list),NULL);
list=gh_cdr(list);
} else if( gh_eq_p(value,gh_symbol2scm("type")) ) {
value=gh_car(list);
list=gh_cdr(list);
if( gh_eq_p(value,gh_symbol2scm("neutral")) ) {
player->Type=PlayerNeutral;
} else if( gh_eq_p(value,gh_symbol2scm("nobody")) ) {
player->Type=PlayerNobody;
} else if( gh_eq_p(value,gh_symbol2scm("computer")) ) {
player->Type=PlayerComputer;
} else if( gh_eq_p(value,gh_symbol2scm("person")) ) {
player->Type=PlayerPerson;
} else if( gh_eq_p(value,gh_symbol2scm("rescue-passive")) ) {
player->Type=PlayerRescuePassive;
} else if( gh_eq_p(value,gh_symbol2scm("rescue-active")) ) {
player->Type=PlayerRescueActive;
} else {
// FIXME: this leaves a half initialized player
errl("Unsupported tag",value);
}
} else if( gh_eq_p(value,gh_symbol2scm("race")) ) {
str=gh_scm2newstr(gh_car(list),NULL);
if( RaceWcNames ) {
for( i=0; RaceWcNames[i]; ++i ) {
if( !strcmp(str,RaceWcNames[i]) ) {
player->RaceName=RaceWcNames[i];
player->Race=i;
break;
}
}
}
free(str);
if( !RaceWcNames || !RaceWcNames[i] ) {
// FIXME: this leaves a half initialized player
errl("Unsupported tag",gh_car(list));
}
#if 0
player->RaceName=str=gh_scm2newstr(gh_car(list),NULL);
if( !strcmp(str,"human") ) {
player->Race=PlayerRaceHuman;
} else if( !strcmp(str,"orc") ) {
player->Race=PlayerRaceOrc;
} else if( !strcmp(str,"neutral") ) {
player->Race=PlayerRaceNeutral;
} else {
// FIXME: this leaves a half initialized player
errl("Unsupported tag",gh_car(list));
}
#endif
list=gh_cdr(list);
} else if( gh_eq_p(value,gh_symbol2scm("ai")) ) {
player->AiNum=gh_scm2int(gh_car(list));
list=gh_cdr(list);
} else if( gh_eq_p(value,gh_symbol2scm("team")) ) {
player->Team=gh_scm2int(gh_car(list));
list=gh_cdr(list);
} else if( gh_eq_p(value,gh_symbol2scm("enemy")) ) {
str=gh_scm2newstr(gh_car(list),NULL);
list=gh_cdr(list);
for( i=0; i<PlayerMax && *str; ++i,++str ) {
if( *str=='-' || *str=='_' || *str==' ' ) {
player->Enemy&=~(1<<i);
} else {
player->Enemy|=(1<<i);
}
}
} else if( gh_eq_p(value,gh_symbol2scm("allied")) ) {
str=gh_scm2newstr(gh_car(list),NULL);
list=gh_cdr(list);
for( i=0; i<PlayerMax && *str; ++i,++str ) {
if( *str=='-' || *str=='_' || *str==' ' ) {
player->Allied&=~(1<<i);
} else {
player->Allied|=(1<<i);
}
}
} else if( gh_eq_p(value,gh_symbol2scm("shared-vision")) ) {
str=gh_scm2newstr(gh_car(list),NULL);
list=gh_cdr(list);
for( i=0; i<PlayerMax && *str; ++i,++str ) {
if( *str=='-' || *str=='_' || *str==' ' ) {
player->SharedVision&=~(1<<i);
} else {
player->SharedVision|=(1<<i);
}
}
} else if( gh_eq_p(value,gh_symbol2scm("start")) ) {
value=gh_car(list);
list=gh_cdr(list);
player->StartX=gh_scm2int(gh_car(value));
player->StartY=gh_scm2int(gh_cadr(value));
} else if( gh_eq_p(value,gh_symbol2scm("resources")) ) {
sublist=gh_car(list);
list=gh_cdr(list);
while( !gh_null_p(sublist) ) {
value=gh_car(sublist);
sublist=gh_cdr(sublist);
for( i=0; i<MaxCosts; ++i ) {
if( gh_eq_p(value,gh_symbol2scm((char*)DefaultResourceNames[i])) ) {
player->Resources[i]=gh_scm2int(gh_car(sublist));
break;
}
}
if( i==MaxCosts ) {
// FIXME: this leaves a half initialized player
errl("Unsupported tag",value);
}
sublist=gh_cdr(sublist);
}
} else if( gh_eq_p(value,gh_symbol2scm("incomes")) ) {
sublist=gh_car(list);
list=gh_cdr(list);
while( !gh_null_p(sublist) ) {
value=gh_car(sublist);
sublist=gh_cdr(sublist);
for( i=0; i<MaxCosts; ++i ) {
if( gh_eq_p(value,gh_symbol2scm((char*)DefaultResourceNames[i])) ) {
player->Incomes[i]=gh_scm2int(gh_car(sublist));
break;
}
}
if( i==MaxCosts ) {
// FIXME: this leaves a half initialized player
errl("Unsupported tag",value);
}
sublist=gh_cdr(sublist);
}
} else if( gh_eq_p(value,gh_symbol2scm("ai-enabled")) ) {
player->AiEnabled=1;
} else if( gh_eq_p(value,gh_symbol2scm("ai-disabled")) ) {
player->AiEnabled=0;
} else if( gh_eq_p(value,gh_symbol2scm("food")) ) {
player->Food=gh_scm2int(gh_car(list));
list=gh_cdr(list);
} else if( gh_eq_p(value,gh_symbol2scm("food-unit-limit")) ) {
player->FoodUnitLimit=gh_scm2int(gh_car(list));
list=gh_cdr(list);
} else if( gh_eq_p(value,gh_symbol2scm("building-limit")) ) {
player->BuildingLimit=gh_scm2int(gh_car(list));
list=gh_cdr(list);
} else if( gh_eq_p(value,gh_symbol2scm("total-unit-limit")) ) {
player->TotalUnitLimit=gh_scm2int(gh_car(list));
list=gh_cdr(list);
} else if( gh_eq_p(value,gh_symbol2scm("score")) ) {
player->Score=gh_scm2int(gh_car(list));
list=gh_cdr(list);
} else if( gh_eq_p(value,gh_symbol2scm("total-units")) ) {
player->TotalUnits=gh_scm2int(gh_car(list));
list=gh_cdr(list);
} else if( gh_eq_p(value,gh_symbol2scm("total-buildings")) ) {
player->TotalBuildings=gh_scm2int(gh_car(list));
list=gh_cdr(list);
} else if( gh_eq_p(value,gh_symbol2scm("total-razings")) ) {
player->TotalRazings=gh_scm2int(gh_car(list));
list=gh_cdr(list);
} else if( gh_eq_p(value,gh_symbol2scm("total-kills")) ) {
player->TotalKills=gh_scm2int(gh_car(list));
list=gh_cdr(list);
} else if( gh_eq_p(value,gh_symbol2scm("total-resources")) ) {
sublist=gh_car(list);
list=gh_cdr(list);
i=gh_length(sublist);
if( i!=MaxCosts ) {
fprintf(stderr,"Wrong number of total-resources %d\n",i);
}
i=0;
while( !gh_null_p(sublist) ) {
if( i<MaxCosts ) {
player->TotalResources[i]=gh_scm2int(gh_car(sublist));
}
sublist=gh_cdr(sublist);
++i;
}
player->TotalUnits=gh_scm2int(gh_car(list));
} else if( gh_eq_p(value,gh_symbol2scm("timers")) ) {
sublist=gh_car(list);
list=gh_cdr(list);
i=gh_length(sublist);
if( i!=UpgradeMax ) {
fprintf(stderr,"Wrong upgrade timer length %d\n",i);
}
i=0;
while( !gh_null_p(sublist) ) {
if( i<UpgradeMax ) {
player->UpgradeTimers.Upgrades[i]=
gh_scm2int(gh_car(sublist));
}
sublist=gh_cdr(sublist);
++i;
}
} else {
// FIXME: this leaves a half initialized player
errl("Unsupported tag",value);
}
}
return SCM_UNSPECIFIED;
}
/* same as in Guile 1.8 */
char* scm_to_locale_stringn (SCM str, size_t* lenp) {
if SCM_UNBNDP(str) return NULL;
return gh_scm2newstr(str, lenp);
}
