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 *wait_near(li_object * o, li_environment * env)
{
wait_camera=g1_find_named_camera(li_get_string(li_eval(li_first(o,env),env),env));
camera_dist=(float)li_get_float(li_eval(li_second(o,env), env),env);
return 0;
}
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;
}
void golgotha_app::choice_first_level()
{
for (int i=1; i<(int)argc; i++)
{
if (argv[i]=="-f")
{
i4_os_string(*(argv+i+1), first_level, 80);
i++;
}
else if (argv[i]==i4_const_str("-edit"))
{
start_in_editor=1;
}
else if (argv[i]=="-eval")
{
i++;
char buf[1000];
i4_os_string(argv[i], buf, 1000);
char * s=buf;
li_eval(li_get_expression(s,0), 0);
}
else if (argv[i]=="-frame_lock")
{
frame_locked_mode=1;
}
}
}
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 *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_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;
}
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);
}
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;
}
