/**********************************************************************
This file is part of Crack dot Com's free source code release of
Golgotha.
for
information about compiling & licensing issues visit this URL
If that doesn't help, contact Jonathan Clark at
golgotha_source@usa.net (Subject should have "GOLG" in it)
***********************************************************************/
#include "main/main.hh"
#include "lisp/lisp.hh"
#include "file/file.hh"
#include "lisp/li_types.hh"
#include "lisp/li_class.hh"
#include "loaders/dir_load.hh"
#include "loaders/dir_save.hh"
#include "lisp/li_init.hh"
#include "lisp/li_load.hh"
static li_type_edit_class *li_class_editor=0;
void li_set_class_editor(li_type_edit_class *editor)
{
li_class_editor=editor;
}
////////////////////////////// li_class_type members ///////////////////////////////////////////////
li_class *li_this;
class li_class_type : public li_type_function_table
{
public:
struct var
{
li_object *default_value;
li_object *property_list;
li_symbol *sym;
int original_order;
void init()
{
sym=0;
default_value=0;
property_list=0;
original_order=0;
}
};
static int var_compare(const var *a, const var *b);
i4_fixed_array vars;
int old_tvars;
sw16 *value_remap; // used during loading of a li_class
li_class_type *derived_from;
li_symbol *sym;
var *get_var(li_symbol *sym);
int type;
static li_class_type *get(li_type_function_table *o, li_environment *env)
{
li_class_type *c=(li_class_type *)o;
#ifdef LI_TYPE_CHECK
if (c!=li_get_type(c->type))
li_error(env, "function table does not point to a class");
#endif
return c;
}
li_object *create(li_object *params, li_environment *env);
void mark(int set);
void mark(li_object *o, int set);
void free(li_object *o);
void print(li_object *o, i4_file_class *stream);
char *name();
li_class_type(li_symbol *sym, li_class_type *derived_from)
: sym(sym), derived_from(derived_from)
{
value_remap=0;
}
int get_var_offset(li_symbol *sym, int die_on_error)
{
w32 r=vars.size();
if (!r) return 0;
int l=0,m;
li_symbol *s1,*s2;
while (lname()->value();
else
return "anonymous-class";
}
void li_class_type::mark(int set)
{
for (int i=0; iis_marked()!=set)
li_get_type(vars[i].default_value->unmarked_type())->mark(vars[i].default_value, set);
if (vars[i].property_list)
if (vars[i].property_list->is_marked()!=set)
li_get_type(vars[i].property_list->unmarked_type())->mark(vars[i].property_list, set);
}
}
void li_class::mark(int set)
{
if (!set)
li_object::mark(set);
li_class_type *t=get_type();
for (int i=0; ivars.size(); i++)
{
int type=t->vars[i].default_value->unmarked_type();
li_object *o=object_value(i);
// int's and floats are stored directly and don't need marking
if (type!=LI_INT && type!=LI_FLOAT && o->is_marked()!=set)
li_get_type(o->unmarked_type())->mark(o, set);
}
if (set)
li_object::mark(set);
}
li_class_type::var *li_class_type::get_var(li_symbol *sym)
{
for (int i=0; iget_var(sym);
return 0;
}
void li_class_type::mark(li_object *o, int set)
{
((li_class *)o)->mark(set);
}
void li_class_type::free(li_object *o)
{
li_class::get(o,0)->free();
}
void li_class_type::print(li_object *o, i4_file_class *stream)
{
li_class::get(o,0)->print(stream);
}
li_object *li_class_type::create(li_object *params, li_environment *env)
{
return new li_class(type, params, env);
}
// these load and save type information
void li_class_type::save(i4_saver_class *fp, li_environment *env)
{
fp->write_32(vars.size());
for (int i=0; iread_32();
if (old_tvars)
{
value_remap=(sw16 *)i4_malloc(sizeof(sw16) * old_tvars, "");
for (int j=0; jvars.size();
for (int i=0; ivars[i].default_value;
li_object *v=value(i);
if (li_get_type(def->type())->equal(def, v))
li_save_object(fp, 0, env);
else
li_save_object(fp, value(i), env);
}
}
// load & save type instance information
void li_class_type::save_object(i4_saver_class *fp, li_object *o, li_environment *env)
{
li_class::get(o,env)->save(fp, env);
}
void li_class::load(i4_loader_class *fp, li_type_number *type_remap, li_environment *env)
{
li_class_type *ct=get_type();
int old_tvars=ct->old_tvars;
sw16 *value_remap=ct->value_remap;
for (int i=0; ivars[remap].default_value;
// if type has changed use default value
if ( (def && o) && o->type()==def->type())
set_value(remap, o);
}
}
}
li_object *li_class_type::load_object(i4_loader_class *fp, li_type_number *type_remap,
li_environment *env)
{
li_class *c=new li_class(type);
c->load(fp, type_remap, env);
return c;
}
//////////////////////////////////// li_class members /////////////////////////////////
li_class::li_class(li_type_number class_type,
li_object *params,
li_environment *env)
: li_object(class_type)
{
li_class_type *ct=get_type();
int t_vars=ct->vars.size();
values=(void **)i4_malloc(sizeof(void *) * t_vars, "");
int i;
for (i=0; ivars[i].default_value);
i=0;
while (params)
{
li_object *val=li_eval(li_car(params,env));
for (int j=0; jvars[j].original_order==i)
{
set_value(j, val);
j=t_vars;
}
params=li_cdr(params,env);
i++;
}
}
void li_class::print(i4_file_class *fp)
{
fp->write("#inst-",6);
li_class_type *c=get_type();
char *name=c->name();
fp->write(name,strlen(name));
fp->write_8('<');
for (int i=0; ivars.size(); i++)
{
li_symbol *sym=c->vars[i].sym;
fp->write(" (",2);
li_get_type(LI_SYMBOL)->print(sym, fp);
fp->write_8(' ');
li_object *v=value(i);
li_get_type(v->type())->print(v, fp);
fp->write_8(')');
}
fp->write_8('>');
}
void li_class::free()
{
i4_free(values);
}
int li_class::member_offset(char *sym) const
{
return get_type()->get_var_offset(li_get_symbol(sym), 0);
}
int li_class::member_offset(li_symbol *sym) const
{
return get_type()->get_var_offset(sym, 0);
}
int li_class::get_offset(li_class_member &c, li_type_number _type) const
{
li_class_type *ct=get_type();
if (!c.sym)
c.sym=li_get_symbol(c.name);
c.class_type=type();
c.offset=ct->get_var_offset(c.sym, 1);
if (c.offset==-1)
li_error(0, "class %s does not have a member %s", ct->name(), c.name);
#ifdef LI_TYPE_CHECK
if (ct->vars[c.offset].default_value->type()!=_type)
li_error(0, "class member %O is wrong type (%s should be %s)",
c.sym,
li_get_type(_type)->name(),
li_get_type(ct->vars[c.offset].default_value->type())->name());
#endif
return c.offset;
}
int li_class::get_offset(li_class_member &c) const
{
li_class_type *ct=get_type();
if (!c.sym)
c.sym=li_get_symbol(c.name);
c.class_type=type();
c.offset=ct->get_var_offset(c.sym, 0);
return c.offset;
}
#ifdef LI_TYPE_CHECK
li_class *li_class::get(li_object *o, li_environment *env)
{
check_type(o, ((li_class_type *)li_get_type(o->type()))->type, env);
return ((li_class *)o);
}
#endif
li_object *li_class::value(int member)
{
switch (get_type()->vars[member].default_value->type())
{
case LI_INT : return new li_int(int_value(member)); break;
case LI_FLOAT : return new li_float(float_value(member)); break;
default : return object_value(member); break;
}
}
li_object *li_class::value(char *member_name)
{
return value(member_offset(member_name));
}
void li_class::set_value(int member, li_object *value)
{
li_class_type *ct=get_type();
li_object *def_value=ct->vars[member].default_value;
int t=def_value->type();
switch (t)
{
case LI_INT : int_value(member) = li_int::get(value,0)->value(); break;
case LI_FLOAT : float_value(member) = li_float::get(value,0)->value(); break;
default : object_value(member)=value;
}
}
///////////////////////////////////// li_def_class ///////////////////////////////////////////
li_object *li_def_class(li_object *fields, li_environment *env)
{
li_symbol *sym=li_symbol::get(li_car(fields,env),env); fields=li_cdr(fields,env);
li_object *derived=li_eval(li_car(fields,env), env); fields=li_cdr(fields,env);
li_class_type *d=0;
int derived_type=0;
if (derived!=li_nil)
{
derived_type=li_type::get(derived,env)->value();
if (derived_type)
{
d=(li_class_type *)li_get_type(derived_type);
if (d->type!=derived_type)
li_error(env, "cannot derive a class from %O, only other classes", derived);
}
else li_error(env, "no such type %O", derived);
}
li_class_type *me=new li_class_type(sym, d);
li_object *c;
int t_vars=0;
// how many variables in the parent class
if (derived_type)
t_vars+=li_class_total_members(derived_type);
for (c=fields; c; c=li_cdr(c,env)) // count how many variables were added
t_vars++;
me->vars.resize(t_vars);
t_vars=0;
if (derived_type)
{
int t_from_derived_class=li_class_total_members(derived_type);
for (int i=0; ivars[t_vars].init();
me->vars[t_vars].original_order=t_vars;
li_symbol *s=li_class_get_symbol(derived_type, i);
me->vars[t_vars].sym=s;
me->vars[t_vars].default_value=li_class_get_default(derived_type, s);
me->vars[t_vars].property_list=li_class_get_property_list(derived_type, s);
t_vars++;
}
}
for (c=fields; c; c=li_cdr(c,env))
{
li_object *var=li_car(c,env);
me->vars[t_vars].init();
me->vars[t_vars].original_order=t_vars;
me->vars[t_vars].sym=li_symbol::get(li_car(var,env),env); var=li_cdr(var,env);
if (var)
{
me->vars[t_vars].default_value=li_eval(li_car(var,env), env); var=li_cdr(var,env);
li_symbol *s=me->vars[t_vars].sym;
li_object *d=me->vars[t_vars].default_value;
if (var)
me->vars[t_vars].property_list=li_eval(li_car(var,env), env);
}
t_vars++;
}
me->vars.sort(li_class_type::var_compare);
me->editor=li_class_editor;
me->type=li_add_type(me);
return new li_type(me->type);
}
li_object *li_class::set(char *member_name, li_object *value) // slow, but easy way to access data
{
int off=member_offset(member_name);
if (off==-1)
li_error(0, "class %o does not have member %s", member_name);
set_value(off, value);
return value;
}
int li_class_type::var_compare(const var *a, const var *b)
{
if (a->symsym)
return -1;
else if (a->sym>b->sym)
return 1;
else return 0;
}
int li_class_total_members(li_type_number type)
{
return li_class_type::get(li_get_type(type),0)->vars.size();
}
li_symbol *li_class_get_symbol(li_type_number type, int member_number)
{
li_class_type *ct=li_class_type::get(li_get_type(type),0);
return ct->vars[member_number].sym;
}
li_object *li_class_get_default(li_type_number type, li_symbol *sym)
{
li_class_type *ct=li_class_type::get(li_get_type(type),0);
return ct->vars[ct->get_var_offset(sym, 1)].default_value;
}
li_object *li_class_get_property_list(li_type_number type, li_symbol *sym)
{
li_class_type *ct=li_class_type::get(li_get_type(type),0);
return ct->vars[ct->get_var_offset(sym, 1)].property_list;
}
li_object *li_setm(li_object *o, li_environment *env)
{
li_class *c=li_class::get(li_first(o,0),0);
li_symbol *member=li_symbol::get(li_second(o,0),0);
li_object *value=li_eval(li_third(o,0), env);
c->set_value(c->member_offset(member), value);
return value;
}
li_object *li_getm(li_object *o, li_environment *env)
{
li_class *c=li_class::get(o,0);
return c->value(c->member_offset(li_symbol::get(li_first(o,0),0)));
}
li_automatic_add_function(li_def_class, "def_class");
li_automatic_add_function(li_setm, "setm");
li_automatic_add_function(li_getm, "getm");