InputAxis* 
AxisFactory::create(SCM lst)
{
  while(gh_pair_p(lst))
    {
      SCM sym  = gh_car(lst);
      SCM data = gh_cdr(lst);
      
      if (gh_equal_p(sym, gh_symbol2scm("joystick-axis")))
        {
          return create_joystick_axis(data);
        }
      if (gh_equal_p(sym, gh_symbol2scm("button-axis")))
        {
          return create_button_axis(data);
        }
      else
        {
          throw FeuerkraftError("AxisFactory::create: parse error");
        }

      lst = gh_cdr(lst);
    }
  return 0;
}
Esempio n. 2
0
/**
**	Font symbol to id.
**
**	@param type	Type of the font (game,small,...)
**
**	@return		Integer as font identifier.
*/
global int CclFontByIdentifier(SCM type)
{
    if (gh_eq_p(type, gh_symbol2scm("game"))) {
	return GameFont;
    } else if (gh_eq_p(type, gh_symbol2scm("small"))) {
	return SmallFont;
    } else if (gh_eq_p(type, gh_symbol2scm("large"))) {
	return LargeFont;
    } else if (gh_eq_p(type, gh_symbol2scm("small-title"))) {
	return SmallTitleFont;
    } else if (gh_eq_p(type, gh_symbol2scm("large-title"))) {
	return LargeTitleFont;
    } else if (gh_eq_p(type, gh_symbol2scm("user1"))) {
	return User1Font;
    } else if (gh_eq_p(type, gh_symbol2scm("user2"))) {
	return User2Font;
    } else if (gh_eq_p(type, gh_symbol2scm("user3"))) {
	return User3Font;
    } else if (gh_eq_p(type, gh_symbol2scm("user4"))) {
	return User4Font;
    } else if (gh_eq_p(type, gh_symbol2scm("user5"))) {
	return User5Font;
    } else {
	errl("Unsupported font tag", type);
    }
    return 0;
}
GridMapData::GridMapData (SCM desc)
{
  grid_width  = -1;
  grid_height = -1;
  
  while (!gh_null_p (desc))
    {
      SCM symbol = gh_caar(desc);
      SCM data   = gh_cdar(desc);

      if (gh_equal_p (gh_symbol2scm ("file"), symbol))
        {
          parse_from_file (data);
        }
      else
        {
          std::cout << "GridMapData: Unknown data type: '" << std::flush;
          gh_display (symbol);
          std::cout << "' with data: " << std::flush;
          gh_display (data);
          std::cout << std::endl;
          return;
        }

      desc = gh_cdr (desc);
    }
}
Esempio n. 4
0
SCM
abort_test (SCM name, char *exception)
{
  (*env)->ExceptionClear (env);
  return gh_list (name,
		  gh_symbol2scm ("ERROR"), 
		  gh_str02scm (exception),
		  SCM_UNDEFINED);
}
Esempio n. 5
0
/**
**	Mix music to stereo 32 bit.
**
**	@param buffer	Buffer for mixed samples.
**	@param size	Number of samples that fits into buffer.
**
**	@todo this functions can be called from inside the SDL audio callback,
**		which is bad, the buffer should be precalculated.
*/
local void MixMusicToStereo32(int* buffer, int size)
{
    int i;
    int n;
    int len;
    short* buf;

    if (PlayingMusic) {
	DebugCheck(!MusicSample && !MusicSample->Type);

	// FIXME: if samples are shared this fails
	if (MusicSample->Channels == 2) {
	    len = size * sizeof(*buf);
	    buf = alloca(len);
	    n = MusicSample->Type->Read(MusicSample, buf, len);

	    for (i = 0; i < n / (int)sizeof(*buf); ++i) {
		// Add to our samples
		buffer[i] += (buf[i] * MusicVolume) / 256;
	    }
	} else {
	    len = size * sizeof(*buf) / 2;
	    buf = alloca(len);
	    n = MusicSample->Type->Read(MusicSample, buf, len);

	    for (i = 0; i < n / (int)sizeof(*buf); ++i) {
		// Add to our samples
		buffer[i * 2 + 0] += (buf[i] * MusicVolume) / 256;
		buffer[i * 2 + 1] += (buf[i] * MusicVolume) / 256;
	    }
	}

	if (n != len) {			// End reached
	    SCM cb;

	    PlayingMusic = 0;
	    SoundFree(MusicSample);
	    MusicSample = NULL;

	    // FIXME: we are inside the SDL callback!
	    if (CallbackMusic) {
		cb = gh_symbol2scm("music-stopped");
		if (!gh_null_p(symbol_boundp(cb, NIL))) {
		    SCM value;

		    value = symbol_value(cb, NIL);
		    if (!gh_null_p(value)) {
			gh_apply(value, NIL);
		    }
		}
	    }
	}
    }
}
Esempio n. 6
0
/**
**	Change the diplomacy from player to another player.
**
**	@param player	Player to change diplomacy.
**	@param opponent	Player number to change.
**	@param state	To which state this should be changed.
**
**	@return		FIXME: should return old state.
**
**	@todo FIXME: should return old state.
*/
local SCM CclSetDiplomacy(SCM player,SCM state,SCM opponent)
{
    int plynr;

#if 0
    Player* base;

    base=CclGetPlayer(player);
    plynr=gh_scm2int(opponent);

    if( gh_eq_p(state,gh_symbol2scm("allied")) ) {
	base->Enemy&=~(1<<plynr);
	base->Allied|=1<<plynr;
    } else if( gh_eq_p(state,gh_symbol2scm("neutral")) ) {
	base->Enemy&=~(1<<plynr);
	base->Allied&=~(1<<plynr);
    } else if( gh_eq_p(state,gh_symbol2scm("crazy")) ) {
	base->Enemy|=1<<plynr;
	base->Allied|=1<<plynr;
    } else if( gh_eq_p(state,gh_symbol2scm("enemy")) ) {
	base->Enemy|=1<<plynr;
	base->Allied&=~(1<<plynr);
    }

#else
    int base;

    base=gh_scm2int(player);
    plynr=gh_scm2int(opponent);

    // FIXME: must send over network!!

    if( gh_eq_p(state,gh_symbol2scm("allied")) ) {
	SendCommandDiplomacy(base,DiplomacyAllied,plynr);
    } else if( gh_eq_p(state,gh_symbol2scm("neutral")) ) {
	SendCommandDiplomacy(base,DiplomacyNeutral,plynr);
    } else if( gh_eq_p(state,gh_symbol2scm("crazy")) ) {
	SendCommandDiplomacy(base,DiplomacyCrazy,plynr);
    } else if( gh_eq_p(state,gh_symbol2scm("enemy")) ) {
	SendCommandDiplomacy(base,DiplomacyEnemy,plynr);
    }

#endif

    // FIXME: we can return the old state
    return SCM_UNSPECIFIED;
}
Esempio n. 7
0
/**
**	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;
}
Esempio n. 8
0
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);
}
Esempio n. 9
0
/**
**	Parse a clone map.
**
**	@param list	list of tuples keyword data
*/
local SCM CclCloneMap(SCM list)
{
    SCM value;
    SCM name;
    SCM data;

    //
    //	Parse the list:	(still everything could be changed!)
    //
    while( !gh_null_p(list) ) {

	value=gh_car(list);
	//gh_display(value);
	//gh_newline();
	if( gh_list_p(value) ) {
	    name=gh_car(value);
	    data=gh_cdr(value);
	    if( !gh_symbol_p(name) ) {
		fprintf(stderr,"symbol expected\n");
		return list;
	    }
	    if( gh_eq_p(name,gh_symbol2scm("version")) ) {
		DebugLevel1("VERSION:\n");
		gh_display(data);
		gh_newline();
		// FIXME:
	    } else if( gh_eq_p(name,gh_symbol2scm("description")) ) {
		DebugLevel1("DESCRIPTION:\n");
		gh_display(data);
		gh_newline();
		// FIXME:
	    } else if( gh_eq_p(name,gh_symbol2scm("terrain")) ) {
		int terrain;

		DebugLevel1("TERRAIN:\n");
		gh_display(data);
		gh_newline();
		value=gh_car(data);
		data=gh_cdr(data);
		terrain=gh_scm2int(value);
		TheMap.Terrain=terrain;
		// FIXME:
	    } else if( gh_eq_p(name,gh_symbol2scm("dimension")) ) {
		int width;
		int height;

		DebugLevel1("DIMENSION:\n");
		gh_display(data);
		gh_newline();
		value=gh_car(data);
		width=gh_scm2int(value);
		data=gh_cdr(data);
		value=gh_car(data);
		height=gh_scm2int(value);
		TheMap.Width=width;
		TheMap.Height=height;

		TheMap.Fields=calloc(width*height,sizeof(*TheMap.Fields));
		InitUnitCache();

	    } else if( gh_eq_p(name,gh_symbol2scm("tiles")) ) {
		int i;
		int l;

		DebugLevel1("TILES:\n");
		value=gh_car(data);
		if( !gh_vector_p(value) ) {
		    fprintf(stderr,"vector expected\n");
		    return SCM_UNSPECIFIED;
		}
		l=gh_vector_length(value);
		if( l!=TheMap.Width*TheMap.Height ) {
		    fprintf(stderr,"Wrong tile table length %d\n",l);
		}
		for( i=0; i<l; ++i ) {
		    TheMap.Fields[i].Tile=
			    Tilesets[TilesetSummer].Table[
				gh_scm2int(gh_vector_ref(value,gh_int2scm(i)))
			    ];
		}
	    } else {
		;
	    }
	} else {
	    fprintf(stderr,"list expected\n");
	    return list;
	}

	list=gh_cdr(list);
    }

    return list;
}
Esempio n. 10
0
/**
**	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;
}