/* Game modules for Xconq.
   Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1998 Stanley T. Shebs.

Xconq is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.  See the file COPYING.  */

#include "conq.h"

extern char *readerrbuf;

static void do_one_variant PARAMS ((Module *module, struct a_variant *var, Obj *varsetdata));

/* List of all known modules. Their descriptions can co-exist in memory,
   even if their contents cannot. */

Module *modulelist;

/* The main module defining the game in effect. */

Module *mainmodule;

char *moduledesigbuf = NULL;

/* Empty out the list of modules. */

void
clear_game_modules()
{
    modulelist = mainmodule = NULL;
}

/* Create a brand-new game module. */

Module *
create_game_module(name)
char *name;
{
    Module *module = (Module *) xmalloc(sizeof(Module));

    /* Fill in nonzero slots. */
    /* The module's name must never be NULL. */
    if (name == NULL)
      name = "";
    module->name = name;
    module->instructions = lispnil;
    module->notes = lispnil;
    module->designnotes = lispnil;
    module->startlineno = 1;
    module->endlineno = 1;
    /* Add to front of module list. */
    module->next = modulelist;
    modulelist = module;
    return module;
}

Module *
find_game_module(name)
char *name;
{
    Module *module;

    if (name != NULL) {
	for_all_modules(module) {
	    if (module->name && strcmp(name, module->name) == 0)
	      return module;
	}
    }
    return NULL;
}


/* Produce a module of the given name, either by finding it or creating it. */

Module *
get_game_module(name)
char *name;
{
    Module *module = find_game_module(name);

    if (module != NULL)
      return module;
    return create_game_module(name);
}

/* Make a game module for the given name and maybe bolt it into the include
   list of another module. */

Module *
add_game_module(name, includer)
char *name;
Module *includer;
{
    Module *module = get_game_module(name), *other;

    if (includer) {
	/* Add to the end of the list of include files. */
	if (includer->include == NULL) {
	    includer->include = includer->lastinclude = module;
	} else {
	    for (other = includer->include; other != NULL; other = other->nextinclude) {
		/* already here, just return it. */
		if (module == other)
		  return module;
	    }
	    includer->lastinclude->nextinclude = module;
	    includer->lastinclude = module;
	}
    } else {
	/* an error? */
    }
    return module;
}

/* Sometimes we find ourselves lacking a game to provide meaning and
   context for interpretation; this routine loads the standard game
   (or a specified alternative default) immediately, but only makes
   it the main module if none defined. */

void
load_default_game()
{
    extern char *standard_game_name;
    char *defaultname = standard_game_name;
    Module *module, *module2;

    /* If we have a different default module, use it instead. */
    if (mainmodule != NULL
	&& !empty_string(mainmodule->defaultbasemodulename)) {
    	defaultname = mainmodule->defaultbasemodulename;
    }
    module = get_game_module(defaultname);
    if (mainmodule == NULL)
      mainmodule = module;
    load_game_description(module);
    /* Recurse one level of default base module. */
    /* (should recurse indefinitely, or not?) */
    if (!empty_string(module->defaultbasemodulename)) {
	module2 = get_game_module(module->defaultbasemodulename);
	load_game_module(module2, TRUE);
    }
    load_game_module(module, TRUE);
}

/* Attempt to read just the first form in a module and use it as a
   description of the module.  Return true if this worked, false
   otherwise. */

int
load_game_description(module)
Module *module;
{
    Obj *form, *thecar;
    char *name;

    if (open_module(module, FALSE)) {
	if ((form = read_form(module->fp,
			      &(module->startlineno),
			      &(module->endlineno)))
	    != lispeof) {
	    if (consp(form) && symbolp(thecar = car(form))) {
		name = c_string(thecar);
		if (keyword_code(name) == K_GAME_MODULE) {
		    interp_game_module(form, module);
		    close_module(module);
		    /* Note that module is still not considered "loaded". */
		    return TRUE;
		}
	    }
	}
    }
    return FALSE;
}

/* Game files can live in library directories or somewhere else.  This
   function tries to find a file, open it, and load the contents. */

