The R Project SVN R

Rev

Details | Last modification | View Log | RSS feed

Rev Author Line No. Line
6098 pd 1 
/*
2 
 *  RProxy: Connector implementation between application and R language
13365 ripley 3 
 *  Copyright (C) 1999--2001 Thomas Baier
26207 murdoch 4 
 *
6098 pd 5 
 *  This library is free software; you can redistribute it and/or
6 
 *  modify it under the terms of the GNU Library General Public
7 
 *  License as published by the Free Software Foundation; either
8 
 *  version 2 of the License, or (at your option) any later version.
26207 murdoch 9 
 *
6098 pd 10 
 *  This library is distributed in the hope that it will be useful,
11 
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of
12 
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
13 
 *  Library General Public License for more details.
26207 murdoch 14 
 *
6098 pd 15 
 *  You should have received a copy of the GNU Library General Public
16 
 *  License along with this library; if not, write to the Free
17 
 *  Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
18 
 *  MA 02111-1307, USA
6994 pd 19 
 *
26207 murdoch 20 
 *  $Id: rproxy.c,v 1.14 2003/09/13 15:14:09 murdoch Exp $
6098 pd 21 
 */
22 
 
8921 ripley 23 
#define NONAMELESSUNION
6098 pd 24 
#include <windows.h>
25 
#include <stdio.h>
18844 ripley 26 
#include <config.h>
19502 ripley 27 
#include <Rversion.h>
6098 pd 28 
#include "bdx.h"
29 
#include "SC_proxy.h"
30 
#include "rproxy_impl.h"
31 
#include <assert.h>
32 
#include <stdlib.h>
33 
 
13365 ripley 34 
#include <Defn.h>
35 
#include <Graphics.h>
36 
#include <Rdevices.h>
37 
 
26207 murdoch 38 
/* static connector information */
6994 pd 39 
#define CONNECTOR_NAME          "R Statistics Interpreter Connector"
40 
#define CONNECTOR_DESCRIPTION   "Implements abstract connector interface to R"
13365 ripley 41 
#define CONNECTOR_COPYRIGHT     "(C) 1999-2001, Thomas Baier"
6994 pd 42 
#define CONNECTOR_LICENSE       "GNU General Public License version 2 or greater"
17323 ripley 43 
#define CONNECTOR_VERSION_MAJOR "1"
44 
#define CONNECTOR_VERSION_MINOR "0"
6098 pd 45 
 
26207 murdoch 46 
/* interpreter information here at the moment until I know better... */
6994 pd 47 
#define INTERPRETER_NAME        "R"
48 
#define INTERPRETER_DESCRIPTION "A Computer Language for Statistical Data Analysis"
49 
#define INTERPRETER_COPYRIGHT   "(C) R Development Core Team"
50 
#define INTERPRETER_LICENSE     "GNU General Public License version 2 or greater"
51 
 
6098 pd 52 
typedef enum
53 
{
54 
  ps_none,
55 
  ps_initialized
56 
} R_Proxy_Object_State;
57 
 
6994 pd 58 
SC_CharacterDevice* __output_device;
13365 ripley 59 
SC_GraphicsDevice* __graphics_device;
6994 pd 60 
 
6098 pd 61 
typedef struct _R_Proxy_Object_Impl
62 
{
63 
  SC_Proxy_Object_Vtbl* vtbl;
64 
  R_Proxy_Object_State state;
65 
  int                   ref_count;
66 
} R_Proxy_Object_Impl;
67 
 
68 
int SYSCALL R_get_version (R_Proxy_Object_Impl* object,unsigned long* version)
69 
{
70 
  if ((object == NULL)
71 
      || (version == NULL))
72 
    {
73 
      return SC_PROXY_ERR_INVALIDARG;
74 
    }
75 
 
76 
  *version = SC_PROXY_INTERFACE_VERSION;
77 
 
78 
  return SC_PROXY_OK;
79 
}
80 
 
26207 murdoch 81 
/* 00-02-18 | baier | R_init(), R_Proxy_init() now take parameter-string */
13365 ripley 82 
int SYSCALL R_init (R_Proxy_Object_Impl* object,char const* parameters)
6098 pd 83 
{
84 
  int lRc = SC_PROXY_ERR_UNKNOWN;
85 
 
86 
  if (object == NULL)
87 
    {
88 
      return SC_PROXY_ERR_INVALIDARG;
89 
    }
26207 murdoch 90 
 
6098 pd 91 
  if (object->state != ps_none)
92 
    {
93 
      return SC_PROXY_ERR_INITIALIZED;
94 
    }
95 
 
13365 ripley 96 
  lRc = R_Proxy_init (parameters);
6098 pd 97 
 
98 
  if (lRc == SC_PROXY_OK)
99 
    {
100 
      object->state = ps_initialized;
101 
    }
6994 pd 102 
 
6098 pd 103 
  return lRc;
104 
}
105 
 
