/*===========================================================================
  Copyright (C) 1995-2010 European Southern Observatory (ESO)
 
  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 of 
  the License, 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 Massachusetts Ave, Cambridge, 
  MA 02139, USA.
 
  Correspondence concerning ESO-MIDAS should be addressed as follows:
	Internet e-mail: midas@eso.org
	Postal address: European Southern Observatory
			Data Management Division 
			Karl-Schwarzschild-Strasse 2
			D 85748 Garching bei Muenchen 
			GERMANY
===========================================================================*/

/*+++++++++++++++++++  MIDAS monitor routines PREPC4  +++++++++++++++++++++++++
.LANGUAGE    C
.IDENTIFICATION  Module PREPC4
.ENVIRONMENT VMS and UNIX
.AUTHOR  K. Banse                  	ESO - Garching
.COMMENTS    
holds DO_KEYS, IMMEDIATE, DESCR_ACCESS
.KEYWORDS  MIDAS monitor
.VERSION  [1.00] 870908: built from FORTRAN version 3.23 of 870325
 
 100616		last modif
-------------------------------------------------------------------------*/
 
 
#include <fileexts.h>
#include <osyparms.h>
#include <monitdef.h>
#include <midback.h>
 
#include <string.h>
#include <stdio.h>
#include <stdlib.h>
 

static int  work_size = 0;

static char  *work_str;
static char  warnmess[] = "Warning: Superfluous chars. on right hand side";

/*

*/
 
#ifdef __STDC__
int DO_KEYS(char key_task, char *prompt)
#else
int DO_KEYS(key_task,prompt)
 
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE
  handle INQUIRE, DELETE, READ, COPY + WRITE/KEY here directly
.ALGORITHM
  use ST interfaces in C to access the keywords
.RETURNS
  status: MIDAS error codes
------------------------------------------------------------------*/
 
char	key_task   /* IN: = R, D, I, L, C or W  */;
char	*prompt    /* IN: points to prompt in case of I(nquire)  */;
#endif
 