void
load_game_module(module, dowarn)
Module *module;
int dowarn;
{
    char ch;

    if (open_module(module, dowarn)) {
	if (module->fp) {
	    /* Peek at the first character - was 'X' in old format files. */
	    ch = getc(module->fp);
	    ungetc(ch, module->fp);
	    if (ch == 'X') {
		init_error("\"%s\" is probably an obsolete Xconq file; in any case, it cannot be used.",
			   module->filename);
	    } else {
		/* New format, read it all. */
		read_forms(module);
	    }
	} else {
	    /* (should be able to read from contents string) */
	}
	/* We're done, can close. */
	close_module(module);
	/* Mark the module as having been loaded - note that this will happen
	   even if there were horrible errors. */
	module->loaded = TRUE;
	/* If the turn number has been set explicitly to a positive value,
	   assume that a saved game is being restored into the middle of the turn. */
	if (g_turn() > 0)
	  midturnrestore = TRUE;
	/* If the random state has been set explicitly to a nonnegative value,
	   use it to reseed the generator. */
	if (g_random_state() >= 0)
	  init_xrandom(g_random_state());
	/* Make all the cross-references right. */
	patch_object_references();
	/* Are all the types staked down now? */
	if (!canaddutype && !canaddmtype && !canaddttype && !canaddatype) {
	    typesdefined = TRUE;
	    /* (should also record this as a sort of base module?) */
	}
    }
}

void
load_base_module(module)
Module *module;
{
    char *basename = module->basemodulename;
    Module *basemodule;

    if (!empty_string(basename)) {
	basemodule = find_game_module(basename);
	if (basemodule == NULL)
	  basemodule = add_game_module(basename, module);
	if (basemodule->loaded) {    
	    Dprintf("Base module `%s' already loaded.\n", basename);
	} else {
	    Dprintf("Loading base module `%s' ...\n", basename);
	    load_game_module(basemodule, FALSE);
	    Dprintf("... Done loading `%s'.\n", basename);
	}
    }
}

/* Given a module, attempt to open it. */

int
open_module(module, dowarn)
Module *module;
int dowarn;
{
    FILE *fp = NULL;

    /* Don't open more than once. */
    if (module->open && dowarn) {
	init_warning("Module \"%s\" is already open, ignoring attempt to reopen",
		     module->name);
	return FALSE;
    }
    /* Don't open if already loaded. */
    if (module->loaded && dowarn) {
	init_warning("Module \"%s\" is already loaded, ignoring attempt to reload",
		     module->name);
	return FALSE;
    }
    if (module->contents) {
	/* Uninterpreted contents already available, init the ptr. */
	module->sp = module->contents;
	Dprintf("Reading module \"%s\" from string ...\n", module->name);
    } else if ((fp = open_module_library_file(module)) != NULL) {
	/* Found the module in a library directory. */
	Dprintf("Reading module \"%s\" from library file \"%s\" ...\n",
		module->name, module->filename);
	module->fp = fp;
    } else if ((fp = open_module_explicit_file(module)) != NULL) {
	Dprintf("Reading module \"%s\" from file \"%s\" ...\n",
		module->name, module->filename);
	module->fp = fp;
    } else {
	if (dowarn) {
	    if (module->name) {
	    	init_warning("Can't find module \"%s\" anywhere",
			     module->name);
	    } else {
	    	init_warning("Can't find unnamed module anywhere");
	    }
	}
	return FALSE;
    }
    /* It worked, mark this module as open. */
    module->open = TRUE;
    return TRUE;
}

/* Read info about a side's preferences and setup. */

/* This assumes one form only, probably too restrictive. */
/* should read all the forms, use the relevant ones. */
/* (how does this interact with other defaults?) */
/* (should be delayed until player can confirm it...) */

/* (update to work like other module stuff? then can use resources etc) */
/* (fix so that correct name can be found reliably) */