106 
int SYSCALL R_terminate (R_Proxy_Object_Impl* object)
107 
{
108 
  int lRc = SC_PROXY_ERR_UNKNOWN;
109 
 
110 
  if (object == NULL)
111 
    {
112 
      return SC_PROXY_ERR_INVALIDARG;
113 
    }
26207 murdoch 114 
 
6098 pd 115 
  if (object->state != ps_initialized)
116 
    {
117 
      return SC_PROXY_ERR_NOTINITIALIZED;
118 
    }
119 
 
120 
  lRc = R_Proxy_term ();
121 
 
122 
  if (lRc == SC_PROXY_OK)
123 
    {
124 
      object->state = ps_none;
125 
    }
126 
 
127 
  return lRc;
128 
}
129 
 
130 
int SYSCALL R_retain (R_Proxy_Object_Impl* object)
131 
{
132 
  if (object == NULL)
133 
    {
134 
      return SC_PROXY_ERR_INVALIDARG;
135 
    }
136 
 
137 
  assert (object->ref_count > 0);
138 
 
139 
  (object->ref_count)++;
140 
 
141 
  return SC_PROXY_OK;
142 
}
143 
 
26207 murdoch 144 
/* 00-06-19 | baier | release graphics device */
6098 pd 145 
int SYSCALL R_release (R_Proxy_Object_Impl* object)
146 
{
147 
  if (object == NULL)
148 
    {
149 
      return SC_PROXY_ERR_INVALIDARG;
150 
    }
151 
 
26207 murdoch 152 
  /* reference count must not be 0 here */
6098 pd 153 
  assert (object->ref_count > 0);
154 
 
155 
  (object->ref_count)--;
156 
 
157 
  if (object->ref_count > 0)
158 
    {
159 
      return SC_PROXY_OK;
160 
    }
161 
 
162 
  if (object->state != ps_none)
163 
    {
164 
      return SC_PROXY_ERR_INITIALIZED;
165 
    }
26207 murdoch 166 
 
6994 pd 167 
  if (__output_device)
168 
    {
169 
      __output_device->vtbl->release (__output_device);
170 
      __output_device = NULL;
171 
    }
172 
 
13365 ripley 173 
  if (__graphics_device)
174 
    {
175 
      __graphics_device->vtbl->release (__graphics_device);
176 
      __graphics_device = NULL;
177 
    }
178 
 
6098 pd 179 
  free (object);
26207 murdoch 180 
 
6098 pd 181 
  return SC_PROXY_OK;
182 
}
183 
 
184 
int SYSCALL R_set_symbol (R_Proxy_Object_Impl* object,
185 
			  char const* symbol,
186 
			  BDX_Data* data)
187 
{
188 
  int lRc = 0;
189 
 
26207 murdoch 190 
  /* check parameters */
6098 pd 191 
  if ((object == NULL)
192 
      || (symbol == NULL)
193 
      || (strlen (symbol) == 0)
194 
      || (data == NULL))
195 
    {
196 
      return SC_PROXY_ERR_INVALIDARG;
197 
    }
26207 murdoch 198 
 
6994 pd 199 
  if (data->version != BDX_VERSION)
6098 pd 200 
    {
201 
      return SC_PROXY_ERR_INVALIDFORMAT;
202 
    }
26207 murdoch 203 
 
6098 pd 204 
  lRc = R_Proxy_set_symbol (symbol,data);
205 
 
206 
  return lRc;
207 
}
208 
 
209 
int SYSCALL R_get_symbol (R_Proxy_Object_Impl* object,
210 
			  char const* symbol,
211 
			  BDX_Data** data)
212 
{
213 
  int lRc = 0;
214 
 
26207 murdoch 215 
  /* check parameters */
6098 pd 216 
  if ((object == NULL)
217 
      || (symbol == NULL)
218 
      || (strlen (symbol) == 0)
219 
      || (data == NULL))
220 
    {
221 
      return SC_PROXY_ERR_INVALIDARG;
222 
    }
223 
 
224 
  lRc = R_Proxy_get_symbol (symbol,data);
225 
 
226 
  if (lRc == SC_PROXY_OK)
227 
    {
6994 pd 228 
      (*data)->version = BDX_VERSION;
6098 pd 229 
    }
230 
 
231 
  return lRc;
232 
}
233 
 
