/* The GIMP -- an image manipulation program
 * Copyright (C) 1999 Ray Lehtiniemi
 *
 * This program 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 of the License, or
 * (at your option) any later version.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 */

#include <guile/gh.h>
#include <libguile/list.h>
#include "libgimp/gimp.h"
#include "interp.h"

/* turn a string into an interned symbol */
#define LOOKUP(x) SCM_CAR (scm_intern0 (x))

/* export stuff to guile */
static void register_everything (void);


/* a flag for the benefit of the server main loop */
static gint active = 0;

gint
interp_active (void)
{
  return active;
}

/* register various routines, then load the user's init files and the
   guile-fu server core */
void
interp_init (void)
{
  SCM tail = SCM_EOL;

  register_everything ();

  tail = scm_cons (LOOKUP ("begin"),
                   tail);
  
  tail = scm_cons (SCM_LIST1 (LOOKUP ("load-user-init")),
                   tail);

  tail = scm_cons (SCM_LIST2 (LOOKUP ("primitive-load-path"),
                              scm_makfrom0str ("guile-fu.scm")),
                   tail);
  
  tail = scm_cons (SCM_LIST1 (LOOKUP ("gf-init")),
                   tail);

  scm_eval_x (scm_reverse_x (tail, SCM_UNDEFINED));

  active = 1;
}

/* evaluate the cmd string and stringify the resulting expression */
gchar *
interp_eval (gchar * cmd)
{
  SCM tail = SCM_EOL;
  
  tail = scm_cons (LOOKUP ("begin"),
                   tail);
  
  tail = scm_cons (SCM_LIST2 (LOOKUP ("gf-eval"),
                              scm_makfrom0str (cmd)),
                   tail);

  tail = scm_reverse_x (tail, SCM_UNDEFINED);

  tail = scm_strprint_obj (scm_eval_x (tail));

  return (g_strdup (SCM_CHARS (tail)));
}

/* drop into the standalone main loop */
void
interp_main (void)
{
  SCM tail = SCM_EOL;

  tail = scm_cons (LOOKUP ("begin"),
                   tail);
  
  tail = scm_cons (SCM_LIST1 (LOOKUP ("gf-repl")),
                   tail);

  tail = scm_reverse_x (tail, SCM_UNDEFINED);

  exit (scm_exit_status (scm_eval_x (tail)));
}



/* set the continue flag to zero so the main driver knows to exit */
static SCM
quit (void)
{
  active = 0;
  return SCM_UNDEFINED;
}


/* the primary PDB marshaller.  this function accepts a string with
   the name of the PDB procedure to invoke and a list of cons cells
   with the arguments.  the car of each cell is the type of arg
   expected and the cdr is the arg itself.  if the args look good, we
   invoke the routine and send back the results */
