← Back to branch summary

~ubuntu-branches/debian/jessie/eso-midas/jessie

« back to all changes in this revision

Viewing changes to libsrc/agl/fintf-2.fc

  • Committer: Package Import Robot
  • Author(s): Ole Streicher
  • Date: 2014-04-22 14:44:58 UTC
  • Revision ID: package-import@ubuntu.com-20140422144458-okiwi1assxkkiz39
Tags: upstream-13.09pl1.2+dfsg
Import upstream version 13.09pl1.2+dfsg

Show diffs side-by-side

added added

removed removed

Lines of Context:
libsrc/agl/fintf-2.fc
 
1
/*===========================================================================
 
2
  Copyright (C) 1995-2009 European Southern Observatory (ESO)
 
3
 
 
4
  This program is free software; you can redistribute it and/or 
 
5
  modify it under the terms of the GNU General Public License as 
 
6
  published by the Free Software Foundation; either version 2 of 
 
7
  the License, or (at your option) any later version.
 
8
 
 
9
  This program is distributed in the hope that it will be useful,
 
10
  but WITHOUT ANY WARRANTY; without even the implied warranty of
 
11
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 
12
  GNU General Public License for more details.
 
13
 
 
14
  You should have received a copy of the GNU General Public 
 
15
  License along with this program; if not, write to the Free 
 
16
  Software Foundation, Inc., 675 Massachusetts Ave, Cambridge, 
 
17
  MA 02139, USA.
 
18
 
 
19
  Correspondence concerning ESO-MIDAS should be addressed as follows:
 
20
        Internet e-mail: midas@eso.org
 
21
        Postal address: European Southern Observatory
 
22
                        Data Management Division 
 
23
                        Karl-Schwarzschild-Strasse 2
 
24
                        D 85748 Garching bei Muenchen 
 
25
                        GERMANY
 
26
===========================================================================*/
 
27
 
 
28
/*
 
29
 * HEADER : fintf.fc    - Vers 3.6.001  - Sep 1993 -  L. Fini, M. Pucillo
 
30
 *                      - Vers 3.6.000  - Oct 1991 -  L. Fini, M. Pucillo
 
31
 *
 
32
 *
 
33
 * AGL FORTRAN to C interface --        Generic version to be filtered 
 
34
 *                                      in order to generate the machine 
 
35
 *                                      dependent code.
 
36
 *
 
37
 *
 
38
 * This module is a C layer needed to interface the AGL FORTRAN interface
 
39
 * Layer to the AGL standard C interface
 
40
 *
 
41
 * Entry points correspond one-to-one to standard C interface (except for
 
42
 * AGIDN routine which is directly implemented in FORTRAN in file agidn.for
 
43
 *
 
44
 * The two routines: AG_SCAN, AG_DMSG are available in the C interface only
 
45
 *
 
46
 * Modified: 910617. CG: Master Fortran to C file. 
 
47
 * Modified: 910825. CG: This code only compiled for Unix systems.
 
48
 * Modified: 920115. CG: For both VMS and UNIX.
 
49
 *
 
50
 * 090422       last modif
 
51
 *
 
52
 * ===============================
 
53
 *  AGL FORTRAN STANDARD INTERFACE
 
54
 *
 
55
 *
 
56
 *
 
57
 *
 
58
 *
 
59
 *  The following entry points define the AGL standard FORTRAN interface
 
60
 *
 
61
 *
 
62
 * I   - Status operations
 
63
 *
 
64
 * AGCLS
 
65
 *
 
66
 * AGCDEF ( XCLIP0, XCLIP1, YCLIP0, YCLIP1 ) 
 
67
 * 
 
68
 * AGSSET (STRING)
 
69
 *
 
70
 * AGVDEF ( DEVICE, IDENT, XA, XB, YA, YB, XLIM, YLIM )
 
71
 *
 
72
 * AGVKIL
 
73
 * 
 
74
 * AGVSEL ( IDENT )
 
75
 *
 
76
 * AGWDEF ( X0, X1, Y0, Y1 )
 
77
 *
 
78
 * 
 
79
 * II  - Graphic primitives
 
80
 *
 
81
 * AGGPLG ( X, Y, N )
 
82
 *
 
83
 * AGGPLL ( X, Y, N )
 
84
 * 
 
85
 * AGGPLM ( X, Y, N, MARK )
 
86
 *
 
87
 * AGGINT ( X, Y, N )
 
88
 *
 
89
 * AGGTXT ( XT, YT, STRING, CENTRE )
 
90
 *
 
91
 * AGVERS
 
92
 * 
 
93
 *
 
94
 * III - Get information
 
95
 *
 
96
 * AGIGET (STRING,IVECT)
 
97
 * 
 
98
 * AGRGET (STRING,RVECT)
 
99
 * 
 
100
 * AGTGET ( STRING, XL, YL )
 
101
 * 
 
102
 * AGVLOC ( X, Y, CHAR, PIXVAL )
 
103
 *
 
104
 * AGVLOS ( X, Y, MAXLEN, STR, PIXVAL )
 
105
 *
 
106
 *
 
107
 * IV  - Metafile manipulation
 
108
 *
 
109
 * AGMCLS
 
110
 * 
 
111
 * AGMOPN ( NAME )
 
112
 * 
 
113
 * AGMRDW ( MFILE )
 
114
 *
 
115
 * AGMRES
 
116
 * 
 
117
 * AGMSUS
 
118
 *
 
119
 *
 
120
 * V   - Miscellaneous
 
121
 *
 
122
 * AGESC ( CMD, CMDLEN )
 
123
 *
 
124
 * AGDRIV 
 
125
 *
 
126
 * AGIDN ( IDENT )
 
127
 * 
 
128
 * AGMAGN ( XFACT, YFACT, X, Y, N )
 
129
 *
 
130
 * AGTROT ( X, Y, N )
 
131
 *
 
132
 * AGTSET ( XFACT, YFACT, ANGLE, ITEM )
 
133
 *
 
134
 * AGVN2U ( XN, YN, XV, YV )
 
135
 * 
 
136
 * AGVU2N ( XU, YU, XN, YN )
 
137
 *
 
138
 * AGVUPD 
 
139
 *
 
140
 * VI   - High level routines
 
141
 *
 
142
 * AGAXES ( X0, X1, Y0, Y1, CMDSTR )
 
143
 *
 
144
 * AGAXIS ( TYPE, DATA, LSPACE, FORM, LABEL )
 
145
 *
 
146
 * AGORAX ( TYPE, ENDS, DATA, FORM, LABEL )
 
147
 *
 
148
 * AGHIST ( X, Y, N, MODE, JOIN )
 
149
 *
 
150
 * AGNLIN ( X0, X1, Y0, Y1, CMDSTR )
 
151
 *
 
152
 */
 
