extern li_object *li_eval(li_object *exp, li_object *env) {
li_object *seq, *proc, *args;
int done;
done = 0;
while (!li_is_self_evaluating(exp) && !done) {
li_stack_trace_push(exp);
if (li_is_symbol(exp)) {
exp = li_environment_lookup(env, exp);
done = 1;
} else if (li_is_quoted(exp)) {
check_special_form(li_cdr(exp) && !li_cddr(exp), exp);
exp = li_cadr(exp);
done = 1;
} else if (li_is_quasiquoted(exp)) {
check_special_form(li_cdr(exp) && !li_cddr(exp), exp);
exp = eval_quasiquote(li_cadr(exp), env);
done = 1;
} else if (li_is_application(exp)) {
proc = li_eval(li_car(exp), env);
args = li_cdr(exp);
if (li_is_procedure(proc))
args = list_of_values(args, env);
if (li_is_lambda(proc)) {
env = extend_environment(li_to_lambda(proc).vars, args,
li_to_lambda(proc).env);
for (seq = li_to_lambda(proc).body; seq && li_cdr(seq);
seq = li_cdr(seq))
li_eval(li_car(seq), env);
exp = li_car(seq);
} else if (li_is_macro(proc)) {
exp = expand_macro(proc, args);
} else if (li_is_primitive_procedure(proc)) {
exp = li_to_primitive_procedure(proc)(args);
done = 1;
} else if (li_is_special_form(proc)) {
exp = li_to_special_form(proc)(args, env);
} else {
li_error("not applicable", proc);
}
} else {
li_error("unknown expression type", exp);
}
li_stack_trace_pop();
}
return exp;
}
static li_object *extend_environment(li_object *vars, li_object *vals,
li_object *env)
{
for (env = li_environment(env); vars;
vars = li_cdr(vars), vals = li_cdr(vals)) {
if (li_is_symbol(vars)) {
li_append_variable(vars, vals, env);
return env;
}
if (!vals)
break;
li_append_variable(li_car(vars), li_car(vals), env);
}
if (vars || vals)
li_error("wrong number of args", vars);
return env;
}
li_object *g1_def_weapon_damage(li_object * i, li_environment * env)
{
while (i)
{
li_object * o=li_car(i,env), * c;
g1_damage_map_struct * a=g1_damage_maps.add();
a->object_for=li_symbol::get(li_car(o,env),env);
o=li_cdr(o,env);
li_symbol * htype=li_symbol::get(li_car(o,env),env);
if (htype==li_sing.get())
{
a->hurt_type=g1_damage_map_struct::HURT_SINGLE_GUY;
}
else if (htype==li_mult.get())
{
a->hurt_type=g1_damage_map_struct::DO_AREA_OF_EFFECT;
}
else
{
li_error(env, "USER: Unknown hurt type %O, should be sing or mult", o);
}
o=li_cdr(o,env);
a->default_damage=li_get_int(li_car(o,env),env);
o=li_cdr(o,env);
a->special_damage=li_get_int(li_car(o,env),env);
o=li_cdr(o,env);
a->speed=li_get_float(li_car(o,env),env);
o=li_cdr(o,env);
a->range=li_get_float(li_car(o,env),env);
o=li_cdr(o,env);
// count how many exceptions follow
for (a->t_maps=0, c=o; c; c=li_cdr(c,env), a->t_maps++)
{
;
}
if (a->t_maps)
{
a->maps=(g1_damage_map_struct::map *)I4_MALLOC(a->t_maps *
sizeof(g1_damage_map_struct::map),"");
int i=0;
for (; o; o=li_cdr(o,env))
{
a->maps[i].object_type=li_symbol::get(li_car(li_car(o,env),env),env);
a->maps[i].damage=li_get_int(li_car(li_cdr(li_car(o,env),env),env),env);
i++;
}
}
else
{
a->maps=0;
}
i=li_cdr(i,env);
}
return 0;
}
// format of ("texture_name" (property_name prop_value)..)
void g1_tile_class::get_properties(li_object * properties, li_environment * env)
{
while (properties)
{
li_symbol * sym=li_symbol::get(li_car(li_car(properties,env),env),env);
li_object * temp=li_cdr(li_car(properties,env),env);
if (!temp)
{
li_error(env,"USER: Missing texture property argument");
}
li_object * value=li_car(temp,env);
if (sym==li_get_symbol("block", g1_block))
{
if (li_get_bool(value,env))
{
flags|=BLOCKING;
}
else
{
flags&=~BLOCKING;
}
}
else if (sym==li_get_symbol("wave", g1_wave))
{
if (li_get_bool(value,env))
{
flags|=WAVE;
}
else
{
flags&=~WAVE;
}
}
else if (sym==li_get_symbol("selectable", g1_selectable))
{
//By default, this property is true.
if (li_get_bool(value, env))
{
flags|=SELECTABLE;
}
else
{
flags&=~SELECTABLE;
}
}
else if (sym==li_get_symbol("friction", g1_friction))
{
set_friction((float)(li_float::get(value,env)->value()));
}
else if (sym==li_get_symbol("damage", g1_damage))
{
damage = li_int::get(value,env)->value();
}
else if (sym==li_get_symbol("save_name", g1_save_name))
{
w32 newkey=i4_str_checksum(i4_const_str(li_string::get(value,env)->value()));
//must fake the insertion of a pointer
g1_tile_man.store_alternate_checksum(newkey,filename_checksum);
filename_checksum=newkey;
}
else if (sym==li_get_symbol("alternate_checksum", g1_alternate_checksum))
{
w32 newkey=li_int::get(value,env)->value();
if (newkey!=0 && newkey!=filename_checksum)
{
g1_tile_man.store_alternate_checksum(newkey,filename_checksum);
filename_checksum=newkey;
}
}
else if (sym==li_get_symbol("flags"))
{
//Used internally for flag saving
flags=li_int::get(value,env)->value();
}
else
{
i4_error("bad texture flag '%s' should be block, wave, selectable, friction, save_name, alternate_checksum or flags",
sym->name()->value());
}
properties=li_cdr(properties,env);
}
}
