/*
 *                     S C H E M E _ C O O R D . C
 *
 *  Implements new scheme data types: coordinates and ranges.
 *
 *  Version      : $Revision: 1.3 $
 *
 *  Created      : Sun Jul 17 23:39:49 1994
 *  Author       : Ulrich Drepper <drepper@mydec>
 *
 *  Last modified: Sun Jul 17 23:40:52 1994
 *  Author       : Ulrich Drepper <drepper@mydec>
 *
 *  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 1, 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., 675 Mass Ave, Cambridge, MA 02139, USA.
 *
 */
#if !defined(lint)
static const char *vcid = "$Id: scheme_coord.c,v 1.3 1994/07/17 22:41:06 drepper Exp $";
#endif /* lint */

#include "scheme.h"

/* globals */
Scheme_Object *scheme_coord_type, *scheme_range_type;

/* locals */
static Scheme_Object *coord_p(int argc, Scheme_Object *argv[]);
static Scheme_Object *range_p(int argc, Scheme_Object *argv[]);
static Scheme_Object *lu_coord(int argc, Scheme_Object *argv[]);
static Scheme_Object *rl_coord(int argc, Scheme_Object *argv[]);

void
scheme_init_coord(Scheme_Env *env)
{
    scheme_coord_type = scheme_make_type("<coord>");
    scheme_range_type = scheme_make_type("<range>");
    scheme_add_global ("<coord>", scheme_coord_type, env);
    scheme_add_global ("<range>", scheme_range_type, env);
    scheme_add_global ("coord?", scheme_make_prim (coord_p), env);
    scheme_add_global ("range?", scheme_make_prim (range_p), env);
    scheme_add_global ("lu-coord", scheme_make_prim (lu_coord), env);
    scheme_add_global ("rl-coord", scheme_make_prim (rl_coord), env);
}

Scheme_Object *
scheme_make_coord (int x, int y)
{
    Scheme_Object *sc;

    sc = scheme_alloc_object ();
    SCHEME_TYPE (sc) = scheme_coord_type;
    SCHEME_COORD_VAL_X (sc) = x;
    SCHEME_COORD_VAL_Y (sc) = y;
    return sc;
}

Scheme_Object *
scheme_make_range (int xlu, int ylu, int xrl, int yrl)
{
    Scheme_Object *sr;
    
    if (xlu > xrl) { int tmp = xlu; xlu = xrl; xrl = tmp; }
    if (ylu > yrl) { int tmp = ylu; ylu = yrl; yrl = tmp; }	 

    sr = scheme_alloc_object ();
    SCHEME_TYPE (sr) = scheme_range_type;
    SCHEME_RANGE_VAL_LU (sr) = scheme_make_coord (xlu, ylu);
    SCHEME_RANGE_VAL_RL (sr) = scheme_make_coord (xrl, yrl);

    return sr;
}

/* locals */

static Scheme_Object *
coord_p(int argc, Scheme_Object *argv[])
{
  SCHEME_ASSERT ((argc == 1), "coord?: wrong number of args");
  return SCHEME_COORDP(argv[0]) ? scheme_true : scheme_false;
}

static Scheme_Object *
range_p(int argc, Scheme_Object *argv[])
{
  SCHEME_ASSERT ((argc == 1), "range?: wrong number of args");
  return SCHEME_RANGEP(argv[0]) ? scheme_true : scheme_false;
}

static Scheme_Object *
lu_coord(int argc, Scheme_Object *argv[])
{
  SCHEME_ASSERT ((argc == 1), "lu-coord: wrong number of args");
  if (SCHEME_RANGEP (argv[0]))
    {
      if (SCHEME_COORDP (argv[0]))
	{
	  return argv[0];
	}
      else
	{
	  return SCHEME_RANGE_VAL_LU (argv[0]);
	}
    }
  else
    {
      scheme_signal_error ("lu-coord: arg must be a range");
    }
}

static Scheme_Object *
rl_coord(int argc, Scheme_Object *argv[])
{
  SCHEME_ASSERT ((argc == 1), "rl-coord: wrong number of args");
  if (SCHEME_RANGEP (argv[0]))
    {
      if (SCHEME_COORDP (argv[0]))
	{
	  return argv[0];
	}
      else
	{
	  return SCHEME_RANGE_VAL_RL (argv[0]);
	}
    }
  else
    {
      scheme_signal_error ("rl-coord: arg must be a range");
    }
}

/*
 * Local Variables:
 *  mode:c
 *  c-indent-level:4
 *  c-continued-statement-offset:4
 *  c-continued-brace-offset:0
 *  c-brace-offset:0
 *  c-imaginary-offset:0
 *  c-argdecl-indent:4
 *  c-label-offset:-2
 * End:
 */