static SCM
run_proc (SCM name,
          SCM params)
{
  GParam *args = NULL;
  GParam *vals = NULL;
  gint nargs = 0;
  gint nvals = 0;
  SCM retval = SCM_EOL;
  gint i;
  
  SCM_ASSERT (SCM_NIMP (name) && SCM_STRINGP (name),
              name, SCM_ARG1, "run_proc");

  nargs = scm_ilength (params);
  SCM_ASSERT (nargs >= 0, params, SCM_ARG2, "run_proc");

  if (nargs != 0)
    {
      args = (GParam *) g_new (GParam, nargs);

      for (i = 0; i < nargs; i++)
        {
          SCM param, type, val;
          
          param = SCM_CAR (params);
          params = SCM_CDR (params);
          if (SCM_NCONSP (param))
            goto die_args;
      
          type = SCM_CAR (param);
          val = SCM_CDR (param);
          if (SCM_NINUMP (type))
            goto die_args;

          args[i].type = scm_num2long (type, SCM_ARGn, "run_proc");
      
          switch (args[i].type)
            {
            case PARAM_INT32:
            case PARAM_DISPLAY:
            case PARAM_IMAGE:
            case PARAM_LAYER:
            case PARAM_CHANNEL:
            case PARAM_DRAWABLE:
            case PARAM_SELECTION:
              {
                if (SCM_NINUMP (val))
                  goto die_args;

                args[i].data.d_int32 =
                  (gint32) scm_num2long (val, SCM_ARGn, "run_proc");
              }
              break;
          
            case PARAM_INT16:
              {
                if (SCM_NINUMP (val))
                  goto die_args;
                
                args[i].data.d_int16 =
                  (gint16) scm_num2long (val, SCM_ARGn, "run_proc");
              }
              break;
                  
            case PARAM_INT8:
              {
                if (SCM_NINUMP (val))
                  goto die_args;

                args[i].data.d_int8 =
                  (gint8) scm_num2long (val, SCM_ARGn, "run_proc");
              }
              break;
          
            case PARAM_FLOAT:
              {
                if (SCM_NINUMP (val))
                  goto die_args;
                
                args[i].data.d_float =
                  (gfloat) scm_num2dbl (val, "run_proc");
              }
              break;
              
            case PARAM_STRING:
              {
                if (SCM_IMP (val) || SCM_NSTRINGP (val))
                  goto die_args;
                
                args[i].data.d_string =
                  g_strdup (SCM_CHARS (val));
              }
              break;
          
            case PARAM_INT32ARRAY:
              {
                if (0) /* FIXME */
                  goto die_args;
                
                args[i].data.d_int32array =
                  (gint32*) SCM_CHARS (val);
              }
              break;
              
            case PARAM_INT16ARRAY:
              {
                if (0) /* FIXME */
                  goto die_args;
                
                args[i].data.d_int16array =
                  (gint16*) SCM_CHARS (val);
              }
              break;
              
            case PARAM_INT8ARRAY:
              {
                if (0) /* FIXME */
                  goto die_args;
                
                args[i].data.d_int8array =
                  (gint8*) SCM_CHARS (val);
              }
              break;
              
            case PARAM_FLOATARRAY:
              {
                if (0) /* FIXME */
                  goto die_args;
                
                args[i].data.d_floatarray =
                  (gdouble*) SCM_CHARS (val);
              }
              break;
              
            case PARAM_STRINGARRAY:
              {
                gchar **array;
                gint n, j;

                if ((i < 1) || args[i-1].type != PARAM_INT32)
                  goto die_args;

                n = args[i-1].data.d_int32;

                if (scm_ilength (val) != n)
                  goto die_args;

 		array = args[i].data.d_stringarray = g_new (char *, n);

                for (j=0; j<n; j++)
                  {
                    if (SCM_IMP (SCM_CAR (val)) || SCM_NSTRINGP (SCM_CAR (val)))
                      goto die_args;
		    array[j] = g_strdup (SCM_CHARS (SCM_CAR (val)));
		    val = SCM_CDR (val);
                  }
              }
              break;
             
            case PARAM_COLOR:
              {
                if (scm_ilength (val) != 3)
                  goto die_args;
                
                if (SCM_NINUMP (SCM_CAR (val)))
                  goto die_args;
                args[i].data.d_color.red =
                  (gint8) scm_num2long (SCM_CAR (val), SCM_ARGn, "run_proc");
                val = SCM_CDR (val);

                if (SCM_NINUMP (SCM_CAR (val)))
                  goto die_args;
                args[i].data.d_color.green =
                  (gint8) scm_num2long (SCM_CAR (val), SCM_ARGn, "run_proc");
                val = SCM_CDR (val);

                if (SCM_NINUMP (SCM_CAR (val)))
                  goto die_args;
                args[i].data.d_color.blue =
                  (gint8) scm_num2long (SCM_CAR (val), SCM_ARGn, "run_proc");
              }
              break;

            case PARAM_PARASITE:
              {
                if (scm_ilength (val) != 4)
                  goto die_args;
                
                if (SCM_IMP (SCM_CAR (val)) || SCM_NSTRINGP (SCM_CAR (val)))
                  goto die_args;
                args[i].data.d_parasite.name =
                  g_strdup (SCM_CHARS (SCM_CAR (val)));
                val = SCM_CDR (val);
                
                if (SCM_NINUMP (SCM_CAR (val)))
                  goto die_args;
                args[i].data.d_parasite.flags =
                  (gint32) scm_num2long (SCM_CAR (val), SCM_ARGn, "run_proc");
                val = SCM_CDR (val);

                /* FIXME - what type is this? */
                args[i].data.d_parasite.size =
                  (gint32) SCM_LENGTH (SCM_CAR (val));
                args[i].data.d_parasite.data =
                  (void*) SCM_CHARS (SCM_CAR (val));
              }
              break;
                
            case PARAM_REGION:
            case PARAM_BOUNDARY:
            case PARAM_PATH:
              args[i].type = -1;
              break;
              
            case PARAM_STATUS:
            default:
              goto die_args;

            die_args:
              {
                gimp_destroy_params (args, i);
                g_free (args);
                scm_error (SCM_BOOL_T, SCM_CHARS (name),
                           "Invalid args",
                           SCM_UNDEFINED, SCM_UNDEFINED);
              }
            }
        }
    }
  
  vals = gimp_run_procedure2 (SCM_CHARS (name),
                              &nvals, nargs, args);


  if (vals == NULL)
    {
      retval = scm_cons (LOOKUP ("proc-db-execution-failed"),
                         SCM_EOL);
    }
  else
    {
      retval = scm_cons (SCM_MAKINUM (vals[0].data.d_status),
                         SCM_EOL);

      if (vals[0].data.d_status == STATUS_SUCCESS)
        {
          for (i = 1; i < nvals; i++)
            {
              switch (vals[i].type)
                {
                case PARAM_INT32:
                case PARAM_DISPLAY:
                case PARAM_IMAGE:
                case PARAM_LAYER:
                case PARAM_CHANNEL:
                case PARAM_DRAWABLE:
                case PARAM_SELECTION:
                  retval = scm_cons
                    (SCM_MAKINUM (vals[i].data.d_int32),
                     retval);
                  break;
                  
                case PARAM_INT16:
                  retval = scm_cons
                    (SCM_MAKINUM (vals[i].data.d_int16),
                     retval);
                  break;
                  
                case PARAM_INT8:
                  retval = scm_cons
                    (SCM_MAKINUM (vals[i].data.d_int8),
                     retval);
                  break;
                  
                case PARAM_FLOAT:
                  retval = scm_cons
                    (scm_makdbl (vals[i].data.d_float, 0),
                     retval);
                  break;
          
                case PARAM_STRING:
                  retval = scm_cons
                    (scm_makfrom0str (vals[i].data.d_string),
                     retval);
                  break;
          
                case PARAM_INT32ARRAY:
                  {
                    SCM array;
                    gint32 * p;
                    int j;
                
                    array = scm_make_uve (vals[i-1].data.d_int32,
                                          SCM_MAKINUM (0));
                    p = (gint32*) SCM_CHARS (array);
                    for (j = 0; j < vals[i-1].data.d_int32; j++)
                      p[j] = vals[i].data.d_int32array[j];
                
                    retval = scm_cons (array, retval);
                  }
                  break;
              
                case PARAM_INT16ARRAY:
                  {
                    SCM array;
                    gint16 * p;
                    int j;

                    array = scm_make_uve (vals[i-1].data.d_int32,
                                          LOOKUP ("s"));
                    p = (gint16*) SCM_CHARS (array);
                    for (j = 0; j < vals[i-1].data.d_int32; j++)
                      p[j] = vals[i].data.d_int16array[j];
                
                    retval = scm_cons (array, retval);
                  }
                  break;
              
                case PARAM_INT8ARRAY:
                  {
                    SCM array;
                    gint8 * p;
                    int j;
                
                    array = scm_make_uve (vals[i-1].data.d_int32,
                                          SCM_MAKICHR ('\0'));
                    p = (gint8*) SCM_CHARS (array);
                    for (j = 0; j < vals[i-1].data.d_int32; j++)
                      p[j] = vals[i].data.d_int8array[j];
                
                    retval = scm_cons (array, retval);
                  }
                  break;
              
                case PARAM_FLOATARRAY:
                  {
                    SCM array;
                    gdouble * p;
                    int j;
                
                    array = scm_make_uve (vals[i-1].data.d_int32,
                                          scm_makdbl (1, 0));
                    p = (gdouble*) SCM_CHARS (array);
                    for (j = 0; j < vals[i-1].data.d_int32; j++)
                      p[j] = vals[i].data.d_floatarray[j];
                
                    retval = scm_cons (array, retval);
                  }
                  break;

                case PARAM_STRINGARRAY:
                  {
                    SCM array;
                    char **p;
                    int j;

                    array = SCM_EOL;
                    p = (char **) vals[i].data.d_stringarray;
                    for (j = 0; j < vals[i-1].data.d_int32; j++)
                      array = scm_cons (scm_makfrom0str (p[j]), array);
                    array = scm_reverse_x (array, SCM_UNDEFINED);
                
                    retval = scm_cons (array, retval);
                  }
                  break;
              
                case PARAM_COLOR:
                case PARAM_PARASITE:
                  retval = scm_cons
                    (LOOKUP ("unimplemented-return-val"),
                     retval);
                  break;
   
                case PARAM_REGION:
                case PARAM_BOUNDARY:
                case PARAM_PATH:
                case PARAM_STATUS:
                default:
                  retval = scm_cons
                    (LOOKUP ("unsupported-return-val"),
                     retval);
                  break;
                }
            }
        }
      
      retval = scm_reverse_x (retval, SCM_UNDEFINED);
    }
  

  gimp_destroy_params (vals, nvals);
  g_free (args);
  
  return retval;
}


static void
register_everything (void)
{
  scm_make_gsubr ("gf-quit", 0, 0, 0, quit);
  scm_make_gsubr ("gf-run", 1, 0, 1, run_proc);
}

