static li_object *eval_quasiquote(li_object *exp, li_object *env) {
li_object *head, *iter, *tail;
if (!li_is_pair(exp))
return exp;
else if (li_is_unquoted(exp))
return li_eval(li_cadr(exp), env);
else if (li_is_unquoted_splicing(li_car(exp))) {
head = tail = li_null;
for (iter = li_eval(li_cadar(exp), env); iter; iter = li_cdr(iter)) {
if (head)
tail = li_set_cdr(tail, li_cons(li_car(iter), li_null));
else
head = tail = li_cons(li_car(iter), li_null);
}
if (tail) {
li_set_cdr(tail, eval_quasiquote(li_cdr(exp), env));
return head;
} else {
return eval_quasiquote(li_cdr(exp), env);
}
}
return li_cons(eval_quasiquote(li_car(exp), env),
eval_quasiquote(li_cdr(exp), env));
}
li_object *g1_get_tile_textures(li_object * o, li_environment * env)
{
//li_object *fmt=li_eval(li_car(o,env),env);
//char buf[200];
for (o=li_cdr(o,env); o; o=li_cdr(o,env)) // skip path at start
{
char * name;
if (li_car(o,env)->type()==LI_STRING)
{
name=li_string::get(li_eval(li_car(o,env),env),env)->value();
}
else
{
name=li_string::get(li_eval(li_car(li_car(o,env),env),env),env)->value();
}
// The format is unused and must not be stored with the texture names,
// since location and extension of the textures is handled by the loader, not
// the texture handler.
//sprintf(buf, li_string::get(fmt,env)->value(), name);
I4_ASSERT(name!=0,"Error: Invalid texture name found");
g1_current_tnames->add(new i4_str(name));
li_set_value("texture_object_list",new li_list(li_car(o,env),li_get_value("texture_object_list",env)),env);
g1_current_t_tiles++;
}
return 0;
}
li_object *g1_defaults(li_object * i, li_environment * env)
{
while (i)
{
g1_object_defaults_struct * d=g1_obj_defaults.add();
li_object * o=li_car(i,env);
strcpy(d->object_name, li_get_string(li_symbol::get(li_car(o,env),env)->name(),env));
o=li_cdr(o,env);
d->speed=li_get_float(li_car(o,env),env);
o=li_cdr(o,env);
d->turn_speed=li_get_float(li_car(o,env),env);
o=li_cdr(o,env);
d->accel=li_get_float(li_car(o,env),env);
o=li_cdr(o,env);
d->cost=li_get_int(li_car(o,env),env);
o=li_cdr(o,env);
d->health=li_get_int(li_car(o,env),env);
o=li_cdr(o,env);
d->fire_delay=li_get_int(li_car(o,env),env);
o=li_cdr(o,env);
d->detection_range=li_get_float(li_car(o,env),env);
o=li_cdr(o,env);
d->fire_type=li_symbol::get(li_car(o,env),env);
o=li_cdr(o,env);
i=li_cdr(i,env);
}
return 0;
}
li_object *g1_get_movable_object_textures(li_object * o, li_environment * env)
{
//li_object *fmt=li_get_value("object_format", env);
li_set_value("def_movable_object_list",new li_list(o,li_get_value("def_movable_object_list",env)),env);
for (li_object * p=li_cdr(o,env); p; p=li_cdr(p,env))
{
li_symbol * sym=li_symbol::get(li_car(li_car(p,env),env),env);
if (sym==li_get_symbol("model_name",s_model_name))
{
g1_add_to_list(*g1_current_model_names, li_car(li_cdr(li_car(p,env),env),env));
}
else if (sym==li_get_symbol("mini_object",s_mini_object))
{
li_object * s=li_cdr(li_car(p,env),env); // s = ("gunport_barrel")
for (; s; s=li_cdr(s,env))
{
if (li_symbol::get(li_car(li_car(s,env),env),env)==
li_get_symbol("model_name", s_model_name))
{
g1_add_to_list(*g1_current_model_names, li_car(li_cdr(li_car(s,env),env),env));
}
}
}
}
return 0;
}
static li_object *play_demo(li_object * o, li_environment * env)
{
if (o)
{
current_demo_num=li_get_int(li_car(o,env),env);
}
char demo_name[200];
sprintf(demo_name, "demos/demo%02d.level", current_demo_num);
i4_file_status_struct fstat;
if (!i4_get_status(demo_name,fstat))
{
return 0;
}
li_call("Hide_Main_Menu");
g1_cwin_man->destroy_views();
m1_maxtool_man->destroy_views();
//i4_file_open_message_class opm(G1_SAVEGAME_LOAD_OK, new i4_str(demo_name));
//i4_current_app->receive_event(&opm);
if (g1_load_level(demo_name)) //there's actually little that could have
//failed till here. (except corrupt data)
{
//if (loading_window.get())
//i4_kernel.delete_handler(loading_window.get());
i4_loader_class * lfp=i4_open_save_file(i4_open(demo_name));
if (lfp)
{
w32 off, size;
g1_cwin_man->create_views();
/*if (g1_map_is_loaded() && g1_get_map()->start_movie())
{
playing_movie=i4_T;
g1_resources.paused=i4_F;
if (g1_current_controller.get())
g1_current_controller->view.suggest_camera_mode(G1_CAMERA_MODE);
}*/
if (lfp->get_section_info("inputs", off, size))
{
g1_human->playback_start(new i4_sub_section_file(i4_open(demo_name), off, size));
}
if (lfp->get_section_info("script", off, size))
{
i4_file_class * fp=new i4_sub_section_file(i4_open(demo_name), off,size);
li_load(fp);
delete fp;
}
delete lfp;
}
}
return 0;
}
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_get_building_textures(li_object * o, li_environment * env)
{
//li_object *fmt=li_get_value("building_format", env);
li_set_value("def_buildings_list",new li_list(o,li_get_value("def_buildings_list",env)),env);
for (; o; o=li_cdr(o,env))
{
li_object * obj=li_car(o,env);
if (obj->type()!=LI_STRING) //may be a list of (name flags)
{
obj=li_car(obj,env);
}
g1_add_to_list(*g1_current_model_names, obj);
}
return 0;
}
bool g1_tile_man_class::add_new(li_object * o, li_environment * env)
{
li_object * prop=0;
li_string * tname=0;
if (o->type()==LI_STRING)
{
tname=li_string::get(o,env);
}
else
{
prop=li_cdr(o,env);
tname=li_string::get(li_car(o,env),env);
}
r1_texture_manager_class * tman=g1_render.r_api->get_tmanager();
i4_const_str i4_tname=i4_const_str(tname->value());
w32 curr_checksum=i4_str_checksum(i4_tname);
i4_bool found=false;
for (int i=0; i<array.size(); i++)
{
//must not add a tile twice
//and also not a tile which has already been added using an alternate checksum.
if (array[i].filename_checksum==curr_checksum)
{
found=true;
break;
}
w32 c=get_original_checksum(array[i].filename_checksum);
if (c!=0 && curr_checksum==c)
{
found=true;
break;
}
}
if (!found)
{
g1_tile_class * newtile=array.add();
newtile->init();
newtile->texture=tman->register_texture(i4_tname, i4_tname);
newtile->filename_checksum=curr_checksum;
newtile->get_properties(prop, env);
if (newtile->flags & g1_tile_class::SELECTABLE)
{
newtile->selection_order=select_remap.size()-1;
select_remap.add(array.size()-1); //last entry of array is new
}
sorted_by_checksum=0;
return true;
}
return false;
}
li_object *g1_add_stank_weapons(li_object * i, li_environment * env)
{
while (i)
{
li_object * o=li_car(i,env);
g1_stank_ammo_type_struct * a=g1_stank_ammo_types.add();
a->weapon_type=li_symbol::get(li_car(o,env),env);
o=li_cdr(o,env);
a->max_amount=li_get_int(li_eval(li_car(o,env),env),env);
o=li_cdr(o,env);
a->refuel_delay=li_get_int(li_eval(li_car(o,env),env),env);
o=li_cdr(o,env);
a->fire_delay=li_get_int(li_eval(li_car(o,env),env),env);
o=li_cdr(o,env);
char name[100];
sprintf(name,"bitmaps/stank/frame_%s.tga", li_get_string(li_car(o,env),env));
a->icon=i4_load_image(name); //what the heck? i4_const_str() sometimes fails.
sprintf(name,"bitmaps/stank/dark_%s.tga", li_get_string(li_car(o,env), env));
a->dark_icon=i4_load_image(name);
i=li_cdr(i,env);
}
return 0;
}
static li_object *expand_macro(li_object *mac, li_object *args) {
li_object *env, *ret, *seq;
ret = li_null;
env = extend_environment(li_to_macro(mac).vars, args, li_to_macro(mac).env);
for (seq = li_to_macro(mac).body; seq; seq = li_cdr(seq))
ret = li_eval(li_car(seq), env);
return ret;
}
void g1_demo_tick()
{
if (wait_camera)
{
g1_object_class * c=g1_player_man.get_local()->get_commander();
if (!c)
{
wait_camera=0;
}
else if ((c->x-wait_camera->x)*(c->x-wait_camera->x)+
(c->y-wait_camera->y)*(c->y-wait_camera->y)+
(c->h-wait_camera->h)*(c->h-wait_camera->h) < camera_dist*camera_dist)
{
wait_camera=0;
}
}
else if (wait_ticks)
{
wait_ticks--;
}
else
{
li_object * script_start=demo_script.get();
li_object * script=script_start;
while (!wait_camera && !wait_ticks && script)
{
li_object * o=li_car(script, 0);
if (o->type()==LI_INT)
{
wait_ticks=li_get_int(o, 0);
}
else
{
li_eval(o);
}
if (script_start!=demo_script.get())
{
// we loaded another script
script=0;
}
if (script)
{
script=li_cdr(script, 0);
}
}
if (script_start==demo_script.get())
{
demo_script=script;
}
}
}
static li_object *list_of_values(li_object *exps, li_object *env) {
li_object *head, *node, *tail;
head = li_null;
while (exps) {
tail = li_cons(li_eval(li_car(exps), env), li_null);
node = head ? li_set_cdr(node, tail) : (head = tail);
exps = li_cdr(exps);
}
return head;
}
li_object *g1_set_level_vars(li_object * o, li_environment * env)
{
if (o==0)
{
return 0;
}
g1_map_vars.var_ptr=li_car(o, env);
g1_get_map()->mark_for_recalc(G1_MAP_VARS);
g1_get_map()->recalc_static_stuff();
return 0;
}
li_object *g1_get_model_names(li_object * o, li_environment * env)
{
//li_object *fmt=li_eval(li_car(o,env),env);
for (o=li_cdr(o,env); o; o=li_cdr(o,env))
{
// skip path at start
g1_add_to_list(*g1_current_model_names, li_car(o,env));
}
return 0;
}
li_object *g1_sky_textures(li_object * o, li_environment * env)
{
//li_object *fmt=li_eval(li_car(o,env),env);
//char buf[200], name1[200], name2[200];
//call the global function (used to build the list of skys.)
//This is defined in golg__sky.cpp
g1_def_skys(o,env);
for (o=li_cdr(o,env); o; o=li_cdr(o,env)) // skip path at start
{
char * name;
if (li_car(o,env)->type()==LI_STRING)
{
name=li_string::get(li_eval(li_car(o,env),env),env)->value();
}
else
{
name=li_string::get(li_eval(li_car(li_car(o,env),env),env),env)->value();
}
//sprintf(buf, li_string::get(fmt,env)->value(), name);
//sprintf(name1, "%s1", buf);
//sprintf(name2, "%s2", buf);
g1_current_tnames->add(new i4_str(name));
//g1_current_tnames->add(new i4_str(name1));
//g1_current_tnames->add(new i4_str(name2));
li_set_value("texture_object_list",new li_list(li_car(o,env),li_get_value("texture_object_list",env)),env);
g1_current_t_tiles+=1;
}
return 0;
}
bool g1_tile_man_class::add(li_object * o, li_environment * env)
{
//if (t_tiles==max_tiles)
// i4_error("WARNING: Too many tile textures in level.");
li_object * prop=0;
li_string * tname=0;
if (o->type()==LI_STRING)
{
tname=li_string::get(o,env);
}
else
{
prop=li_cdr(o,env);
tname=li_string::get(li_car(o,env),env);
}
r1_texture_manager_class * tman=g1_render.r_api->get_tmanager();
i4_const_str i4_tname=i4_const_str(tname->value());
w32 curr_checksum=i4_str_checksum(i4_tname);
i4_bool found=false;
for (int i=0; i<array.size(); i++)
{
if (array[i].filename_checksum==curr_checksum)
{
found=true;
break;
}
}
if (!found)
{
g1_tile_class * newtile=array.add();
newtile->init();
newtile->texture=tman->register_texture(i4_tname, i4_tname);
newtile->filename_checksum=curr_checksum;
newtile->get_properties(prop, env);
sorted_by_checksum=0;
return true;
}
return false;
}
extern li_object *li_apply(li_object *proc, li_object *args) {
li_object *head, *tail, *obj;
if (li_is_primitive_procedure(proc))
return li_to_primitive_procedure(proc)(args);
head = li_null;
while (args) {
obj = li_car(args);
if (!li_is_self_evaluating(obj))
obj = li_cons(li_symbol("quote"), li_cons(obj, li_null));
if (head)
tail = li_set_cdr(tail, li_cons(obj, li_null));
else
head = tail = li_cons(obj, li_null);
args = li_cdr(args);
}
return li_eval(li_cons(proc, head), li_to_lambda(proc).env);
}
static li_object *p_bytevector_append(li_object *args)
{
li_bytevector_t *to, *from;
li_object *iter = args;
int i = 0;
while (iter) {
li_parse_args(iter, "B.", &to, &iter);
i += li_bytevector_length(to);
}
to = li_make_bytevector(i, 0);
for (i = 0, iter = args; iter; iter = li_cdr(iter)) {
int j, n;
from = (li_bytevector_t *)li_car(iter);
n = li_bytevector_length(from);
for (j = 0; j < n; ++i, ++j)
li_bytevector_set(to, i, li_bytevector_get(from, j));
}
return (li_object *)to;
}
li_object *g1_set_default_level(li_object * o, li_environment * env)
{
strcpy(first_level, li_get_string(li_eval(li_car(o,env),env),env));
return 0;
}
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;
}
i4_bool g1_factory_class::build(int type)
{
li_class_context context(vars);
g1_path_object_class * startp=get_start();
if (startp)
{
// is this a object type we can build?
int found=0;
for (li_object * blist=can_build(); !found && blist; blist=li_cdr(blist,0))
{
li_object * val=li_get_value(li_symbol::get(li_car(blist,0),0));
li_int * anint=li_int::get(val,0);
if (anint&&anint->value()==type)
{
found=1;
}
}
if (!found)
{
return 0;
}
int cost=g1_object_type_array[type]->defaults->cost;
if (cost<=g1_player_man.get(player_num)->money() && !deploy_que.full())
{
if (player_num==g1_player_man.local_player)
{
sfx_built.play();
}
g1_player_man.get(player_num)->money()-=cost;
g1_build_item item;
item.type=type;
g1_path_object_class * list[400];
if (startp)
{
int t=startp->find_path(g1_player_man.get(player_num)->get_team(), list, 400);
item.path=(g1_id_ref *)I4_MALLOC(sizeof(g1_id_ref) *(t+1), "");
for (int i=0; i<t; i++)
{
item.path[i]=list[i];
}
item.path[t].id=0;
}
else
{
item.path=0;
}
deploy_que.que(item);
request_think();
return i4_T;
}
}
return i4_F;
}
// 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);
}
}
w32 g1_human_class::show_selection(g1_object_controller_class * for_who,
i4_transform_class &transform,
g1_draw_context_class * context)
{
if (!selected_object.valid() || selected_object->id!=g1_get_object_type("convoy"))
{
return 0;
}
g1_convoy_class * c=(g1_convoy_class *) selected_object.get();
li_class_context ctx(c->vars);
int i;
w32 j;
int nums=units()->size();
g1_screen_box * b=0,* thisbb=0;
//doesn't work because i4_array cannot correctly handle the garbage collector
//i4_array<li_object *> special_commands(10,10);
li_object * lians=0,* liobj;
li_symbol * lisym;
char * cmdname;
special_command_entry * sce=0;
//we should probably optimize this if nums and/or selectables is big.
if (nums<1)
{
return 0;
}
g1_object_class * o=0;
for (i=0; i<nums; i++)
{
o=units()->value(i);
if (!o)
{
continue;
}
b=for_who->selectable_list.recent;
//I4_ASSERT(o,"ERROR: Selected list contains non-object.");
//for(j=0;j<for_who->selectable_list.t_recent;j++)
// {
// if (for_who->selectable_list.recent->object_id
// }
thisbb=0;
for (j=0; j<for_who->selectable_list.t_recent; j++,b++)
{
if (b->object_id==o->global_id)
{
thisbb=b;
break;
}
}
//if (!thisbb)
// continue;
if (thisbb)
{
g1_render.draw_outline(thisbb,o);
}
w32 commands_flags=o->get_selection_flags();
if ((o->player_num==team()) ||
(commands_flags&g1_object_class::SEL_ENEMYCANSENDCMD))
{
lians=new li_list(o->message(commands_ask.get(),0,0),lians);
}
//special_commands.add(lians);
}
//The list has the following format (I suppose?!?)
//((command-a1,command-a2,command-a3),(command-b1,command-b2),...,0);
if (nums==1)
{
//the easy case: only one unit selected
//lians=special_commands[0];
lians=li_car(lians,0); //first element of first entry
liobj=li_car(lians,0);
i4_float butx,buty,butz;
//butx=(thisbb->x1+thisbb->x2)/2;
//buty=(thisbb->y1+thisbb->y2)/2;
//butx=thisbb->x1+10;
//buty=thisbb->y2+10;
butx=10;
buty=2*g1_render.center_y-30;
if (thisbb)
{
butz=thisbb->z1;
}
else
{
butz=r1_near_clip_z;
}
while(liobj!=0)
{
lisym=li_symbol::get(liobj,0);
cmdname=lisym->name()->value();
draw_button_model(cmdname,butx,buty,butz,o);
lians=li_cdr(lians,0);
liobj=li_car(lians,0);
//The format of the list is a bit strange because it is concatenated
if (liobj&&liobj->type()!=LI_SYMBOL)
{
lians=liobj;
liobj=li_car(lians,0);
}
butx+=50;
}
}
//special_commands.uninit();
return nums;
}
static li_object *set_game_hz(li_object * o, li_environment * env)
{
G1_HZ=li_get_int(li_car(o,env),env);
return 0;
}