153
 
 
154
 
 
155
#include <stdio.h>
 
156
#include <proto_agl.h>
 
157
 
 
158
#include <stdlib.h>
 
159
#include <string.h>
 
160
 
 
161
#ifndef MIN
 
162
#define MIN(x,y)        ((x) <= (y) ? (x):(y) )    /* Minimum */
 
163
#endif /* MIN */
 
164
 
 
165
int   mm;
 
166
char *ptr1, *ptr2;
 
167
extern char *loc_pntr(int jdx,int* loclen);
 
168
extern char *strp_pntr(int jdx);
 
169
 
 
170
/*
 
171
 
 
172
*/
 
173
 
 
174
/* I   - Status operations */
 
175
 
 
176
ROUTINE AGCDEF (x1,x2,y1,y2)
 
177
float *x1;
 
178
float *x2;
 
179
float *y1;
 
180
float *y2; 
 
181
 
 
182
{ 
 
183
AG_CDEF ( *x1, *x2, *y1, *y2 ); 
 
184
return 0;
 
185
}
 
186
 
 
187
ROUTINE AGCLS () { AG_CLS (); return 0;}
 
188
 
 
189
/*==========================================================================*/
 
190
 
 
191
/*** stat =  AG_SSET(command) ***/
 
192
 
 
193
ROUTINE AGL1 (status)
 
194
int  *status;   /* dummy argument - not used */
 
195
 
 
196
{ 
 
197
ptr1 = strp_pntr(1);            /* get stripped string of "command" */
 
198
 
 
199
AG_SSET (ptr1);
 
200
return 0;
 
201
}
 
202
 
 
203
/*==========================================================================*/
 
204
 
 
205
/*** stat =  AGVDEF ( device, xa,xb,ya,yb,xlim,ylim) ***/
 
206
 
 
207
ROUTINE AGL2 ( xa,xb,ya,yb,xlim,ylim)
 
208
float *xa;
 
209
float *xb;
 
210
float *ya;
 
211
float *yb;
 
212
float *xlim;
 
213
float *ylim;
 
214
 
 
215
{
 
216
ptr1 = strp_pntr(1);            /* get stripped string of "device" */
 
217
 
 
218
(void) AG_VDEF(ptr1, *xa, *xb, *ya, *yb, *xlim, *ylim);
 
219
return 0;
 
220
}
 