{
int   cnvno, *ibuf, iall;
int   first, bytelem, noelem;
int    sbytelem, snoelem;
int   lkey, klen, nb, wr_remote;
int   stat, kk, n, nn, start, slen, copy_1;
int   iwa[5], errflg;
int   unit, nullo;
register int  nr;
	
char	k_type[4], type[16], cc[4], keyname[32], *cbuf, substr[24];
char	*xbuf, type_save[4];
char    myfram[200];
register char cr;
 
float	*rbuf, rall, rwa[2];
	
double	*dbuf, dall, dwa[2];

size_t	*sbuf, sall;


 
type_save[0] = '\0';
stat = wr_remote = 0;
if (work_size == 0)
   {
   work_size = 800;		/* start with buffer for 800 chars.  */
   work_str = malloc((size_t)work_size);
   }
dbuf = (double *)work_str;
ibuf = (int *)work_str;
rbuf = (float *)work_str;
sbuf = (size_t *)work_str;
cbuf = work_str;
copy_1 = 0;
errflg = 1;				/* default error_str to 2. token  */
ERRO_LOG = 1;				/* save lower level errors ... */ 

 
/*   branch according to action  */
 
if (key_task == 'R')
   {                            /*---------
	                           read keys
	                         -----------*/

   if (TOKEN[1].STR[0] == '?') TOKEN[1].STR[0] = '*';

   /*  display or really read key(s)  */

   if ((server.MODE == 1) && (server.FUNC == 30))	/* that's a XCKRDx */
      {
      lkey = CGN_INDEXC(TOKEN[1].STR,'/');
      (void) strncpy(keyname,TOKEN[1].STR,(size_t)lkey);
      keyname[lkey] = '\0';
      start = lkey + 1;
      slen = CGN_EXTRSS(TOKEN[1].STR,TOKEN[1].LEN,'/',&start,type,15);
      MID_TYPCHK(type,cc,&nn);
      type[0] = cc[0];
      bytelem = nn;
      slen = CGN_EXTRSS(TOKEN[1].STR,TOKEN[1].LEN,'/',&start,substr,20);
      n = CGN_CNVT(substr,1,1,&first,rwa,dwa);
      slen = CGN_EXTRSS(TOKEN[1].STR,TOKEN[1].LEN,'/',&start,substr,20);
      n = CGN_CNVT(substr,1,1,&noelem,rwa,dwa);

      cnvno = 1;			/* in case SCKRDx fails */
      if (type[0] == 'I')
         {
         iwa[0] = 1;
         *ibuf = 0;
         stat = SCKRDI(keyname,first,noelem,&cnvno,ibuf,&unit,&nullo);
         }
      else if (type[0] == 'R')
         {
         iwa[0] = 2;
         *rbuf = 0.0;
         stat = SCKRDR(keyname,first,noelem,&cnvno,rbuf,&unit,&nullo);
         }
      else if (type[0] == 'D')
         {
         iwa[0] = 4;
         *dbuf = 0.0;
         stat = SCKRDD(keyname,first,noelem,&cnvno,dbuf,&unit,&nullo);
         }
      else if (type[0] == 'C')
         {
         iwa[0] = 3;
         *cbuf = '\0';
         stat = SCKRDC(keyname,bytelem,first,noelem,&cnvno,cbuf,&unit,&nullo);
         }
      else
         {
         iwa[0] = 5;
         *sbuf = (size_t)0;
         stat = SCKRDS(keyname,first,noelem,&cnvno,sbuf,&unit,&nullo);
         }
      iwa[1] = cnvno;
      iwa[2] = unit;
      iwa[3] = nullo;
      iwa[4] = stat;
      if (type[0] == 'I')
         stat = inmail(10,(char *)ibuf,iwa);			/* send it */
      else if (type[0] == 'R')
         stat = inmail(10,(char *)rbuf,iwa);			/* send it */
      else if (type[0] == 'D')
         stat = inmail(10,(char *)dbuf,iwa);			/* send it */
      else if (type[0] == 'C')
         {
         iwa[1] *= bytelem;
         stat = inmail(10,cbuf,iwa);				/* send it */
         }
      else
         stat = inmail(10,(char *)sbuf,iwa);			/* send it */
      }

   else					/* read locally */
      {
      stat = MID_DSPKEY(TOKEN[1].STR,TOKEN[2].STR[0]);
      if (stat != ERR_NORMAL) 
         {
         ERRORS.SYS = 51;
         goto sect_1334;
         }
      }

   return (0);			/* that's it */
   }
 

ERRORS.SYS = 5;				/* default to invalid syntax  */

if (key_task == 'D')
   {                            /*---------
	                           delete keys
	                         -------------*/
 
   stat = MID_DELKEY(TOKEN[1].STR);		/* delete key   */
   if (stat != ERR_NORMAL)
      goto sect_1333;
   else
      return (0);				/* finished */
   }

  

	                 /*-----------------------------
	                 define/write/inquire/copy keys
	                 -----------------------------*/

write_loop:
(void) strcpy(keyname,TOKEN[1].STR);
lkey = CGN_INDEXC(keyname,'/');			/* test, if default is taken */

if ((server.MODE == 1) && (server.FUNC == 20))       /* that's a XCKWRx */
   wr_remote = 1;
else
   wr_remote = 0;
 
 
/*  handle default or specific key specs  */
 
if (lkey <= 0)  				/* yes - all defaults  */
   {
   if (key_task == 'L') goto sect_1334;		/* not good for DEFINE/LOCAL */
   if (MID_FNDKEY(keyname,k_type,&sbytelem,&snoelem,&unit) < 0)
      goto sect_1333;				/* wrong syntax...   */
 
   first = 1;
   if ( (k_type[0] == 'C') && (sbytelem > 1) )
      (void) sprintf(type,"C*%d",sbytelem);
   else
      {
      type[0] = k_type[0];
      type[1] = '\0';
      }
   bytelem = sbytelem;
   noelem = snoelem;
   }

else if (lkey > KEY_NAMELEN)			/* avoid too long keynames */
   {
   ERRORS.SYS = 51;
   goto sect_1334;
   }

else				    /* no. we have to extract everything...  */
   {
   start = lkey + 1;
   slen = CGN_EXTRSS(TOKEN[1].STR,TOKEN[1].LEN,'/',&start,type,KEY_NAMELEN);
   MID_TYPCHK(type,cc,&nn);
   if (cc[0] == ' ')
      {
      ERRORS.SYS = 50;
      goto sect_1334;
      }
 
   keyname[lkey] = '\0';
   type[0] = cc[0];
   bytelem = nn;
   slen = CGN_EXTRSS(TOKEN[1].STR,TOKEN[1].LEN,'/',&start,substr,20);
   if (slen >= 1) 
      {
      n = CGN_CNVT(substr,1,2,iwa,rwa,dwa);
      if (n < 1) goto sect_1334;
      first = iwa[0];
      slen = CGN_EXTRSS(TOKEN[1].STR,TOKEN[1].LEN,'/',&start,substr,20);
      }
   n = CGN_CNVT(substr,1,2,iwa,rwa,dwa);
   noelem = iwa[0];
   if ((slen < 1) || (n < 1) || (noelem < 1)) goto sect_1334;
 
   if (key_task == 'L') 
      {
      stat = MID_TSTKEY(keyname);	    /* check against system names */
      if (stat != ERR_NORMAL)
         {
         ERRORS.SYS = 51;
         goto sect_1334;
         }

      if ( (TOKEN[4].STR[0] == '+') &&
           ((TOKEN[4].STR[1] == 'l') || (TOKEN[4].STR[1] == 'L')) )
         key_task = 'l';			/* also for lower levels! */
      }

   else			 /*  check ,if key already exists   */
      {
      n = MID_FNDKEY(keyname,k_type,&sbytelem,&nb,&unit);
      if (n < 0)
         {
         if (key_task == 'C')	/* for COPY/KEY the source key must exist... */
            {
            ERRORS.SYS = 52;
            goto sect_1334;
            }
         }
      else
         {
         if ( (type[0] != k_type[0]) || (nn != sbytelem) )
            {
            ERRORS.SYS = 50;
            errflg = 2;
            goto sect_1334;
            }
         else
            goto copy_check;
         }
      }

   klen = noelem + first - 1;
   stat = MID_DEFKEY(keyname,key_task,type,klen,&unit);
   if (stat != ERR_NORMAL) goto sect_1333;
   }
 
	
/*  if it's COPY/KEY, we have to read the source key */
 
copy_check:
if (key_task == 'C')
   {
   if (copy_1 == 0)
      {

      /* now check, if we get key from different Midas unit  */

      if (MONIT.COUNT > 3)
         {
         if (strncmp(TOKEN[3].STR,"IDI",3) == 0)        /* unit in IDISERV */
            {
            int  fid;

            nn = CGN_COPY(myfram,FRONT.STARTUP);
            (void) strcpy(&myfram[nn],"IDISERV");
            fid = osaopen(myfram,READ);
            if (fid > 0)
               {
               nn = osaread(fid,TOKEN[3].STR,4);
               osaclose(fid);
               }
            }
                                                /* save companion unit */
         stat = SCKWRC("OUTPUTC",1,TOKEN[3].STR,70,2,&unit);
         MID_MOVKEY("O",myfram);                /* close own keyfile */
         nn = CGN_COPY(myfram,FRONT.STARTUP);
         (void) strcpy(&myfram[nn],"FORGR  .KEY");
         myfram[nn+5] = CGN_UPPER(TOKEN[3].STR[0]);
         myfram[nn+6] = CGN_UPPER(TOKEN[3].STR[1]);
      
         stat = MID_MOVKEY("IM",myfram);	/* get other keyfile in */
      
         if ( stat != ERR_NORMAL)
            {
            myfram[nn+5] = FRONT.DAZUNIT[0]; 
            myfram[nn+6] = FRONT.DAZUNIT[1];
            stat = MID_MOVKEY("IM",myfram);
            ERRORS.SYS = 100;
            errflg = -1;
            (void) strcpy(LINE.STR,"could not open background keyfile");
            goto sect_1334;
            }
         }
 
      if (type[0] == 'I')
         stat = SCKRDI(keyname,first,noelem,&cnvno,ibuf,&unit,&nullo);	
      else if (type[0] == 'R')
         stat = SCKRDR(keyname,first,noelem,&cnvno,rbuf,&unit,&nullo);	
      else if (type[0] == 'D')
         stat = SCKRDD(keyname,first,noelem,&cnvno,dbuf,&unit,&nullo);	
      else if (type[0] == 'C')
         stat = SCKRDC(keyname,bytelem,first,noelem,&cnvno,cbuf,&unit,&nullo);	
      else
         stat = SCKRDS(keyname,first,noelem,&cnvno,sbuf,&unit,&nullo);	

      if (stat != ERR_NORMAL) goto sect_1333;

      if (MONIT.COUNT > 3)
         {
         (void) MID_MOVKEY("O",myfram);		/* close background keyfile */
         myfram[nn+5] = FRONT.DAZUNIT[0]; 
         myfram[nn+6] = FRONT.DAZUNIT[1];
         stat = MID_MOVKEY("IM",myfram);
         }

      TOKEN[1].LEN = CGN_COPY(TOKEN[1].STR,TOKEN[2].STR);
      copy_1 = 1;			/* because we have to loop once */
      type_save[0] = type[0];
      goto write_loop;
      }

   else
      {
      if (type_save[0] != type[0])
         {
         ERRORS.SYS = 53;
         goto sect_1334;
         }

      if (cnvno > noelem) cnvno = noelem;
      
      if (type[0] == 'I')
         stat = SCKWRI(keyname,ibuf,first,cnvno,&unit);
      else if (type[0] == 'R')
         stat = SCKWRR(keyname,rbuf,first,cnvno,&unit);
      else if (type[0] == 'D')
         stat = SCKWRD(keyname,dbuf,first,cnvno,&unit);
      else if (type[0] == 'C')
         stat = SCKWRC(keyname,bytelem,cbuf,first,cnvno,&unit);	
      else
         stat = SCKWRS(keyname,sbuf,first,cnvno,&unit);	
      if (stat == ERR_NORMAL) 
         goto ok_return;
      else
         goto sect_1333;
      } 
   }


/*  if it's INQUIRE/KEY, we have to prompt   */
 
if (key_task == 'I')
   {
   char  myprompt[88];

   if (server.MODE != 0)		/* not possible in background mode */
      {					/* we'd wait forever! */ 
      if (MONIT.ENV != 'P')
         {				/* but only if we're not PyMidas! */
         ERRORS.SYS = 56;
         goto sect_1334;
         }
      }
	
   if ( *prompt == ' ')			/* build default prompt string  */
      {
      (void) strcpy(myprompt,"Enter values for key ");
      (void) strcpy(&myprompt[21],keyname);
      (void) strcat(myprompt,":");
      }
   else
      { 
      slen = (int) strlen(prompt);
      nr = 0;
      if ( (prompt[0] == '"') && (slen > 2) && (prompt[slen-1] == '"') )
         {
         nr = 1;
         slen -= 2;
         }
      if (slen > 87) slen = 87;		/* avoid overflow */

      (void) memcpy(myprompt,(prompt+nr),(size_t)slen);
      for (nr=slen-1; nr>0; nr--)	   /*  get rid of trailing blanks  */
         {
         if (myprompt[nr] != ' ')
            {
            myprompt[nr+1] = '\0';
            break;
            }
         }
      }
 

   CGN_UPCOPY(substr,TOKEN[3].STR,5);
   if (strncmp(substr,"FLUSH",5) == 0)		/* if par3 = FLUSH, */
      {						/* clear input buffer */
      ostopen();
      kk = ostin();
      if (kk > 0) n = ostread(KAUX.OUT,kk,0);
      ostclose();
      }

   if (type[0] == 'I')
      stat = 
      SCKPRI(myprompt,keyname,first,noelem,&cnvno,ibuf,&unit,&nullo);	

   else if (type[0] == 'R')
      stat = 
      SCKPRR(myprompt,keyname,first,noelem,&cnvno,rbuf,&unit,&nullo);	

   else if (type[0] == 'D')
      stat = 
      SCKPRD(myprompt,keyname,first,noelem,&cnvno,dbuf,&unit,&nullo);	

   else if (type[0] == 'C')
      stat = SCKPRC(myprompt,keyname,bytelem,first,noelem,&cnvno,
                    cbuf,&unit,&nullo);	
   else
      stat = 
      SCKPRS(myprompt,keyname,first,noelem,&cnvno,sbuf,&unit,&nullo);	
 
   if ((stat != ERR_NORMAL) && (stat != ERR_NODATA)) 
      {
      KIWORDS[OFF_AUX+6] = 0;		/* clear AUX_MODE(7)  */
      goto sect_1333;
      }
   else
      {
      KIWORDS[OFF_AUX+6] = cnvno;	/* AUX_MODE(7) <=  no. of elements  */
      goto ok_return;
      }
   }
 
 
/*  for WRITE/KEY convert to binary if it's not a character keyword  */
 
cr = type[0];
if (cr == 'C') goto char_key;		/* character stuff not handled here */

if (wr_remote == 1)
   {
   iwa[1] = noelem;
   if (cr == 'I')			/* get the data from Client */
      {
      iwa[0] = 1;			/* the data type */
      stat = inmail(11,(char *)ibuf,iwa);
      }
   else if (cr == 'R')
      {
      iwa[0] = 2;			/* the data type */
      stat = inmail(11,(char *)rbuf,iwa);
      }
   else if (cr == 'D')
      {
      iwa[0] = 4;			/* the data type */
      stat = inmail(11,(char *)dbuf,iwa);
      }
   else
      {
      iwa[0] = 5;			/* the data type */
      stat = inmail(11,(char *)sbuf,iwa);
      }
   cnvno = noelem;
   }

else
   {
   if (cr == 'I')
      nb = 1;
   else if (cr == 'R')
      nb = 2;
   else if (cr == 'D')
      nb = 4;
   else
      nb = 5;

   if (MONIT.COUNT < 3)
      {
      TOKEN[3].STR[0] = 'A'; 		/* emulate ALL option with zeros */
      ibuf[0] = 0;
      rbuf[0] = 0.0;
      dbuf[0] = 0.0;
      sbuf[0] = (size_t)0;
      cnvno = 1;
      }
   else
      {
      cnvno = CGN_xCNVT(TOKEN[2].STR,nb,noelem,ibuf,rbuf,dbuf,sbuf);
      if (cnvno < 1) 
         {
         errflg = 2;
         ERRORS.SYS = 100;
         goto sect_1334;
         }
      }
   }
 
	
/*  check for ALL option   */
 
if ( (TOKEN[3].STR[0] == 'A') || (TOKEN[3].STR[0] == 'a') )
   {
   if (cr == 'I')
      {
      iall = *ibuf;
      kk = noelem * II_SIZE;
      if (kk > work_size)
         {
         free(work_str);	       /* free old memory + allocate new one */
         work_size = kk;
         work_str = malloc((size_t)work_size);
         ibuf = (int *) work_str;
         }
      for (nr=0; nr<noelem; nr++)
         *(ibuf+nr) = iall;
      }
   else if (cr == 'R')
      {
      rall = *rbuf;
      kk = noelem * RR_SIZE;
      if (kk > work_size)
         {
         free(work_str);           /* free old memory + allocate new one */
         work_size = kk;
         work_str = malloc((size_t)work_size);
         rbuf = (float *) work_str;
         }
      for (nr=0; nr<noelem; nr++)
         *(rbuf+nr) = rall;
      }
   else if (cr == 'D')
      {
      dall = *dbuf;
      kk = noelem * DD_SIZE;
      if (kk > work_size)
         {
         free(work_str);           /* free old memory + allocate new one */
         work_size = kk;
         work_str = malloc((size_t)work_size);
         dbuf = (double *) work_str;
         }
      for (nr=0; nr<noelem; nr++)
         *(dbuf+nr) = dall;
      }
   else 				/* only size_t left...   */
      {
      sall = *sbuf;
      kk = noelem * SS_SIZE;
      if (kk > work_size)
         {
         free(work_str);           /* free old memory + allocate new one */
         work_size = kk;
         work_str = malloc((size_t)work_size);
         sbuf = (size_t *) work_str;
         }
      for (nr=0; nr<noelem; nr++)
         *(sbuf+nr) = sall;
      }
   cnvno = noelem;			/* update cnvno to full count */
   }
	

/*  now write the stuff into the keyword   */
 
if (cr == 'I')
   stat = SCKWRI(keyname,ibuf,first,cnvno,&unit);
else if (cr == 'R')
   stat = SCKWRR(keyname,rbuf,first,cnvno,&unit);
else if (cr == 'D')
   stat = SCKWRD(keyname,dbuf,first,cnvno,&unit);
else
   stat = SCKWRS(keyname,sbuf,first,cnvno,&unit);

if (stat != ERR_NORMAL) 
   goto sect_1333;
else
   goto ok_return;
 
	
/*  here we work on character arrays   */
 
char_key:
nn = noelem * bytelem;			/* total size */
if (nn > work_size)
   {
   free(work_str);            /* free old memory + allocate new one */
   work_size = nn;
   work_str = malloc((size_t)work_size);
   cbuf = work_str;
   }

if (wr_remote == 1)			/* it's an XCKWRC call */
   {
   iwa[0] = 3;
   iwa[1] = nn;
   stat = inmail(11,cbuf,iwa);
   }

else
   {
   if (KIWORDS[OFF_AUX+4] == 0)	/* AUX_MODE(5) is double_quote flag */
      {
      slen = TOKEN[2].LEN - 1;
      if ( (TOKEN[2].STR[0] == '"') && (slen > 1) 
                                    && (TOKEN[2].STR[slen] == '"') )
         {
         CGN_strcpy(TOKEN[2].STR,&TOKEN[2].STR[1]);
         TOKEN[2].STR[--slen] = '\0';
         TOKEN[2].LEN = slen;
         }
      }
 

   if ( (TOKEN[3].STR[0] == 'A') || (TOKEN[3].STR[0] == 'a') )
      {					/* handle ALL option ...  */
      kk = 0;
      xbuf = cbuf;
      for (nr=0; nr<nn; nr++)				
         {
         *xbuf++ = TOKEN[2].STR[kk++];
         if (kk >= TOKEN[2].LEN) kk = 0;
         }
      }
   else
      {
      (void) strcpy(cbuf,TOKEN[2].STR);
      if (TOKEN[2].LEN < nn)
         {
         kk = TOKEN[2].LEN;
         xbuf = cbuf + kk;
         for (nr=kk; nr<nn; nr++) *xbuf++ = ' ';	/* pad with blanks  */
         }
      }
   } 
 
stat = SCKWRC(keyname,bytelem,cbuf,first,noelem,&unit);
if (stat != ERR_NORMAL) goto sect_1333;

ok_return:
ERRO_LOG = 0;
ERRO_INDX = -1;
return (0);
 
	
/*  here, if something went wrong...   */
 
sect_1333:
if (stat == ERR_INPINV)
   errflg = 2;
else if (stat == ERR_KEYBAD)
   ERRORS.SYS = 52;

sect_1334:
ERRORS.STATUS = stat;
if (errflg == -1)
   {
   cbuf[0] = ' ';
   cbuf[1] = '\0';
   }
else
   (void) strcpy(cbuf,TOKEN[errflg].STR);

PREPERR("MIDAS",LINE.STR,cbuf);
ERRO_LOG = 0;
ERRO_INDX = -1;

if (wr_remote == 1)		/* set status keyword to retstat */
   KIWORDS[OFF_PRSTAT] = stat;

return (1);
 
}
/*

*/
 
