#include <config.h>
#if HAVE_ALLOCA_H
#include <alloca.h>
#endif /* HAVE_ALLOCA_H */ 
#include "lisp.h"
#include "charset.h"
#include "fontset.h"

static char STRcasetbl[256];

static int
STRcasecmp(s0, s1)
     unsigned char *s0, *s1;
{
  while (*s0) if (STRcasetbl[*s0++] != STRcasetbl[*s1++]) return 1;
  return (int)*s1;
}

FONT_INFO *font_table;
int font_table_size;
int n_fonts;

FONTSET_INFO *fontset_table;
int fontset_table_size;
int n_fontsets;

void (*load_font_func)( /* FONT_INFO *fontinfo */);
char **(*font_list_func)( /* char *name, int *count, int size */);

fs_new_font(requested, lc)
     char *requested;
     int lc;
{
  int len;

  if (font_table_size == 0) {
    font_table_size = 32;
    n_fonts = 0;
    font_table = (FONT_INFO *) xmalloc (font_table_size
					* sizeof (font_table[0]));
  } else if (n_fonts >= font_table_size) {
    font_table_size *= 2;
    font_table = (FONT_INFO *) xrealloc (font_table,
					 font_table_size
					 * sizeof (font_table[0]));
  }
    
  font_table[n_fonts].fontID = n_fonts;
  font_table[n_fonts].font = (FONT_PTR)0;
  font_table[n_fonts].lc = lc;
  font_table[n_fonts].status = FONT_NOT_OPENED;
  font_table[n_fonts].name = (char *)0;
  font_table[n_fonts].size = 0;
  font_table[n_fonts].encoding = 0;
  font_table[n_fonts].yoffset = 0;
  font_table[n_fonts].relative_compose = 0;
  len = strlen(requested) + 1;
  font_table[n_fonts].requested = (char *) xmalloc(len);
  bcopy(requested, font_table[n_fonts].requested, len);
  return (n_fonts++);
}

fs_query_font(fontname, lc, size)
     char *fontname;
     int lc, size;
{
  int i;

  for (i = 0; i < n_fonts; i++) {
    if (lc == font_table[i].lc
	&& (!font_table[i].size
	    || (!size && font_table[i].status != FONT_NOT_FOUND)
	    || font_table[i].size == size)
	&& (!STRcasecmp(fontname, font_table[i].requested)
	    || (font_table[i].name
		&& !STRcasecmp(fontname, font_table[i].name))))
      return i;
  }
  return -1;
}

load_query_font(fontname, lc, size)
     char *fontname;
     int lc, size;
{
  int fontID = fs_query_font(fontname, lc, size);

  return (fontID >= 0 ? fontID : fs_new_font(fontname, lc));
}

static
fs_copy_font(from, to)
     int from, to;
{
  font_table[to].font = font_table[from].font;
  font_table[to].name = font_table[from].name;
  font_table[to].lc = font_table[from].lc;
  font_table[to].status = font_table[from].status;
  font_table[to].size = font_table[from].size;
  font_table[to].encoding = font_table[from].encoding;
  font_table[to].yoffset = font_table[from].yoffset;
  font_table[to].relative_compose = font_table[from].relative_compose;
}  

fs_load_font(fsID, lc, size)
     int fsID, lc, size;
{
  int fontID = FS_FONT_ID(fsID, lc);
  FONT_INFO *font;

  if (fontID < 0)
    return -1;
  
  while (1) {
    font = font_table + fontID;
    if (font->status == FONT_NOT_FOUND) {
      if (!font->size		/* no font of this pattern */
	  || size == font->size	/* size specified, but no font of this size */
	  )
	return -1;
      /* size != font->size */
      fontID = FS_FONT_ID (fsID, lc)
	= load_query_font(font->requested, lc, size);
    } else if (font->status == FONT_OPENED) {
      if (!size || size == font->size)
	return fontID;
      /* size != font->size */
      fontID = FS_FONT_ID (fsID, lc)
	= load_query_font(font->requested, lc, size);
    } else  /* font->status == FONT_NOT_OPENED */
      break;
  }

  if (!font_list_func) {
    /* No way to get another name. */
    (*load_font_func)(font);

  } else {
    int count, i, anotherID;
    char **font_names = (*font_list_func)(font->requested, &count, size);

    if (!font_names) {
      font->size = size;
      font->status = FONT_NOT_FOUND;
      return -1;
    }

    for (i = 0; i < count; i++)
      if ((anotherID = fs_query_font(font_names[i], lc, size)) >= 0)
	break;
    if (i >= count)
      i = 0, anotherID = fontID;

    if (font_table[anotherID].status == FONT_NOT_OPENED) {
      font_table[anotherID].name = font_names[i];
      (*load_font_func)(font_table + anotherID);
      if (size) font_table[anotherID].size = size;
    }
    if (anotherID != fontID)
      fs_copy_font(anotherID, fontID);
  }
  return (font->status == FONT_OPENED ? fontID : -1);
}