221
 
 
222
ROUTINE AGVKIL () { AG_VKIL (); return 0;}
 
223
 
 
224
ROUTINE AGVSEL (id)
 
225
int *id;        
 
226
 
 
227
{ 
 
228
AG_VSEL ( *id ); 
 
229
return 0;
 
230
}
 
231
 
 
232
ROUTINE AGWDEF (x1,x2,y1,y2)
 
233
float *x1;
 
234
float *x2;
 
235
float *y1;
 
236
float *y2; 
 
237
 
 
238
{ 
 
239
AG_WDEF ( *x1, *x2, *y1, *y2 ); 
 
240
return 0;
 
241
}
 
242
 
 
243
/* II  - Graphic primitives */
 
244
 
 
245
ROUTINE AGGPLG (xv,yv,np)
 
246
float xv[];
 
247
float yv[];
 
248
int *np;
 
249
 
 
250
{ 
 
251
AG_GPLG ( xv, yv, *np ); 
 
252
return 0;
 
253
}
 
254
 
 
255
ROUTINE AGGPLL (xv,yv,np)
 
256
float xv[];
 
257
float yv[];
 
258
int *np;
 
259
 
 
260
{ 
 
261
AG_GPLL ( xv, yv, *np ); 
 
262
return 0;
 
263
}
 
264
 
 
265
ROUTINE AGGPLM (xv,yv,np,mark)
 
266
float xv[];
 
267
float yv[];
 
268
int  *np;
 
269
int  *mark;
 
270
 
 
271
{ 
 
272
AG_GPLM ( xv, yv, *np, *mark ); 
 
273
return 0;
 
274
}
 
275
 
 
276
ROUTINE AGGINT (xv,yv,np)
 
277
float xv[];
 
278
float yv[];
 
279
int *np;
 
280
 
 
281
{ 
 
282
AG_GINT ( xv, yv, *np ); 
 
283
return 0;
 
284
}
 
285
 
 
286
/*==========================================================================*/
 
287
 
 
288
/*** void AGGTXT (xc,yc,str,cntr) ***/
 
289
 
 
290
ROUTINE AGL3 (xc,yc,cntr)
 
291
float *xc;
 
292
float *yc;
 
293
int  *cntr;
 
294
 
 
295
{ 
 
296
ptr1 = strp_pntr(1);            /* get stripped string of "str" */
 
297
 
 
298
AG_GTXT ( *xc, *yc, ptr1, *cntr ); 
 
299
return 0;
 
300
}
 
301
 
 
302
ROUTINE AGVERS () { AG_VERS (); return 0;}
 
303
 
 
304
/*==========================================================================*/
 
305
 
 
306
/*** void AGGERR (code,mesg) ***/
 
307
 
 
308
ROUTINE AGL4 (code)
 
309
int *code;
 
310
 
 
311
{ 
 
312
ptr1 = strp_pntr(1);            /* get stripped string of "mesg" */
 
313
 
 
314
AG_GERR( *code,ptr1);
 
315
return 0;
 
316
}
 
317
 
 
318
 
 
319
ROUTINE AGISET (ints,numb) 
 
320
int ints[],numb;  
 
321
 
 
322
{ 
 
323
AG_ISET (numb,ints); 
 
324
return 0;
 
325
}
 
326
 
 
327
ROUTINE AGRSET (floats,numb) 
 
328
float floats[]; int numb; 
 
329
 
 
330
{ 
 
331
AG_RSET(numb,floats); 
 
332
return 0;
 
333
}
 
334
 
 
335
/* III - Get information */
 
336
 
 
337
 
 
338
/*==========================================================================*/
 
339
 
 
340
/*** int AG_IGET (item,ival) ***/
 
341
 
 
342
ROUTINE AGL5 (ival) 
 
343
int *ival;
 
344
 
 
345
{
 
346
int  n;
 
347
 
 
348
ptr1 = strp_pntr(1);            /* get stripped string of "item" */
 
349
 
 
350
n = AG_IGET ( ptr1, ival ); 
 
351
return 0;
 
352
}
 
353
 
 
354
/*==========================================================================*/
 
355
 
 
356
/*** int AG_RGET (item,fval) ***/
 
357
 
 
358
 
 
359
ROUTINE AGL6 (fval) 
 
360
float *fval;
 