int IMMEDIATE()
 
/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE
  handle all MIDAS commands of the form A = ...
  where A is 1) a keyword like MODE(4)
	     2) a descriptor like ITEST,NPIX(2)
	     3) a single frame pixel like ITEST[@20,>]
	     4) a single entry in a table, specified via TABLE,COL,ROW
.ALGORITHM
  for 1) just return(0)
  for 2) use module DESCR_ACCESS
  for 3) use modules PIXEL_ACCES 
  for 4) use module TABLE_ACCESS
 
.RETURNS
  int 	=1 for 2) and 3) and 4)
	=0 for 1)
        = -1, if a bug
----------------------------------------------------------------*/
 
{
	
static char kname[] = "L$L$L$ ";

int   unit, iav, nullo;
int   iwa[2], kk, elem, size;
 
float  rwa[2];

double dwa[2];

char	savtoken[MAX_TOKEN], type[12];

	

if (CGN_INDEXC(TOKEN[0].STR,'[') > 0)			/* frame access */
   {
   kname[6] = 'R';				/* access as real image */
   (void) strcpy(savtoken,TOKEN[0].STR);	/* save result spec. */
   size = TOKEN[0].LEN;				/* and length */
   TOKEN[0].LEN = CGN_COPY(TOKEN[0].STR,kname);
   kk = KEYCOMP(0,2,type);
   if (kk == 0)
      (void) SCKRDR(kname,1,1,&iav,rwa,&unit,&nullo);
   else
      {
      ERRORS.INDEX = 2;
      return (-1);
      }

   savtoken[size-1] = '\0';
   kk = PIXEL_ACCESS(1,savtoken,rwa);	  /* leave closing ] out..  */
   if (kk != 0)
      return (-1);
   else
      return (1);
   }

 
kk = CGN_INDEXC(TOKEN[0].STR,',');
if (kk < 1) return (0);               /*  TOKEN[0].STR must be keyword  */
	

/* we are left with table or descriptor settings  */

if (CGN_INDEXC(&TOKEN[0].STR[kk+1],',') >= 0)
   {
   kk = TABLE_ACCESS(2,TOKEN[0].STR,iwa,rwa,TOKEN[2].STR,
                  dwa,type,&size);
   if (kk < 0)				/* something wrong  */
      {
      ERRORS.INDEX = 0;
      return (-1);
      }
   else if (kk == 11)			/* we read the selection flag */
      return 1;

   if (type[0] != 'C')
      {					/* test if value = null or = NULL */
      if ((TOKEN[2].STR[0] != 'n') &&
          (TOKEN[2].STR[0] != '*') &&
          (TOKEN[2].STR[0] != 'N'))	/* avoid NULL setting */
         {
         kname[6] = type[0];
         (void) strcpy(savtoken,TOKEN[0].STR);         /* save result descr. */
         TOKEN[0].LEN = CGN_COPY(TOKEN[0].STR,kname);
         kk = KEYCOMP(0,2,type);
         TOKEN[0].LEN = CGN_COPY(TOKEN[0].STR,savtoken);
         if (kk == 0)
            TOKEN[2].LEN = CGN_COPY(TOKEN[2].STR,kname);
         else
            {
            ERRORS.INDEX = 2;
            return (-1);
            }
         }
      }
   else if (MONIT.COUNT > 3) (void) printf("%s\n",warnmess);

   kk = TABLE_ACCESS(1,TOKEN[0].STR,iwa,rwa,TOKEN[2].STR,
		  dwa,type,&size);
   }

else
   {
   DESCR_ACCESS(2,TOKEN[0].STR,iwa,rwa,TOKEN[2].STR,
                dwa,type,&elem,&size);
   if (type[0] == ' ')                          /* something wrong  */
      {
      ERRORS.INDEX = 0;
      return (-1);
      }
   if (type[0] != 'C')
      {
      kname[6] = type[0];
      (void) strcpy(savtoken,TOKEN[0].STR);		/* save result descr. */
      TOKEN[0].LEN = CGN_COPY(TOKEN[0].STR,kname);
      kk = KEYCOMP(0,2,type);
      TOKEN[0].LEN = CGN_COPY(TOKEN[0].STR,savtoken);
      if (kk == 0)
         (void) strcpy(TOKEN[2].STR,kname);
      else
         {
         ERRORS.INDEX = 2;
         return (-1);
         }
      }
   else if (MONIT.COUNT > 3) (void) printf("%s\n",warnmess);

   DESCR_ACCESS(1,TOKEN[0].STR,iwa,rwa,TOKEN[2].STR,
                dwa,type,&elem,&size);
   }
 
if (type[0] != ' ')
   return (1);
else
   return (-1);			/* that's bad ... */
 
}
/*

*/
 
