smob-value.c 5.73 KB
Newer Older
1 2 3
/* -*- mode: c; c-basic-offset: 8 -*- */

/*
4
 *
5 6
 *     Author: Ariel Rios <ariel@arcavia.com>
 *	   Copyright Ariel Rios 2000
7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23
 *
 * 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, 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 software; see the file COPYING.  If not, write to
 * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
 * Boston, MA 02111-1307 USA
 */

24
#include <config.h>
25
#include <libguile.h>
26
#include <glib.h>
27 28
#include <gtk/gtk.h>
#include <guile/gh.h>
29
#include <stdlib.h>
30

31
#include "smob-value.h"
32
#include "value.h"
33 34 35 36 37 38 39 40 41

static long value_tag;

typedef struct _SCM_Value
{
	Value *v;
	SCM update_func;
} SCM_Value;

42 43 44 45 46 47 48 49
SCM
make_new_smob (Value *v)
{
	SCM_Value *value;

	value = (SCM_Value *) scm_must_malloc (sizeof (SCM_Value), "value");
	value->v = v;
	value->update_func = SCM_BOOL_F;
50

51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66
	SCM_RETURN_NEWSMOB (value_tag, value);
}

Value *
get_value_from_smob (SCM value_smob)
{
	Value *value;
	SCM_Value *v = (SCM_Value *) SCM_CDR (value_smob);

	value = g_new (Value, 1);

	value = v->v;

	return value;

}
67

68 69
static SCM
make_value (SCM scm)
70 71
{
	Value *v;
72
	SCM_Value *value;
73

74
	v = g_new (Value, 1);
75

76 77 78 79
	/*
	  FIXME:
	  Add support for array, null values, etc
	*/
80

81 82
	if (SCM_NIMP (scm) && SCM_STRINGP (scm))
		v = value_new_string (SCM_CHARS (scm));
83

84
	if ((SCM_NFALSEP (scm_number_p(scm))))
Jody Goldberg's avatar
Jody Goldberg committed
85
		v = value_new_float ((gnum_float) scm_num2dbl(scm, 0));
86 87

	if (gh_boolean_p (scm))
88 89
		v = value_new_bool ((gboolean) gh_scm2bool (scm));

90
	value = (SCM_Value *) scm_must_malloc (sizeof (SCM_Value), "value");
91 92
	value->v = v;
	value->update_func = SCM_BOOL_F;
93

94
	SCM_RETURN_NEWSMOB (value_tag, value);
95
}
96 97 98 99 100

static SCM
mark_value (SCM value_smob)
{
	SCM_Value *v = (SCM_Value *) SCM_CDR (value_smob);
101

102 103 104
	return v->update_func;
}

105
static scm_sizet
106 107 108 109
free_value (SCM value_smob)
{
	SCM_Value *v = (SCM_Value *) SCM_CDR (value_smob);
	scm_sizet size  = sizeof (SCM_Value);
110
	value_release (v->v);
111 112 113 114 115 116 117

	return size;
}

static int
print_value (SCM value_smob, SCM port, scm_print_state *pstate)
{
118
	//SCM_Value *v = (SCM_Value *) SCM_CDR (value_smob);
119

120
	scm_puts ("#<Value>", port);
121 122 123

	return 1;
}
124

125

126 127 128 129 130 131
static SCM
equalp_value (SCM value_smob_1, SCM value_smob_2)
{
	SCM_Value *v1 = (SCM_Value *) SCM_CDR (value_smob_1);
	SCM_Value *v2 = (SCM_Value *) SCM_CDR (value_smob_2);
	SCM flag;
132

133
	flag = (value_compare (v1->v, v2->v, TRUE))? SCM_BOOL_T : SCM_BOOL_F;
134 135 136

	return flag;
}
137

138 139 140 141 142 143 144
static SCM
scm_value_new_bool (SCM scm)
{
	Value *v;
	SCM_Value *value;

	v = g_new (Value, 1);
145 146

	if (gh_boolean_p (scm))
147 148 149 150 151
		v = value_new_bool ((gboolean) gh_scm2bool (scm));

	value = (SCM_Value *) scm_must_malloc (sizeof (SCM_Value), "value");
	value->v = v;
	value->update_func = SCM_BOOL_F;
152

153 154 155 156 157 158 159 160 161 162
	SCM_RETURN_NEWSMOB (value_tag, value);
}