361
 
 
362
{ 
 
363
int  n;
 
364
 
 
365
ptr1 = strp_pntr(1);            /* get stripped string of "item" */
 
366
 
 
367
n = AG_RGET (ptr1, fval ); 
 
368
return 0;
 
369
}
 
370
 
 
371
 
 
372
/*==========================================================================*/
 
373
 
 
374
/*** void AG_TGET (item,xd,yd) ***/
 
375
 
 
376
 
 
377
ROUTINE AGL7 (xd,yd)
 
378
float  *xd;
 
379
float  *yd;
 
380
 
 
381
{
 
382
ptr1 = strp_pntr(1);            /* get stripped string of "item" */
 
383
 
 
384
AG_TGET (ptr1, xd, yd ); 
 
385
return 0;
 
386
}
 
387
 
 
388
ROUTINE AGVLOC (xv,yv,key,pixval)
 
389
float *xv;
 
390
float *yv;
 
391
int *key;
 
392
int *pixval;
 
393
 
 
394
{
 
395
AG_VLOC ( xv, yv, key, pixval ); 
 
396
return 0;
 
397
}
 
398
 
 
399
 
 
400
/*==========================================================================*/
 
401
 
 
402
/*** void AG_VLOS (xv,yv,maxlen,chstrg,pixval) ***/
 
403
 
 
404
ROUTINE AGL8 (xv,yv,maxlen,pixval)
 
405
float *xv;
 
406
float *yv;
 
407
int  *maxlen;
 
408
int  *pixval;
 
409
 
 
410
{
 
411
int  nn;
 
412
 
 
413
 
 
414
ptr1 = loc_pntr(1,&mm);            /* get location of "chstrg" */
 
415
 
 
416
AG_VLOS ( xv, yv, (mm-1), ptr1, pixval ); 
 
417
 
 
418
nn = (int) strlen(ptr1);
 
419
if (nn < mm) *(ptr1+mm) = ' ';
 
420
return 0;
 
421
}
 
422
 
 
423
/* IV  - Metafile manipulation */
 
424
 
 
425
ROUTINE AGMCLS () { AG_MCLS (); return 0;}
 
426
 
 
427
 
 
428
/*==========================================================================*/
 
429
 
 
430
/*** void AG_MOPN (fname) ***/
 
431
 
 
432
ROUTINE AGL9 ( status )
 
433
int  *status;
 
434
 
 
435
{
 
436
ptr1 = strp_pntr(1);            /* get stripped string of "fname" */
 
437
 
 
438
AG_MOPN (ptr1);
 
439
return 0;
 
440
}
 
441
 
 
442
/*==========================================================================*/
 
443
 
 
444
/*** void AG_MRDW (metafile) ***/
 
445
 
 
446
ROUTINE AGL10 ( status )
 
447
int  *status;
 
448
 
 
449
{
 
450
ptr1 = strp_pntr(1);            /* get stripped string of "metafile" */
 
451
 
 
452
AG_MRDW (ptr1);
 
453
return 0;
 
454
}
 
455
 
 
456
ROUTINE AGMRES () { AG_MRES (); return 0;}
 
457
 
 
458
ROUTINE AGMSUS () { AG_MSUS (); return 0;}
 
459
 
 
460
/* V  - Miscellaneus */
 
461
 
 
462
 
 
463
/*==========================================================================*/
 
464
 
 
465
/*** void AG_ESC (cmd,cmdlen) ***/
 
466
 
 
467
ROUTINE AGL11 (cmdlen)
 
468
int *cmdlen;
 
469
 
 
470
{
 
471
ptr1 = strp_pntr(1);            /* get stripped string of "cmd" */
 
472
 
 
473
AG_ESC ( ptr1, *cmdlen ); 
 
474
return 0;
 
475
}
 
476
 
 
477
ROUTINE AGDRIV () { AG_DRIV (); return 0;}
 
478
 
 
479
ROUTINE AGMAGN (xfact,yfact,xv,yv,np)
 
480
float *xfact;
 
481
float *yfact;
 
482
float xv[];
 
483
float yv[];
 
484
int *np;
 
485
 
 
486
{
 
487
AG_MAGN( *xfact, *yfact, xv, yv, *np ); 
 
488
return 0;
 
489
}
 
490
 
 
491
ROUTINE AGTROT (xv,yv,np)
 
492
float xv[];
 
493
float yv[];
 
494
int *np;
 
495
 
 
496
{
 
497
AG_TROT ( xv, yv, *np ); 
 
498
return 0;
 
499
}
 
500
 
 
501
ROUTINE AGTSET (xoff,yoff,angle,item)
 
502
float *xoff;
 