234 
int SYSCALL R_evaluate (R_Proxy_Object_Impl* object,
235 
			char const* command,
236 
			BDX_Data** data )
237 
{
238 
  if ((object == NULL)
239 
      || (command == NULL)
240 
      || (strlen (command) == 0)
241 
      || (data == NULL))
242 
    {
243 
      return SC_PROXY_ERR_INVALIDARG;
244 
    }
245 
 
246 
  if (object->state != ps_initialized)
247 
    {
248 
      return SC_PROXY_ERR_NOTINITIALIZED;
249 
    }
26207 murdoch 250 
 
6098 pd 251 
  return R_Proxy_evaluate (command,data);
252 
}
253 
 
254 
int SYSCALL R_evaluate_noreturn (R_Proxy_Object_Impl* object,
255 
				 char const* command)
256 
{
257 
  if ((object == NULL)
258 
      || (command == NULL)
259 
      || (strlen (command) == 0))
260 
    {
261 
      return SC_PROXY_ERR_INVALIDARG;
262 
    }
263 
 
264 
  if (object->state != ps_initialized)
265 
    {
266 
      return SC_PROXY_ERR_NOTINITIALIZED;
267 
    }
26207 murdoch 268 
 
6098 pd 269 
  return R_Proxy_evaluate_noreturn (command);
270 
}
271 
 
272 
 
273 
int SYSCALL R_query_types (R_Proxy_Object_Impl* object,
274 
			   long* type_mask)
275 
{
276 
  if ((object == NULL)
277 
      || (type_mask == NULL))
278 
    {
279 
      return SC_PROXY_ERR_INVALIDARG;
280 
    }
281 
 
6994 pd 282 
  *type_mask = (SC_TM_SCALAR_ALL | SC_TM_ARRAY_ALL | SC_TM_VECTOR_ALL);
6098 pd 283 
 
284 
  return SC_PROXY_OK;
285 
}
286 
 
287 
 
288 
int SYSCALL R_query_ops (R_Proxy_Object_Impl* object,
289 
			 long* op_mask)
290 
{
291 
  if ((object == NULL)
292 
      || (op_mask == NULL))
293 
    {
294 
      return SC_PROXY_ERR_INVALIDARG;
295 
    }
296 
 
297 
  *op_mask = 0;
298 
 
6994 pd 299 
  return SC_PROXY_ERR_NOTIMPL;
6098 pd 300 
}
301 
 
302 
int SYSCALL R_free_data_buffer (R_Proxy_Object_Impl* object,
303 
				BDX_Data* data)
304 
{
305 
  if ((data == NULL)
306 
      || (object == NULL))
307 
    {
308 
      return SC_PROXY_ERR_INVALIDARG;
309 
    }
310 
 
6994 pd 311 
  if (data->version != BDX_VERSION)
6098 pd 312 
    {
313 
      return SC_PROXY_ERR_INVALIDFORMAT;
314 
    }
26207 murdoch 315 
 
6098 pd 316 
  assert (data != NULL);
6994 pd 317 
  assert (data->version == BDX_VERSION);
6098 pd 318 
 
319 
  bdx_free (data);
26207 murdoch 320 
  /*  free (data); */
6098 pd 321 
 
322 
  return SC_PROXY_OK;
323 
}
324 
 
26207 murdoch 325 
/* 00-06-19 | baier | only set if version matches */
6994 pd 326 
int SYSCALL R_set_output_device (R_Proxy_Object_Impl* object,
327 
				 struct _SC_CharacterDevice* device)
328 
{
329 
  unsigned long lCurrentVersion = 0;
6098 pd 330 
 
6994 pd 331 
  if (object == NULL)
332 
    {
333 
      return SC_PROXY_ERR_INVALIDARG;
334 
    }
335 
 
336 
  if (__output_device)
337 
    {
338 
      __output_device->vtbl->release (__output_device);
339 
      __output_device = NULL;
340 
    }
341 
 
342 
  if (device == NULL)
343 
    {
344 
      return SC_PROXY_OK;
345 
    }
346 
 
13365 ripley 347 
  if (device->vtbl->get_version (device,
348 
				 &lCurrentVersion) != SC_PROXY_OK)
6994 pd 349 
    {
350 
      return SC_PROXY_ERR_UNKNOWN;
351 
    }
352 
 
353 
  if (lCurrentVersion != SC_CHARACTERDEVICE_VERSION)
354 
    {
355 
      return SC_PROXY_ERR_INVALIDINTERFACEVERSION;
356 
    }
357 
 
13365 ripley 358 
  __output_device = device;
6994 pd 359 
  __output_device->vtbl->retain (device);
360 
 
361 
  return SC_PROXY_OK;
362 
}
363 
 