void DESCR_ACCESS(flag,string,ival,rval,cval,dval,type,elem,size)
 
/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE
  replace string FILE,DESCR(...) or FILE[...:...],DESCR(...)
  with the contents of descr DESCR(...)
  or fill descr specified by FILE,DESCR(...) with given value
.ALGORITHM
  read relevant element of descr + convert it to ASCII
  or fill it with a given value
.RETURNS
  nothing
----------------------------------------------------------------------*/
 
int   flag    /* IN: = 0, read descr     \
		     = 1, write descr    \
		     = 2, get type, size of descr */;
char	*string    /* IN: file,descr(...) terminated by \0 */;
int   *ival   /* IO: integer value to be read or written  */;
float	*rval	   /* IN/OUT: real value to be read or written  */;
char	*cval	   /* IO: character value to be read or written   \
                          or it holds the name of the keyword to  \
			  be read for flag=1 and nonchar. type   */;
double	*dval	   /* IO: double prec. value to be read or written  */;
char	*type	   /* OUT: type of descr: I,R,CHAR*..,D   \
		           = ' ', if something wrong     */;
int   *elem   /* OUT: element accessed  */;
int   *size   /* IO: max length on input (for char. parms.) \
                          length of value returned (for 'flag' = 0)  */;
	
{
int  entrx, first, bytelem;
int  unit, iav, nullo;
int  sfirst, sbytelem, stat, kk, n, last, ity;
register int  nr;

char	descr[50];


 
if (work_size == 0)
   {
   work_size = MAX_TOKEN;
   work_str = malloc((size_t)work_size);
   }
 
iav = CGN_INDEXC(string,']')+1;		/* test for: frame[...],descr */
kk = CGN_INDEXC(&string[iav],',');	/* split up frame + descr */
kk += iav;
(void) strncpy(work_str,string, (size_t)kk);
work_str[kk] = '\0';
*type = ' ';				/* init to failure */

(void) FRAMACC('O',work_str,0,&entrx);		/* open image or table */
if (entrx < 0) 
   {
   ERRORS.SYS = 44;			/* could not open */
   return;
   }


/* find out, if descr exists  */
	
DSCR_PARSE(entrx,(string+kk+1),descr,type,&sbytelem,elem,&sfirst,&last);
 
nullo = -1;		/* indicate, that we do not test for null values  */
if (*type == 'I') 
   ity = 1;
else if (*type == 'R')
   ity = 2;
else if (*type == 'C')
   ity = 3;
else if (*type == 'D')
   ity = 4;
else if (*type == 'L')
   ity = 5;
else
   {
   ERRORS.SYS = 85;			/* wrong descriptor  */
   return;
   }
 

if (flag == 2)				/* just get type of descr */
   {
   *(type+1) = '\0';
   return;
   }


if (ity != 3)
   {			/*  handle integer, real, double precision alike   */
   *size = 1;
   first = *elem;
   if (flag == 0)                 /*  read...  */
      {
      if (ity == 1)
         stat = SCDRDI(entrx,descr,first,1,&iav,ival,&unit,&nullo);
      else if (ity == 2)
         stat = SCDRDR(entrx,descr,first,1,&iav,rval,&unit,&nullo);
      else if (ity == 4)
         stat = SCDRDD(entrx,descr,first,1,&iav,dval,&unit,&nullo);
      else
         stat = SCDRDL(entrx,descr,first,1,&iav,ival,&unit,&nullo);
      }
   else                           /*   write...   */
      {
      if (ity == 1)
         {
         (void) SCKRDI(cval,1,1,&iav,ival,&unit,&nullo);
         stat = SCDWRI(entrx,descr,ival,first,1,&unit);
         }
      else if (ity == 2)
         {
         (void) SCKRDR(cval,1,1,&iav,rval,&unit,&nullo);
         stat = SCDWRR(entrx,descr,rval,first,1,&unit);
         }
      else if (ity == 4)
         {
         (void) SCKRDD(cval,1,1,&iav,dval,&unit,&nullo);
         stat = SCDWRD(entrx,descr,dval,first,1,&unit);
         }
      else
         {
         (void) SCKRDI(cval,1,1,&iav,ival,&unit,&nullo);
         stat = SCDWRL(entrx,descr,ival,first,1,&unit);
         }
      }
   }

else
   {			/*  handle character descriptor here  */
   bytelem = sbytelem;
   first = sfirst--;		/* first is original `sfirst' */
   if (last < 0)
      kk = -last;
   else
      kk = last;
   kk -= sfirst;

   if (flag == 0)
      {
      memset((void *)cval,32,(size_t)*size);

      if (kk < *size)
         *size = kk;		/*   minimize...  */
      else
         kk = *size;
 
      if (sbytelem == 1)			/* flat string */
         {
         stat = SCDRDC(entrx,descr,1,first,
                       kk,&iav,cval,&unit,&nullo);
         kk = iav;					/* kk  <=  *size ... */
         }
      else
         {
         if (kk+sfirst > sbytelem) kk = sbytelem - sfirst;
         if (bytelem > work_size)
            {
            free(work_str);	       /* free old memory + allocate new one */
            work_size = bytelem;
            work_str = malloc((size_t)work_size);
            }
         stat = SCDRDC(entrx,descr,bytelem,*elem,1,&iav,work_str,&unit,&nullo);
         (void) strncpy(cval,work_str+sfirst,(size_t)kk);
         }

      if (stat == ERR_NORMAL) 
         {
         *size = kk;
 
         for (nr=0; nr<kk; nr++)			/* look for '\0'  */
            {
            if (cval[nr] == '\0')
               {
               *size = nr;
               return;
               }
            }

         if (last < 0)
            {
            for (nr=kk-1; nr>0; nr--)		/* cut off trailing blanks  */
               {
               if (cval[nr] != ' ')
                  {
                  *size = nr + 1;
                  return;
                  }
               }
            }
         }
      }
   
   else
      {
      n = (int) strlen(cval);
      if (KIWORDS[OFF_AUX+4] == 0)
         {
         if ((*cval == '"') && (*(cval+n-1) == '"'))
            {				/* drop the enclosing quotes */
            cval ++;
            n -= 2;
            }
         }
      if ((last < 0) && (kk > n)) kk = n;

      if (sbytelem == 1)			/* flat char. string */
         {
         if (n >= kk)
            stat = SCDWRC(entrx,descr,1,cval,first,kk,&unit);
         else
            {
            if (kk > work_size)
               {
               free(work_str);     /* free old memory + allocate new one */
               work_size = kk;
               work_str = malloc((size_t)work_size);
               }
            (void) strncpy(work_str,cval,(size_t)n);
            memset((void *)(work_str+n),32,(size_t)(kk-n));
            stat = SCDWRC(entrx,descr,1,work_str,first,kk,&unit);
            }
         }
      else
         {
         if (sbytelem > work_size)
            {
            free(work_str);        /* free old memory + allocate new one */
            work_size = sbytelem;
            work_str = malloc((size_t)work_size);
            }
         stat = SCDRDC(entrx,descr,bytelem,*elem,1,&iav,work_str,&unit,&nullo);
         if (stat == ERR_NORMAL) 
            {
            if (n >= kk)
               (void) strncpy(work_str+sfirst,cval,(size_t)kk);
            else
               {
               (void) strncpy(work_str+sfirst,cval,(size_t)n);
               memset((void *)(work_str+sfirst+n),32,(size_t)(kk-n));
               }
            stat = SCDWRC(entrx,descr,bytelem,work_str,*elem,1,&unit);
            }
         }
      }
   }

if (stat != ERR_NORMAL) 
   {
   ERRORS.STATUS = stat;			/* save low level error */
   ERRORS.SYS = 85;
   }
}