new_fontset(name, fontnames)
     char *name, **fontnames;
{
  int i;

  if (!fontnames[LCASCII]
      || !fontnames[LCASCII][0])
    /* At least, ASCII font should be specified. */
    return -1;

  /* Room left in fontset_table? */
  if (fontset_table_size == 0) {
    fontset_table_size = 8;
    n_fontsets = 0;
    fontset_table = (FONTSET_INFO *) xmalloc (fontset_table_size
					      * sizeof (fontset_table[0]));
  } else if (n_fontsets >= fontset_table_size) {
    fontset_table_size += 8;
    fontset_table = (FONTSET_INFO *) xrealloc (fontset_table,
					       fontset_table_size
					       * sizeof (fontset_table[0]));
  }

  if (name && name[0]) {
    i = strlen(name) + 1;
    fontset_table[n_fontsets].name = (char *) xmalloc (i);
    bcopy(name, fontset_table[n_fontsets].name, i);
  } else {
    fontset_table[n_fontsets].name = (char *) 0;
  }

  fontset_table[n_fontsets].size = -1;

  FS_FONT_ID(n_fontsets, 0) = load_query_font(fontnames[0], 0, 0);
  for (i = 1; i < 128; i++) {
    FS_FONT_ID(n_fontsets, i + 128)
      = (fontnames[i] ? load_query_font(fontnames[i], i + 128, 0)
	 : n_fontsets != DEFAULT_FONTSET ? FS_FONT_ID(DEFAULT_FONTSET, i + 128)
	 : -1);
  }

  return n_fontsets++;
}

query_fontset(name)
     char *name;
{
  int fsID;

  if (!name || !name[0])
    return -1;

  for (fsID = 0; fsID < n_fontsets; fsID++)
    if (fontset_table[fsID].name
	&& !STRcasecmp(name, fontset_table[fsID].name))
      return fsID;
  return -1;
}

DEFUN ("fontsetp", Ffontsetp, Sfontsetp, 1, 1, 0,
  "T if NAME is a fontset already created by `new-fontset'.")
  (name)
     Lisp_Object name;
{
  CHECK_STRING (name, 0);

  return (query_fontset (XSTRING (name)->data) >= 0 ? Qt : Qnil);
}

load_query_fontset(name, fontnames)
     char *name, **fontnames;
{
  int fsID = query_fontset(name);

  return (fsID >= 0 ? fsID : new_fontset(name, fontnames));
}  

find_fontset_from_font(fontname, lc)
     char *fontname;
     int lc;
{
  int i;

  for (i = 0; i < n_fontsets; i++) {
    if (FS_FONT_ID(i, lc) >= 0) { /* 94.6.28 by Mr.Shiode */
      FONT_INFO *fontinfo = &FS_FONT_INFO(i, lc);

      if (!STRcasecmp(fontinfo->requested, fontname)
	  || (fontinfo->name && !STRcasecmp(fontinfo->name, fontname)))
	return i;
    }
  }
  return -1;
}

DEFUN ("new-fontset", Fnew_fontset, Snew_fontset, 2, 2, 0,
  "Create a new fontset of NAME which contains fonts in FONTNAMES.\n\
FONTNAMES should be a vector of fontnames.\n\
Returns fontset-id (integer) or nil if fails.")
  (name, fontnames)
     Lisp_Object name, fontnames;
{
  int fsID;
  char *fonts[128];
  int i;

  CHECK_STRING (name, 0);
  CHECK_VECTOR (fontnames, 1);

  for (i = 0; i < XVECTOR (fontnames)->size; i++) {
    fonts[i] = (XTYPE (XVECTOR (fontnames)->contents[i]) != Lisp_String)
      ? (char *)0 : (char *) XSTRING (XVECTOR (fontnames)->contents[i])->data;
  }
  for (; i < 128; i++)
    fonts[i] = (char *)0;

  fsID = load_query_fontset(XSTRING(name)->data, fonts);

  return (fsID >= 0 ? make_number(fsID) : Qnil);
}

DEFUN ("set-fontset-font", Fset_fontset_font, Sset_fontset_font, 3, 3, 0,
  "Args are FONTSET (string), LEADING-CHAR (integer), and FONTNAME (string).\n\
Set FONTNAME for a font of charset specified by LEADING-CHAR in FONTSET.")
  (fontset, lc, fontname)
     Lisp_Object fontset, lc, fontname;
{
  int fsID;

  CHECK_STRING (fontset, 0);
  CHECK_NUMBER (lc, 1);
  CHECK_STRING (fontname, 2);

  if (XFASTINT (lc) >= 256 || char_type[XFASTINT (lc)] == TYPEINV)
    error ("Invalid leading-char: %d", XFASTINT (lc));

  if ((fsID = query_fontset (XSTRING (fontset)->data)) < 0)
    error ("Invalid fontset: %s", XSTRING (fontset)->data);
  
  FS_FONT_ID (fsID, XFASTINT (lc))
    = load_query_font (XSTRING (fontname)->data, XFASTINT (lc), 0);

  return Qnil;
}