364 
int SYSCALL R_query_info (R_Proxy_Object_Impl* object,
365 
			  long main_key,
366 
			  long sub_key,
367 
			  char const** information)
368 
{
369 
  if ((object == NULL)
370 
      || (information == NULL))
371 
    {
372 
      return SC_PROXY_ERR_INVALIDARG;
373 
    }
374 
 
375 
  switch (main_key)
376 
    {
377 
    case SC_INFO_MAIN_CONNECTOR:
378 
      switch (sub_key)
379 
	{
380 
	case SC_INFO_SUB_NAME:
381 
	  *information = INTERPRETER_NAME;
382 
	  break;
383 
	case SC_INFO_SUB_DESCRIPTION:
384 
	  *information = INTERPRETER_DESCRIPTION;
385 
	  break;
386 
	case SC_INFO_SUB_COPYRIGHT:
387 
	  *information = INTERPRETER_COPYRIGHT;
388 
	  break;
389 
	case SC_INFO_SUB_LICENSE:
390 
	  *information = INTERPRETER_LICENSE;
391 
	  break;
392 
	case SC_INFO_SUB_MINORVERSION:
393 
	  *information = R_MINOR;
394 
	  break;
395 
	case SC_INFO_SUB_MAJORVERSION:
396 
	  *information = R_MAJOR;
397 
	  break;
398 
	default:
399 
	  *information = "";
400 
	}
401 
      break;
402 
    case SC_INFO_MAIN_INTERPRETER:
403 
      switch (sub_key)
404 
	{
405 
	case SC_INFO_SUB_NAME:
406 
	  *information = CONNECTOR_NAME;
407 
	  break;
408 
	case SC_INFO_SUB_DESCRIPTION:
409 
	  *information = CONNECTOR_DESCRIPTION;
410 
	  break;
411 
	case SC_INFO_SUB_COPYRIGHT:
412 
	  *information = CONNECTOR_COPYRIGHT;
413 
	  break;
414 
	case SC_INFO_SUB_LICENSE:
415 
	  *information = CONNECTOR_LICENSE;
416 
	  break;
417 
	case SC_INFO_SUB_MINORVERSION:
418 
	  *information = CONNECTOR_VERSION_MINOR;
419 
	  break;
420 
	case SC_INFO_SUB_MAJORVERSION:
421 
	  *information = CONNECTOR_VERSION_MAJOR;
422 
	  break;
423 
	default:
424 
	  *information = "";
425 
	}
426 
      break;
427 
    default:
428 
      *information = "";
429 
    }
430 
 
431 
  return SC_PROXY_OK;
432 
}
26207 murdoch 433 
/* 01-01-25 | baier | new parameters */
17227 murrell 434 
int R_Proxy_Graphics_Driver (NewDevDesc* pDD,
13365 ripley 435 
			     char* pDisplay,
436 
			     double pWidth,
437 
			     double pHeight,
438 
			     double pPointSize,
439 
			     Rboolean pRecording,
440 
			     int pResize,
441 
			     struct _SC_GraphicsDevice* pDevice);
6994 pd 442 
 
443 
 
13365 ripley 444 
int SYSCALL R_set_graphics_device (struct _SC_Proxy_Object* object,
445 
				   struct _SC_GraphicsDevice* device)