int
load_side_config(side)
Side *side;
{
#if 0
    FILE *fp;
    Obj *config;
    Module *module;

    /* (should incorp config name somehow, also be sys-dependent) */
    module = create_game_module(side->player->name);

    /* Don't use fopen directly, use open_module which indirectly calls 
    open_file to ensure mac/unix cross-platform compatibility. */    
    if (open_module(module, FALSE)) {
	if ((config = read_form(module->fp,
				&(module->startlineno),
				&(module->endlineno)))
	    != lispeof) {
	    /* interpret the config */
	    Dprintf("Interpreting %s config form", side_desig(side));
	    Dprintlisp(config);
	    Dprintf("\n");
	    fill_in_side(side, config, TRUE);
	} else {
	    /* no config form in the file */
	}
    } else {
	init_warning("Module \"%s\" could not be opened", module->name);
	/* Not a disaster, keep going */
    }
#endif
    return FALSE;
}

/* Read an entire file, attempting to pick up objects in it. */

/* (does this interp game-module form twice if description previously
   loaded?) */

void
read_forms(module)
Module *module;
{
    Obj *form;

    Dprintf("Trying to read a new format file \"%s\"...\n", module->name);
    if (module->fp != NULL) {
	while ((form = read_form(module->fp,
			     &(module->startlineno),
			     &(module->endlineno)))
		!= lispeof) {
	    interp_form(module, form);
	}
    } else {
	while ((form = read_form_from_string(module->sp,
			     &(module->startlineno),
			     &(module->endlineno),
			     &(module->sp)))
		!= lispeof) {
	    interp_form(module, form);
	}
    }
    /* Clean up after any print forms that might have been done. */
    end_printing_forms();
    Dprintf("... Done reading \"%s\".\n", module->name);
}

/* Interpret the given list of variants. */

void
do_module_variants(module, lis)
Module *module;
Obj *lis;
{
    int i, found, didsome;
    Obj *restset, *varset;
    Variant *var;

    if (module->variants == NULL)
      return; /* error? */
    didsome = FALSE;
    for_all_list(lis, restset) {
	varset = car(restset);
	found = FALSE;
	for (i = 0; module->variants[i].id != lispnil; ++i) {
	    var = &(module->variants[i]);
	    if (equal(car(varset), var->id)) {
		do_one_variant(module, var, cdr(varset));
		found = TRUE;
		didsome = TRUE;
	    }
	}
	if (!found) {
	    read_warning("Mystifying variant");
	}
    }
    /* Now implement all the defaults. */
    for (i = 0; module->variants[i].id != lispnil; ++i) {
	var = &(module->variants[i]);
	if (!var->used) {
	    do_one_variant(module, var, lispnil);
	    didsome = TRUE;
	}
    }
    if (didsome) {
	/* Make all the cross-references right. */
	patch_object_references();
	/* Recheck everything, the variants might have broken something. */
	check_game_validity();
    }
}