DEFUN ("get-font-info", Fget_font_info, Sget_font_info, 1, 1, 0,
  "Return information specified by FONT-INDEX by a vector of length 9.\n\
The elements are:\n\
 0. FONT-INDEX\n\
 1. REQUESTED-NAME\n\
 2. OPENED-NAME\n\
 3. LEADING CHARACTER\n\
 4. STATUS -- 0:not yet opened, 1:font opened, 2:font not found\n\
 5. PIXEL SIZE\n\
 6. ENCODING -- 0:0x20-0x7F, 1:0xA0-0xFF\n\
 7. YOFFSET -- vertical upward offset from baseline of ASCII text\n\
 8. RELATIVE_COMPOSE -- non-zero means glyph should be relatively composed")
  (font_idx)
     Lisp_Object font_idx;
{
  unsigned int fontID;
  Lisp_Object val;
  FONT_INFO *font;

  CHECK_NUMBER(font_idx, 0);
  fontID = XFASTINT (font_idx);
  if (fontID >= n_fonts)
    error ("Invalid font index: %d", fontID);
  font = font_table + fontID;
  val = Fmake_vector(9, Qnil);
  XVECTOR (val)->contents[0] = font_idx;
  XVECTOR (val)->contents[1] = build_string(font->requested);
  XVECTOR (val)->contents[2] =
    font->status == FONT_OPENED ? build_string(font->name) : Qnil;
  XVECTOR (val)->contents[3] = make_number(font->lc);
  XVECTOR (val)->contents[4] = make_number(font->status);
  XVECTOR (val)->contents[5] = make_number(font->size);
  XVECTOR (val)->contents[6] = make_number(font->encoding);
  XVECTOR (val)->contents[7] = make_number(font->yoffset);
  XVECTOR (val)->contents[8] = make_number(font->relative_compose);

  return val;
}

DEFUN ("font-list", Ffont_list, Sfont_list, 0, 0, 0,
  "Return a list of fonts.")
  ()
{
  Lisp_Object val = Qnil;
  int i;

  for (i = n_fonts - 1; i >= 0; i--)
    val = Fcons (Fget_font_info(make_number(i)), val);

  return val;
}

DEFUN ("get-fontset-info", Fget_fontset_info, Sget_fontset_info, 1, 1, 0,
  "Return information about FONTSET.\n\
The returned value is a cons of fontset name and fontset contents.\n\
A fontset contents is a vector of length 128 and values are indices of font.")
  (fontset)
     Lisp_Object fontset;
{
  int fsID, i;
  Lisp_Object fonts;
  
  CHECK_STRING(fontset, 0);

  if ((fsID = query_fontset (XSTRING (fontset)->data)) < 0)
    return Qnil;
  
  fonts = Fmake_vector(128, Qnil);
  for (i = 0; i < 128; i++)
    XSET(XVECTOR (fonts)->contents[i], Lisp_Int, FS_FONT_ID(fsID, i));

  return Fcons(fontset, fonts);
}

DEFUN ("fontset-list", Ffontset_list, Sfontset_list, 0, 1, 0,
  "Return a list of fontset names currently defined.\n\
If optional argument CONTENTS-FLAG is non-nil, return a list of cons\n\
whose `car' part is a fontset name and `cdr' part is a vector of length 128\n\
whose elements are font indices for each character set.")
  (contents_flag)
     Lisp_Object contents_flag;
{
  Lisp_Object val = Qnil, fonts;
  int i, j;

  if (NILP (contents_flag)) {
    for (i = n_fontsets - 1; i >= 0; i--)
      val = Fcons(build_string(fontset_table[i].name), val);
  } else {
    for (i = n_fontsets - 1; i >= 0; i--) {
      fonts = Fmake_vector(128, Qnil);
      for (j = 0; j < 128; j++)
	XSET(XVECTOR (fonts)->contents[j], Lisp_Int, FS_FONT_ID(i, j));
      val = Fcons(Fcons(build_string(fontset_table[i].name), fonts), val);
    }
  }
  return val;
}

init_fontset()
{
  int i;

  font_table_size = n_fonts = 0;
  fontset_table_size = n_fontsets = 0;
  for (i = 0; i < 256; i++)
    STRcasetbl[i] = (i >= 'A' && i <= 'Z') ? i + 'a' - 'A' : i;
}

syms_of_fontset()
{
  defsubr (&Sfontsetp);
  defsubr (&Snew_fontset);
  defsubr (&Sset_fontset_font);
  defsubr (&Sget_font_info);
  defsubr (&Sfont_list);
  defsubr (&Sget_fontset_info);
  defsubr (&Sfontset_list);
}