static SCM
scm_value_new_float (SCM scm)
{
	Value *v;
	SCM_Value *value;

	v = g_new (Value, 1);
163

164 165

	if ((SCM_NFALSEP (scm_number_p(scm))))
Jody Goldberg's avatar
Jody Goldberg committed
166
		v = value_new_float ((gnum_float) scm_num2dbl(scm, 0));
167 168 169 170

	value = (SCM_Value *) scm_must_malloc (sizeof (SCM_Value), "value");
	value->v = v;
	value->update_func = SCM_BOOL_F;
171

172 173 174 175 176 177 178 179 180 181 182 183 184
	SCM_RETURN_NEWSMOB (value_tag, value);
}

static SCM
scm_value_new_string (SCM scm)
{
	Value *v;
	SCM_Value *value;

	v = g_new (Value, 1);

	if (SCM_NIMP (scm) && SCM_STRINGP (scm))
		v = value_new_string (SCM_CHARS (scm));
185

186 187 188
	value = (SCM_Value *) scm_must_malloc (sizeof (SCM_Value), "value");
	value->v = v;
	value->update_func = SCM_BOOL_F;
189

190 191 192
	SCM_RETURN_NEWSMOB (value_tag, value);
}

193 194 195 196
static SCM
scm_value_get_as_string (SCM value_smob)
{
	SCM_Value *v = (SCM_Value *) SCM_CDR (value_smob);
197

198 199 200 201 202 203 204 205 206 207 208 209
	if (v->v->type ==  VALUE_STRING)
		return scm_makfrom0str (value_get_as_string (v->v));

	return SCM_EOL;
}

static SCM
scm_value_get_as_int (SCM value_smob)
{
	SCM_Value *v = (SCM_Value *) SCM_CDR (value_smob);
	if (v->v->type ==  VALUE_INTEGER)
		return scm_long2num (value_get_as_int (v->v));
210

211 212 213 214 215 216 217 218 219 220 221 222 223
	return SCM_EOL;
}

static SCM
scm_value_get_as_float (SCM value_smob)
{
	SCM_Value *v = (SCM_Value *) SCM_CDR (value_smob);

	if (v->v->type ==  VALUE_FLOAT)
		return gh_double2scm (value_get_as_float (v->v));

		return SCM_EOL;
}
224

225 226 227 228 229 230 231 232 233
static SCM
scm_value_get_as_list (SCM value_smob)
{
	SCM_Value *v = (SCM_Value *) SCM_CDR (value_smob);

	if (v->v->type ==  VALUE_ARRAY)
		{
			int x, y, i, ii;
			SCM list, *ls = &list;
234

235 236 237 238 239 240
			x = v->v->v_array.x;
			y = v->v->v_array.y;

			for (i = 0; i < y; i++)
				for (ii = 0; i < x; i++)
					{
Ariel Rios's avatar
Ariel Rios committed
241
						*ls = scm_cons (gh_double2scm (value_get_as_float (v->v->v_array.vals[i][ii])), *ls); // FIXME
242 243 244 245 246 247 248 249 250 251
						ls = SCM_CDRLOC (*ls);
					}
			*ls = SCM_EOL;
			*ls = scm_reverse (*ls);
			return list;
		}

	return SCM_EOL;
}

252 253 254
void
init_value_type ()
{
255

256 257 258 259
	value_tag = scm_make_smob_type ("value", sizeof (SCM_Value));
	scm_set_smob_mark (value_tag, mark_value);
	scm_set_smob_free (value_tag, free_value);
	scm_set_smob_print (value_tag, print_value);
260
	scm_set_smob_equalp (value_tag, equalp_value);
261

262
	scm_make_gsubr ("make-value", 1, 0, 0, make_value);
263 264 265
	scm_make_gsubr ("value-new-bool", 1, 0, 0, scm_value_new_bool);
	scm_make_gsubr ("value-new-float", 1, 0, 0, scm_value_new_float);
	scm_make_gsubr ("value-new-string", 1, 0, 0, scm_value_new_string);
266 267 268 269
	scm_make_gsubr ("value-get-as-string", 1, 0, 0, scm_value_get_as_string);
	scm_make_gsubr ("value-get-as-int", 1, 0, 0, scm_value_get_as_int);
	scm_make_gsubr ("value-get-as-float", 1, 0, 0, scm_value_get_as_float);
	scm_make_gsubr ("value-get-as-list", 1, 0, 0, scm_value_get_as_list);
270 271
}

272 273