static void
do_one_variant(module, var, varsetdata)
Module *module;
Variant *var;
Obj *varsetdata;
{
    int val, caseval;
    int width = 0, height = 0, circumference, latitude, longitude;
    int rtime, rtimeperturn, rtimeperside;
    char *vartypename = c_string(var->id);
    Obj *restcases, *headcase, *rest, *filler, *rawval, *rawcaseval;

    if (Debug) {
	if (readerrbuf == NULL)
	  readerrbuf = (char *) xmalloc(BUFSIZE);
    	sprintlisp(readerrbuf, varsetdata, BUFSIZE);
    	Dprintf("Module %s variant %s being set to `%s'\n",
	    	module_desig(module), vartypename, readerrbuf);
    }
    switch (keyword_code(vartypename)) {
      case K_WORLD_SEEN:
	val = (varsetdata == lispnil ?
	       (var->dflt == lispnil ? FALSE : c_number(eval(var->dflt))) :
	       c_number(eval(car(varsetdata))));
	var->hasintvalue = TRUE;
	var->intvalue = val;
	set_g_terrain_seen(val);
	break;
      case K_SEE_ALL:
	val = (varsetdata == lispnil ?
	       (var->dflt == lispnil ? FALSE : c_number(eval(var->dflt))) :
	       c_number(eval(car(varsetdata))));
	var->hasintvalue = TRUE;
	var->intvalue = val;
	set_g_see_all(val);
	break;
      case K_SEQUENTIAL:
	val = (varsetdata == lispnil ?
	       (var->dflt == lispnil ? FALSE : c_number(eval(var->dflt))) :
	       c_number(eval(car(varsetdata))));
	var->hasintvalue = TRUE;
	var->intvalue = val;
	set_g_use_side_priority(val);
	break;
      case K_WORLD_SIZE:
      	filler = lispnil;
	if (varsetdata != lispnil) {
	    filler = varsetdata;
	} else if (var->dflt != lispnil) {
	    filler = var->dflt;
	}
	/* Pick the width and height out of the list. */
	if (filler != lispnil) {
	    width = c_number(eval(car(filler)));
	    filler = cdr(filler);
	}
	if (filler != lispnil) {
	    height = c_number(eval(car(filler)));
	    filler = cdr(filler);
	} else {
	    height = width;
	}
	/* Pick up a circumference if given. */
	if (filler != lispnil) {
	    circumference = c_number(eval(car(filler)));
	    set_world_circumference(circumference, TRUE);
	    filler = cdr(filler);
	}
	/* This is more useful after the circumference has been set. */
	if (width > 0 && height > 0)
	  set_area_shape(width, height, TRUE);
	/* Pick up latitude and longitude if given. */
	if (filler != lispnil) {
	    latitude = c_number(eval(car(filler)));
	    /* (should use a setter routine?) */
	    area.latitude = latitude;
	    filler = cdr(filler);
	}
	if (filler != lispnil) {
	    longitude = c_number(eval(car(filler)));
	    /* (should use a setter routine?) */
	    area.longitude = longitude;
	    filler = cdr(filler);
	}
	/* (should record settings somehow) */
	break;
      case K_REAL_TIME:
      	filler = lispnil;
	if (varsetdata != lispnil) {
	    filler = varsetdata;
	} else if (var->dflt != lispnil) {
	    filler = var->dflt;
	}
	if (filler != lispnil) {
	    rtime = c_number(eval(car(filler)));
	    filler = cdr(filler);
	} else {
	    rtime = 0;
	}
	if (filler != lispnil) {
	    rtimeperside = c_number(eval(car(filler)));
	    filler = cdr(filler);
	} else {
	    rtimeperside = 0;
	}
	if (filler != lispnil) {
	    rtimeperturn = c_number(eval(car(filler)));
	    filler = cdr(filler);
	} else {
	    rtimeperturn = 0;
	}
	/* If the values were specified, tweak the official
	   realtime globals. */
	if (rtime > 0)
	  set_g_rt_for_game(rtime);
	if (rtimeperside > 0)
	  set_g_rt_per_side(rtimeperside);
	if (rtimeperturn > 0)
	  set_g_rt_per_turn(rtimeperturn);
	/* (should record settings somehow) */
	break;
      default:
	/* This is the general case. */
	if (varsetdata != lispnil) {
	    rawval = car(varsetdata);
	} else if (var->dflt != lispnil) {
	    rawval = var->dflt;
	} else {
	    rawval = lispnil;
	}
	/* Always evaluate the raw value of the variant. */
	rawval = eval(rawval);
	if (numberp(rawval)) {
	    val = c_number(rawval);
	    var->hasintvalue = TRUE;
	    var->intvalue = val;
	} else {
	    val = FALSE;
	    var->hasintvalue = TRUE;
	    var->intvalue = val;
	}
	for_all_list(var->cases, restcases) {
	    headcase = car(restcases);
	    rawcaseval = eval(car(headcase));
	    if (numberp(rawcaseval))
	      caseval = c_number(rawcaseval);
	    if (numberp(rawcaseval) && caseval == val) {
		for_all_list(cdr(headcase), rest) {
		    interp_form(module, car(rest));
	    	}
	    }
	}
	/* Clean up after printing, might have been print forms in variant. */
	end_printing_forms();
	break;
    }
    /* Flag the variant as having been specified. */
    var->used = TRUE;
}

void
init_module_reshape(module)
Module *module;
{
    /* Seed all the reshaping parameters with reasonable values. */
    module->maybe_reshape = TRUE;
    module->subarea_width = area.width;
    module->subarea_height = area.height;
    module->subarea_x = module->subarea_y = 0;
    module->final_subarea_width = area.width;
    module->final_subarea_height = area.height;
    module->final_subarea_x = module->final_subarea_y = 0;
    module->final_width = area.width;  module->final_height = area.height;
    module->final_circumference = world.circumference;
    module->fill_type = 0;
}