503
float *yoff;
 
504
float *angle;
 
505
int   *item;
 
506
 
 
507
{
 
508
AG_TSET ( *xoff, *yoff, *angle, *item ); 
 
509
return 0;
 
510
}
 
511
 
 
512
ROUTINE AGVN2U (xn,yn,xu,yu)
 
513
float *xn;
 
514
float *yn;
 
515
float *xu;
 
516
float *yu;
 
517
 
 
518
{
 
519
AG_VN2U ( *xn, *yn, xu, yu ); 
 
520
return 0;
 
521
}
 
522
 
 
523
ROUTINE AGVU2N (xu,yu,xn,yn)
 
524
float *xu;
 
525
float *yu;
 
526
float *xn;
 
527
float *yn;
 
528
 
 
529
{
 
530
AG_VU2N ( *xu, *yu, xn, yn ); 
 
531
return 0;
 
532
}
 
533
 
 
534
ROUTINE AGVUPD () { AG_VUPD (); return 0;}
 
535
 
 
536
/* VI - High level routines */
 
537
 
 
538
 
 
539
/*==========================================================================*/
 
540
 
 
541
/*** void AG_AXES (x1,x2,y1,y2,string) ***/
 
542
 
 
543
ROUTINE AGL12 (x1,x2,y1,y2)
 
544
float *x1;
 
545
float *x2;
 
546
float *y1;
 
547
float *y2; 
 
548
 
 
549
{ 
 
550
ptr1 = strp_pntr(1);            /* get stripped string of "string" */
 
551
 
 
552
AG_AXES ( *x1, *x2, *y1, *y2,ptr1);
 
553
return 0;
 
554
}
 
555
 
 
556
/*==========================================================================*/
 
557
 
 
558
/*** void AG_AXIS (type, data, lspace, form, label) ***/
 
559
 
 
560
ROUTINE AGL13 (type, data, lspace)
 
561
int *type;
 
562
float *data;
 
563
float *lspace;
 
564
 
 
565
{ 
 
566
ptr1 = strp_pntr(1);            /* get stripped string of "form" */
 
567
ptr2 = strp_pntr(2);            /* get stripped string of "label" */
 
568
 
 
569
AG_AXIS( *type, data, *lspace, ptr1, ptr2);
 
570
return 0;
 
571
}
 
572
 
 
573
/*==========================================================================*/
 
574
 
 
575
/*** void AG_ORAX ( type, ends, data, form, label ) ***/
 
576
 
 
577
ROUTINE AGL14 (type, ends, data )
 
578
int *type;
 
579
float *ends;
 
580
float *data;
 
581
 
 
582
{ 
 
583
ptr1 = strp_pntr(1);            /* get stripped string of "form" */
 
584
ptr2 = strp_pntr(2);            /* get stripped string of "label" */
 
585
 
 
586
AG_ORAX( *type, ends, data, ptr1, ptr2);
 
587
return 0;
 
588
}
 
589
 
 
590
ROUTINE AGHIST (xv,yv,np,mode,join)
 
591
float *xv;
 
592
float *yv; 
 
593
int *np;
 
594
int *mode;
 
595
int *join;
 
596
 
 
597
{ 
 
598
AG_HIST ( xv, yv, *np, *mode, *join ); 
 
599
return 0;
 
600
}
 
601
 
 
602
 
 
603
/*==========================================================================*/
 
604
 
 
605
/*** void AG_NLIN(x1,x2,y1,y2,string) ***/
 
606
 
 
607
ROUTINE AGL15 (x1,x2,y1,y2)
 
608
float *x1;
 
609
float *x2;
 
610
float *y1;
 
611
float *y2; 
 
612
 
 
613
{ 
 
614
ptr1 = strp_pntr(1);            /* get stripped string of "string" */
 
615
 
 
616
AG_NLIN ( *x1, *x2, *y1, *y2,ptr1);
 
617
return 0;
 
618
}
 
619
 
 
620
 
 
621
/*==========================================================================*/
 
622
 
 
623
/*** void AG_FILL(x,y,n,space,angle,sset) ***/
 
624
 
 
625
ROUTINE AGL16(x,y,n,space,angle)
 
626
float *x;
 
627
float *y;
 
628
int   *n;
 
629
float *space;
 
630
float *angle;
 
631
 
 
632
{
 
633
ptr1 = strp_pntr(1);            /* get stripped string of "sset" */
 
634
 
 
635
AG_FILL( x, y, *n, *space, *angle, ptr1);
 
636
return 0;
 
637
}
 
638