446 
{
447 
  unsigned long lCurrentVersion = 0;
448 
 
449 
  if (object == NULL)
450 
    {
451 
      return SC_PROXY_ERR_INVALIDARG;
452 
    }
453 
 
454 
  if (__graphics_device)
455 
    {
26207 murdoch 456 
      /* remove the graphics device from the set of drivers */
457 
      /* @TB */
13365 ripley 458 
      __graphics_device->vtbl->release (__graphics_device);
459 
      __graphics_device = NULL;
460 
    }
461 
 
462 
  if (device == NULL)
463 
    {
464 
      return SC_PROXY_OK;
465 
    }
466 
 
467 
  if (device->vtbl->get_version (device,
468 
				 &lCurrentVersion) != SC_PROXY_OK)
469 
    {
470 
      return SC_PROXY_ERR_UNKNOWN;
471 
    }
472 
 
473 
  if (lCurrentVersion != SC_GRAPHICSDEVICE_VERSION)
474 
    {
475 
      return SC_PROXY_ERR_INVALIDINTERFACEVERSION;
476 
    }
477 
 
478 
  __graphics_device = device;
479 
  __graphics_device->vtbl->retain (device);
480 
 
26207 murdoch 481 
  /* add the graphics device to the set of drivers */
13365 ripley 482 
  {
17227 murrell 483 
    NewDevDesc* lDev = (NewDevDesc*) calloc (1, sizeof (NewDevDesc));
484 
    GEDevDesc *lDD;
13365 ripley 485 
 
486 
    /* Do this for early redraw attempts */
17227 murrell 487 
    lDev->displayList = R_NilValue;
19169 murrell 488 
    /* Make sure that this is initialised before a GC can occur.
489 
     * This (and displayList) get protected during GC
490 
     */
491 
    lDev->savedSnapshot = R_NilValue;
17227 murrell 492 
    R_Proxy_Graphics_Driver (lDev,
13365 ripley 493 
			     "ActiveXDevice 1",
494 
			     100.0,
495 
			     100.0,
496 
			     10.0,
497 
			     0,
498 
			     0,
499 
			     device);
500 
    gsetVar(install(".Device"),
501 
	    mkString("ActiveXDevice 1"), R_NilValue);
17227 murrell 502 
    lDD = GEcreateDevDesc(lDev);
503 
    addDevice((DevDesc*) lDD);
504 
    GEinitDisplayList(lDD);
13365 ripley 505 
  }
506 
  return SC_PROXY_OK;
507 
}
508 
 
26207 murdoch 509 
/* global object table */
6098 pd 510 
SC_Proxy_Object_Vtbl global_proxy_object_vtbl =
511 
{
512 
  (SC_PROXY_GET_VERSION) R_get_version,
513 
  (SC_PROXY_INIT) R_init,
514 
  (SC_PROXY_TERMINATE) R_terminate,
515 
  (SC_PROXY_RETAIN) R_retain,
516 
  (SC_PROXY_RELEASE) R_release,
517 
  (SC_PROXY_SET_SYMBOL) R_set_symbol,
518 
  (SC_PROXY_GET_SYMBOL) R_get_symbol,
519 
  (SC_PROXY_EVALUATE) R_evaluate,
520 
  (SC_PROXY_EVALUATE_NORETURN) R_evaluate_noreturn,
521 
  (SC_PROXY_QUERY_TYPES) R_query_types,
522 
  (SC_PROXY_QUERY_OPS) R_query_ops,
6994 pd 523 
  (SC_PROXY_FREE_DATA_BUFFER) R_free_data_buffer,
524 
  (SC_PROXY_SET_CHARACTERDEVICE) R_set_output_device,
13365 ripley 525 
  (SC_PROXY_QUERY_INFO) R_query_info,
526 
  (SC_PROXY_SET_GRAPHICSDEVICE) R_set_graphics_device
6098 pd 527 
};
528 
 
529 
int SYSCALL EXPORT SC_Proxy_get_object (SC_Proxy_Object** obj,
530 
					unsigned long version)
531 
{
532 
  R_Proxy_Object_Impl* proxy_object = NULL;
6994 pd 533 
 
6098 pd 534 
  if (obj == NULL)
535 
    {
536 
      return SC_PROXY_ERR_INVALIDARG;
537 
    }
26207 murdoch 538 
 
6098 pd 539 
  if (version != SC_PROXY_INTERFACE_VERSION)
540 
    {
6994 pd 541 
      return SC_PROXY_ERR_INVALIDINTERFACEVERSION;
6098 pd 542 
    }
543 
 
544 
  proxy_object = (R_Proxy_Object_Impl*) malloc (sizeof (R_Proxy_Object_Impl));
26207 murdoch 545 
 
6098 pd 546 
  proxy_object->vtbl = &global_proxy_object_vtbl;
547 
  proxy_object->state = ps_none;
548 
  proxy_object->ref_count = 1;
549 
 
550 
  *obj = (SC_Proxy_Object*) proxy_object;
6994 pd 551 
 
6098 pd 552 
  return SC_PROXY_OK;
553 
}