/* This is true if any actual reshaping is required. */

int
reshape_the_output(module)
Module *module;
{
    return (module->maybe_reshape
	    && (module->subarea_width != area.width
		|| module->subarea_height != area.height
		|| module->subarea_x != 0
		|| module->subarea_y != 0
		|| module->final_subarea_width != area.width
		|| module->final_subarea_height != area.height
		|| module->final_subarea_x != 0
		|| module->final_subarea_y != 0
		|| module->final_width != area.width
		|| module->final_height != area.height
		|| module->final_circumference != world.circumference));
}

/* Check if the proposed reshape will actually work. */

int
valid_reshape(module)
Module *module;
{
    /* (should check hexagon shaping) */
    if (module->subarea_width > area.width
	|| module->subarea_height > area.height)
      return FALSE;
    /* (should check other offsets) */
    if (module->final_width < 3 || module->final_height < 3)
      return FALSE;
    return TRUE;
}

/* Close the module. */

void
close_module(module)
Module *module;
{
    if (module->sp) {
	module->sp = NULL;
    }
    if (module->fp) {
	fclose(module->fp);
	module->fp = NULL;
    }
    module->open = FALSE;
}

/* Return a description of the module. */

char *
module_desig(module)
Module *module;
{
    if (moduledesigbuf == NULL)
      moduledesigbuf = xmalloc(BUFSIZE);
    sprintf(moduledesigbuf, "module %s (%s)",
	    module->name, (module->title ? module->title : "no title"));
    return moduledesigbuf;
}

/* (random code below, should be sent to better places) */

#ifdef DEBUGGING
/* Use this to ensure that everything is cool. */

void
doublecheck_state(side)
Side *side;
{
    Unit *unit;

    for_all_units(unit) {
	if (unit->x < 0 || unit->x >= area.width ||
	    unit->y <= 0 || unit->y >= (area.height - 1) ||
	    unit->hp <= 0) {
	    Dprintf("%s off map hp %d", unit_desig(unit), unit->hp);
	}
    }
}
#endif /* DEBUGGING */

void set_u_internal_name(u, s) int u; char *s; { utypes[u].iname = s; }
void set_u_type_name(u, s) int u; char *s; { utypes[u].name = s; }
void set_m_type_name(m, s) int m; char *s; { mtypes[m].name = s; }
void set_t_type_name(t, s) int t; char *s; { ttypes[t].name = s; }
void set_a_type_name(a, n) int a; char *n; { atypes[a].name = n; }

/* If a special symbol, we might not have to fail. */

int
lazy_bind(sym)
Obj *sym;
{
    int u, m, t, a;
    Obj *value;

    switch (keyword_code(c_string(sym))) {
      case K_USTAR:
	value = lispnil;
	/* Since consing glues onto the front, iterate backwards
	   through the types. */
	for (u = numutypes - 1; u >= 0; --u)
	  value = cons(new_utype(u), value);
	break;
      case K_MSTAR:
	value = lispnil;
	for (m = nummtypes - 1; m >= 0; --m)
	  value = cons(new_mtype(m), value);
	break;
      case K_TSTAR:
	value = lispnil;
	for (t = numttypes - 1; t >= 0; --t)
	  value = cons(new_ttype(t), value);
	break;
      case K_ASTAR:
	value = lispnil;
	for (a = numatypes - 1; a >= 0; --a)
	  value = cons(new_atype(a), value);
	break;
      default:
	return FALSE;
    }
    setq(sym, value);
    return TRUE;
}

int
coerce_to_side_id(x)
Obj *x;
{
    if (numberp(x)) {
	return c_number(x);
    }
    return 0;
}

Side *
coerce_to_side(x)
Obj *x;
{
    return side_n(coerce_to_side_id(x));
}

int
coerce_to_unit_id(x)
Obj *x;
{
    if (numberp(x)) {
	return c_number(x);
    }
    return 0;
}

Unit *
coerce_to_unit(x)
Obj *x;
{
    return find_unit(coerce_to_unit_id(x));
}
