← Back to branch summary

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

« back to all changes in this revision

Viewing changes to prim/tw3/libsrc/tfcc.c

  • 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:
prim/tw3/libsrc/tfcc.c
 
1
/*===========================================================================
 
2
  Copyright (C) 1989-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 Massachusetss Ave, Cambridge, 
 
17
  MA 02139, USA.
 
18
 
 
19
  Corresponding 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
.NAME           tfcc.c
 
30
.TYPE           Module
 
31
.LANGUAGE       C
 
32
.CATEGORY       User interface, forms handling.
 
33
.ENVIRONMENT    TermWindows
 
34
.AUTHOR         Alan Richmond, Francois Ochsenbein
 
35
.VERSION  1.0   08-Jun-1989     Extracted from Proteus
 
36
 
 
37
 090902         last modif
 
38
---------------------------*/
 
39
 
 
40
#define PM_LEVEL        LEVEL_TF
 
41
 
 
42
#define  PASCAL_DEF     0       /* Don't include Pascalisation  */
 
43
 
 
44
#include <stesodef.h>   /* Standard definitions */
 
45
#include <tform.h>      /* for form values      */
 
46
#include <cc.h>         /* for Ccode compilation*/
 
47
 
 
48
 
 
49
extern int cc_exec(), cc_ext(), cc_fct(), cc_glb(), cc_compile();
 
50
 
 
51
extern int eh_put1();
 
52
 
 
53
 
 
54
 
 
55
/*======================================================================*/
 
56
static int tfexec(form)
 
57
/*+++++++++++
 
58
.PURPOSE Routine called to derive Computed fields.
 
59
.RETURNS OK.
 
60
-------------*/
 
61
        TFORM   *form;          /* IN: The Form */
 
62
{
 
63
  return(cc_Execute(form->pgmno));
 
64
}
 
65
 
 
66
/*======================================================================*/
 
67
static int check(form, str, size)
 
68
/*+++++++++++
 
69
.PURPOSE Routine called to derive Computed fields.
 
70
.RETURNS OK.
 
71
-------------*/
 
72
        TFORM   *form;          /* IN: The Form */
 
73
        char    *str;           /* IN: Input String */
 
74
        int     size;           /* IN: Input String Size */
 
75
{
 
76
  return(cc_Execute(form->pgmcheck));
 
77
}
 
78
 
 
79
/*======================================================================*/
 
80
static int err(msg)
 
81
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
82
.PURPOSE Error Function
 
83
.RETURNS NOK.
 
84
------------------------------------------------------------------------*/
 
85
        char    *msg;           /* IN: The Message      */
 
86
{
 
87
  ERROR(msg);
 
88
  return(NOK);
 
89
}
 
90
 
 
91
/*======================================================================*/
 
92
static int isnull(addr)
 
93
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
94
.PURPOSE Check if a Number is Null
 
95
.RETURNS 0 (false) / 1 (true)
 
96
------------------------------------------------------------------------*/
 
97
        long    addr[2];        /* IN: The Message      */
 
98
{
 
99
        char    *x;
 
100
        int     result;
 
101
 
 
102
  result = 0;           /* FALSE = is NOT null  */
 
103
 
 
104
  x = (char *)addr - sizeof(addr) - sizeof(short) - sizeof(char);
 
105
  if ((*x & 0xf) == _DTYPE_INT) result = (addr[0] == addr[1]);
 
106
 
 
107
  return(result);
 
108
}
 
109
 
 
110
/*======================================================================*/
 
111
static int tonull(addr)
 
112
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
113
.PURPOSE Set a number to NULL
 
114
.RETURNS 0 (bad) / 1 (done)
 
115
------------------------------------------------------------------------*/
 
116
        long    addr[2];        /* IN: The Message      */
 
117
{
 
118
        char    *x;
 
119
        int     result;
 
120
 
 
121
  result = 0;           /* FALSE = is NOT null  */
 
122
 
 
123
  x = (char *)addr - sizeof(addr) - sizeof(short) - sizeof(char);
 
124
  if ((*x & 0xf) == _DTYPE_INT) 
 
125
        addr[0] = addr[1],
 
126
        result = 1;
 
127
 
 
128
  return(result);
 
129
}
 
130
 
 
131
/*======================================================================*/
 
132
static int ccbind(form)
 
133
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
134
.PURPOSE Bind variables for Ccode
 
135
.RETURNS NOK.
 
136
------------------------------------------------------------------------*/
 
137
        TFORM   *form;                  /* IN: The form Concerned       */
 
138
{
 
139
        int     i;
 
140
        TFIELD  *field;
 
141
 
 
142
  cc_BindAddress("int $", &(form->avalue));
 
143
  cc_BindFunction("int ERROR",  1, err);
 
144
  cc_BindFunction("int isnull", 1, isnull);
 
145
  cc_BindFunction("int tonull", 1, tonull);
 
146
 
 
147
  for (i = form->nfields, field = form->fields; --i >=0; field++) 
 
148
  {     if (field->string_size == 0)    continue;
 
149
        switch(field->type & 7) 
 
150
        {
 
151
                case _DTYPE_INT:
 
152
                        cc_BindInteger(field->name,field->value.integer);
 
153
                        break;
 
154
                case _DTYPE_DOUBLE: case _DTYPE_FLOAT:
 
155
                        cc_BindDouble(field->name,field->value.real);
 
156
                        break;
 
157
                default:        /* Strings */
 
158
                        cc_BindString(field->name, field->string);
 
159
                        break;
 
160
        }               
 
161
  }
 
162
 
 
163
  return(OK);
 
164
}
 
165
 
 
166
/*======================================================================*/
 
167
int tf_cc(form, source, exe_hook)
 
168
/*+++++++++++
 
169
.PURPOSE Compile source code if any.
 
170
.RETURNS The program number (0 when error).
 
171
.REMARKS If other variables than those specified in the Form are necessary,
 
172
        use BEFORE the call to tf_cc the cc_BindInteger / cc_BindDouble /
 
173
        cc_BindString / cc_BindFunction (see cc.h)
 
174
-------------*/
 
175
        TFORM   *form;          /* MOD: The form Concerned      */
 
176
        char    *source;        /* IN: Code to compile          */
 
177
        int     exe_hook;       /* IN: 0 for Compute / 1 for Check      */
 
178
{
 
179
        int     ret;
 
180
 
 
181
  if(source)    ccbind(form),   /* Bind Variables       */
 
182
                ret = cc_Compile(source);
 
183
  else          ret = 0;
 
184
        
 
185
  if(ret)       
 
186
  {     if (exe_hook)   form->check_fct   = check,  form->pgmcheck = ret;
 
187
        else            form->compute_fct = tfexec, form->pgmno    = ret;
 
188
  }
 
189
 
 
190
  return(ret);
 
191
}
 
192