#define vmr	vmr_		/* parameter for Name Translation is l_ */
#define ROUTINE int
/* @(#)f2cdsp.fc	17.1.1.1 (ESO-DMD) 01/25/02 17:39:35 */
/*===========================================================================
  Copyright (C) 1995 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
===========================================================================*/

/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.LANGUAGE  C
.AUTHOR    Richard van Hees                        ESO - Garching
.IDENTIFICATION  Module f2cdsp.fc
.PURPUSE   fortran to C interfaces for low level display routines
.VERSION   [1.00]  940327
---------------------------------------------------------*/
#include <midas_def.h>
#include <ftoc.h>
#include <idinumd.h>

#define LUTSIZE 256
#define MAXDIM  3

/*

*/

#if 0     /* ==== Original Code ==== */
SUBROUTINE TSCOLR(cbuf,colo)
CHARACTER cbuf;
fint2c  *colo;
#else     /* ==== Generated Code === */
#define TSCOLR	tscolr_
TSCOLR(va_alist) va_dcl 
{ va_list Cargs;
#endif    /* ======================= */
  int FORmark;           /* <forif> */
  va_start(Cargs);       /* <forif> */
  FORmark = ftoc_mark(); /* <forif> */

   *PARAM(2,2,1,fint2c *) = tstcolor(STRIPPED_STRING(1,2,0));
  ftoc_free(FORmark);    /* <forif> */
}

#if 0     /* ==== Original Code ==== */
SUBROUTINE ALPTXC(cbuf,xp,yp,colo)
CHARACTER cbuf;
fint2c  *xp;
fint2c  *yp;
fint2c  *colo;
#else     /* ==== Generated Code === */
#define ALPTXC	alptxc_
ALPTXC(va_alist) va_dcl 
{ va_list Cargs;
#endif    /* ======================= */
  int FORmark;           /* <forif> */
  va_start(Cargs);       /* <forif> */
  FORmark = ftoc_mark(); /* <forif> */

   Alptxec( STRIPPED_STRING(1,4,0), *PARAM(2,4,1,fint2c *), *PARAM(3,4,1,fint2c *), *PARAM(4,4,1,fint2c *) );
  ftoc_free(FORmark);    /* <forif> */
}

#if 0     /* ==== Original Code ==== */
SUBROUTINE ALPTXT(cbuf,na,nb,colo)
CHARACTER cbuf;
fint2c  *na;
fint2c  *nb;
fint2c  *colo;
#else     /* ==== Generated Code === */
#define ALPTXT	alptxt_
ALPTXT(va_alist) va_dcl 
{ va_list Cargs;
#endif    /* ======================= */
  int FORmark;           /* <forif> */
  va_start(Cargs);       /* <forif> */
  FORmark = ftoc_mark(); /* <forif> */

   Alptext( 99, STRIPPED_STRING(1,4,0), *PARAM(2,4,1,fint2c *), *PARAM(3,4,1,fint2c *), *PARAM(4,4,1,fint2c *) );
  ftoc_free(FORmark);    /* <forif> */
}

#define AUXHLP	auxhlp_
ROUTINE AUXHLP( flag )
fint2c  *flag;
{
   auxhelp( *flag );
}

#define AUXWND	auxwnd_
ROUTINE AUXWND(flag,info,xya,xyb,stata)
fint2c  *flag;
fint2c  *info;
fint2c  *xya;
fint2c  *xyb;
fint2c  *stata;
{
   *stata = Cauxwnd(*flag,info,xya,xyb);
}

#if 0     /* ==== Original Code ==== */
SUBROUTINE BLDGRA(shape,coords,arcs,xfig,yfig,figmax,nop)
CHARACTER shape;
fint2c  *coords;
float   *arcs;
fint2c  *xfig;
fint2c  *yfig;
fint2c  *figmax;
fint2c  *nop;
#else     /* ==== Generated Code === */
#define BLDGRA	bldgra_
BLDGRA(va_alist) va_dcl 
{ va_list Cargs;
#endif    /* ======================= */
  int FORmark;           /* <forif> */
  va_start(Cargs);       /* <forif> */
  FORmark = ftoc_mark(); /* <forif> */

buildgra(CHAR_LOC(1,7,0),PARAM(2,7,1,fint2c *),PARAM(3,7,1,float *),PARAM(4,7,1,fint2c *),PARAM(5,7,1,fint2c *),*PARAM(6,7,1,fint2c *),PARAM(7,7,1,fint2c *));
  ftoc_free(FORmark);    /* <forif> */
}

#define CONCHA	concha_
ROUTINE CONCHA( dsplay, chan, grflag, value )
fint2c *dsplay;
fint2c *chan;
fint2c *grflag;
fint2c *value;
{
   CONCHA_C( *dsplay, *chan, *grflag, *value );
}

#define CURSIN	cursin_
ROUTINE CURSIN( dsplay, iact, nocurs, xya, mca, isca, xyb, mcb, iscb )
fint2c  *dsplay;
fint2c  *iact;
fint2c  *nocurs;
fint2c  *xya;
fint2c  *mca;
fint2c  *isca;
fint2c  *xyb;
fint2c  *mcb;
fint2c  *iscb;
{
int  unit, ik[4], kxya[5], kxyb[5];
register int  nr;

for ( nr = 0; nr < 5; nr++ )
    { kxya[nr] = 0;
      kxyb[nr] = 0;
    }
Ccursin( *dsplay, *iact, *nocurs, kxya, isca, kxyb, iscb );
xya[0] = kxya[0];
xya[1] = kxya[1];
*mca = kxya[2];

xyb[0] = kxyb[0];
xyb[1] = kxyb[1];
*mcb = kxyb[2];

if ((*isca != 0) || (*iscb != 0))
   { ik[0] = kxya[3];
     ik[1] = kxya[4];
     ik[2] = kxyb[3];
     ik[3] = kxyb[4];

     (void) SCKWRI("CURSOR",ik,1,4,&unit);	/* save screen coords. */
   }
}

#define DAZVIS	dazvis_
ROUTINE DAZVIS( dsplay, chanl, flag, vis )
fint2c  *dsplay;
fint2c  *chanl;
fint2c  *flag;
fint2c  *vis;
{
(void) Cdazvis( *dsplay,* chanl, *flag, *vis );
}

#define DAZSCR	dazscr_
ROUTINE DAZSCR( dsplay, chanl, scrx, scry, stat )
fint2c  *dsplay;
fint2c  *chanl;
fint2c  *scrx;
fint2c  *scry;
fint2c  *stat;
{
*stat = Cdazscr(*dsplay,*chanl,scrx,scry);
}

#define DAZZSC	dazzsc_
ROUTINE DAZZSC( dsplay, chanl, zoom, scrx, scry, stat )
fint2c  *dsplay;
fint2c  *chanl;
fint2c  *zoom;
fint2c  *scrx;
fint2c  *scry;
fint2c  *stat;
{
*stat = Cdazzsc( *dsplay, *chanl, *zoom, scrx, scry );
}

static void  getc1(ic1,fp1,wc1,val1,xya,ic2,fp2,wc2,val2,xyb)
int   *ic1, *ic2;
float *fp1, *wc1, *val1, *fp2, *wc2, *val2;
float *xya, *xyb;
{
ic1[0] = xya[0];
ic1[1] = xya[1];
fp1[0] = xya[2];
fp1[1] = xya[3];
wc1[0] = xya[4];
wc1[1] = xya[5];
*val1 = xya[6];

ic2[0] = xyb[0];
ic2[1] = xyb[1];
fp2[0] = xyb[2];
fp2[1] = xyb[3];
wc2[0] = xyb[4];
wc2[1] = xyb[5];
*val2 = xyb[6];
}

#if 0     /* ==== Original Code ==== */
SUBROUTINE GETCUR(action,frame,icur1,fp1,wc1,val1,stat1,
                               icur2,fp2,wc2,val2,stat2)
CHARACTER action;
CHARACTER frame;
float     *fp1;
float     *fp2;
float     *wc1;
float     *wc2;
float     *val1;
float     *val2;
fint2c    *icur1;
fint2c    *icur2;
fint2c    *stat1;
fint2c    *stat2;
#else     /* ==== Generated Code === */
#define GETCUR	getcur_
GETCUR(va_alist) va_dcl 
{ va_list Cargs;
#endif    /* ======================= */
  int FORmark;           /* <forif> */

float xya[7], xyb[7];  va_start(Cargs);       /* <forif> */
  FORmark = ftoc_mark(); /* <forif> */


GetCursor(CHAR_LOC(1,12,0),CHAR_LOC(2,12,1),xya,PARAM(7,12,2,fint2c *),xyb,PARAM(12,12,2,fint2c *));

if (*PARAM(7,12,2,fint2c *) != 0) getc1(PARAM(3,12,2,fint2c *),PARAM(4,12,2,float *),PARAM(5,12,2,float *),PARAM(6,12,2,float *),xya,PARAM(8,12,2,fint2c *),PARAM(9,12,2,float *),PARAM(10,12,2,float *),PARAM(11,12,2,float *),xyb);
  ftoc_free(FORmark);    /* <forif> */
}

#if 0     /* ==== Original Code ==== */
SUBROUTINE GETSTR( outstr, dim )
CHARACTER outstr;
fint2c    *dim;
#else     /* ==== Generated Code === */
#define GETSTR	getstr_
GETSTR(va_alist) va_dcl 
{ va_list Cargs;
#endif    /* ======================= */
  int FORmark;           /* <forif> */
  va_start(Cargs);       /* <forif> */
  FORmark = ftoc_mark(); /* <forif> */

   Cgetstr( CHAR_LOC(1,2,0 ),PARAM(2,2,1,fint2c *) );
  ftoc_free(FORmark);    /* <forif> */
}

#define HSIRGB	hsirgb_
ROUTINE HSIRGB( flag, hsi, rgb )
fint2c  *flag;
float   *hsi;
float   *rgb;
{
    HSIRGB_C(*flag,hsi,rgb);
}

#define JOYSTK	joystk_
ROUTINE JOYSTK( dsplay, iact, nocurs, jxdis, jydis, stat )
fint2c *dsplay;
fint2c *iact;
fint2c *nocurs;
fint2c *jxdis;
fint2c *jydis;
fint2c *stat;
{
   *stat = JOYSTK_C( *dsplay, *iact, *nocurs, jxdis, jydis );
}

#define LOADWN	loadwn_
ROUTINE LOADWN( flags, imno, npix, stapix, kpix, wsta, cuts )
fint2c  *flags;
fint2c  *imno;
fint2c  *npix;
fint2c  *stapix;
fint2c  *kpix;
fint2c  *wsta;
float   *cuts;
{
   LOADWN_C( flags, *imno, npix, stapix, kpix, wsta, cuts );
}

#define MAKITT	makitt_
ROUTINE MAKITT(icount,ritt,ocount,oitt)
fint2c *icount;
float  *ritt;
fint2c *ocount;
float  *oitt;
{
   MakeITT(*icount,ritt,*ocount,oitt);
}

static void mak1(ic,mlut,qlut)
int   ic;
float *mlut, *qlut;
{
register int  jin, jout, jouta, joutb;

jout = 0;
jouta = ic;
joutb = jouta + jouta;

for (jin=0; jout<ic; jin+=3)
   {
   mlut[jout++] = qlut[jin];
   mlut[jouta++] = qlut[jin+1];
   mlut[joutb++] = qlut[jin+2];
   }
}

static void mak2(oc,mlut,qlut)
int   oc;
float *mlut, *qlut;
{
register int  jin, jout, jouta, joutb;

jout = 0;
jouta = oc;
joutb = jouta + jouta;
for (jin=0; jout<oc; jin+=3)
   {
   qlut[jin] = mlut[jout++];
   qlut[jin+1] = mlut[jouta++];
   qlut[jin+2] = mlut[joutb++];
   }
}

#define MAKLUT	maklut_
ROUTINE MAKLUT( flag, icount, rlut, ocount, olut )
fint2c *flag;                   /* IN: 1= send to device, 2= get from device */
fint2c *icount;
float  *rlut;
fint2c *ocount;
float  *olut;
{
float  mylut[3*LUTSIZE];


/* 
 * r1 g1 b1 r2 g2 b2 ... rN gN bN   =>   r1 ... rN g1 ... gN b1 ... bN  
 */

if ( *flag == 1 )
   {
   mak1(*icount,mylut,rlut);
   MakeLUT(*icount,mylut,*ocount,olut);
   }

/*
 * r1 ... rN g1 ... gN b1 ... bN   =>   r1 g1 b1 r2 g2 b2 ... rN gN bN
 */

else
   {
   MakeLUT(*icount,rlut,*ocount,mylut);
   mak2(*ocount,mylut,olut);
   }
}

#define PLOHI	plohi_
ROUTINE PLOHI(ino)
fint2c *ino;
{
   Plox(*ino);
}

#define RDITT	rditt_
ROUTINE RDITT(dsplay,chan,nitt,ista,count,ritt,idst)
fint2c *dsplay;
fint2c *chan;
fint2c *nitt;
fint2c *ista;
fint2c *count;
fint2c *idst;
float  *ritt;
{
   int mysta = *ista - 1;              /*  1,... -> 0,... */

   *idst = IILRIT_C(*dsplay,*chan,*nitt,mysta,*count,ritt);
}

#define RDLUT	rdlut_
ROUTINE RDLUT(dsplay,nlut,ista,count,rlut,idst)
fint2c *dsplay;
fint2c *nlut;
fint2c *ista;
fint2c *count;
fint2c *idst;
float    *rlut;
{
   int mysta = *ista - 1;              /*  1,... -> 0,... */

   *idst = IILRLT_C(*dsplay,*nlut,mysta,*count,rlut);
}

#define REFOVR	refovr_
ROUTINE REFOVR(stat)
fint2c  *stat;
{
   *stat = 0;
   Crefrovr();
}

#define SPLCNT	splcnt_
ROUTINE SPLCNT( splcx, splcy )
fint2c (*splcx)[5];
fint2c (*splcy)[5];
{
   SPLCNT_C( splcx, splcy );
}

#define SETCUR	setcur_
ROUTINE SETCUR( dsplay, cursno, forma, colo, coords, stat )
fint2c *dsplay;
fint2c *cursno;
fint2c *forma;
fint2c *colo;
fint2c *coords;
fint2c *stat;
{
   *stat = 0;
   SETCUR_C( *dsplay, *cursno, *forma, *colo, coords );
}

static int pxx(flag,cb,rbuff,dbuf,tbuf)
int  flag;
char *cb;
float *rbuff;
double *dbuf, *tbuf;

{

if (flag == 1)
   {
   if ((cb[0] == 'I') && (cb[1] == 'N'))		/* action = INIT */
      return (1);

   else
      {
      dbuf[0] = rbuff[0];
      dbuf[1] = rbuff[1];
      tbuf[0] = rbuff[2];		/* for security - maybe not needed... */
      tbuf[1] = rbuff[3];
      }
   }

else
   {
   rbuff[2] = dbuf[0];
   rbuff[3] = dbuf[1];
   rbuff[4] = tbuf[0];
   rbuff[5] = tbuf[1];
   }

return (0);
}

/*  OJO: this routine works only for 1dim or 2dim frames */

#if 0     /* ==== Original Code ==== */
SUBROUTINE PIXXCV(cflag,imno,rbuff,stat)
CHARACTER cflag;
fint2c    *imno;
float     *rbuff;
fint2c    *stat;
#else     /* ==== Generated Code === */
#define PIXXCV	pixxcv_
PIXXCV(va_alist) va_dcl 
{ va_list Cargs;
#endif    /* ======================= */
  int FORmark;           /* <forif> */

int  ipxx;
double dbuf1[MAXDIM], dbuf2[MAXDIM], dbuf3[MAXDIM];  va_start(Cargs);       /* <forif> */
  FORmark = ftoc_mark(); /* <forif> */


ipxx = pxx(1,CHAR_LOC(1,4,0),PARAM(3,4,1,float *),dbuf1,dbuf2);
if (ipxx == 1)
   {
   *PARAM(4,4,1,fint2c *) = Pixconv("INIT",*PARAM(2,4,1,fint2c *),dbuf1,dbuf2,dbuf3);
   if (*PARAM(4,4,1,fint2c *) == -1) *PARAM(4,4,1,fint2c *) = 0;				/* FORTRAN wants 0 */
   }
else
   {
   *PARAM(4,4,1,fint2c *) = Pixconv(CHAR_LOC(1,4,0),0,dbuf1,dbuf2,dbuf3);
   if (*PARAM(4,4,1,fint2c *) == 0) 
      (void) pxx(2,"RES",PARAM(3,4,1,float *),dbuf2,dbuf3);		/* store results */
   }
  ftoc_free(FORmark);    /* <forif> */
}

#define WALPHB	walphb_
ROUTINE WALPHB(chan,flag)
fint2c  *chan;
fint2c  *flag;
{
*flag = 0;
Alphamem( *chan );
}

#define WRITT	writt_
ROUTINE WRITT(dsplay,chan,nitt,ista,count,ritt,idst)
fint2c *dsplay;
fint2c *chan;
fint2c *nitt;
fint2c *ista;
fint2c *count;
fint2c *idst;
float  *ritt;
{
   int mysta = *ista - 1;              /*  1,... -> 0,... */

   *idst = IILWIT_C(*dsplay,*chan,*nitt,mysta,*count,ritt);
}

#define WRLUT	wrlut_
ROUTINE WRLUT(dsplay,nlut,ista,count,rlut,idst)
fint2c *dsplay;
fint2c *nlut;
fint2c *ista;
fint2c *count;
fint2c *idst;
float    *rlut;
{
   int mysta = *ista - 1;              /*  1,... -> 0,... */

   *idst = IILWLT_C(*dsplay,*nlut,mysta,*count,rlut);
}

#define K1PACK	k1pack_
ROUTINE K1PACK(rbuf,ibuf,jbuf,jubuf,cbuf,aux,faux,ldata,outaux)
float *rbuf;            /* IN: float image data  */
fint2c *ibuf;           /* IN: int image data  */
short int *jbuf;        /* IN: short int image data  */
unsigned short int *jubuf;      /* IN: unsigned short int image data  */
unsigned char *cbuf;    /* IN: byte image data  */
fint2c *aux;            /* IN: auxiliary info array:    \
                               data type flag (1-R4,2-I4,3-I2,4-I1)  \
                               offset in input data     \
                               size of above            \
                               scaling factor           \
                               scaling_flag, = 0 (no), = 1 (yes scale)  */
float *faux;            /* IN: auxiliary real info array:     \
                               factor to map into [0,outmax]  \
                               artificial minimum and maximum of image data  */

unsigned char *ldata;   /* OUT: scaled line with pixel in byte  */
fint2c *outaux;         /* IN: max. output value (<= 255)  \
                               offset in pixel array      */

{
char  *cpntr;

int  kk;

kk = aux[0];
if (kk == 2)
   cpntr = (char *) ibuf;
else if (kk == 3)
   cpntr = (char *) jbuf;
else if (kk == 4)
   cpntr = (char *) cbuf;
else
   cpntr = (char *) rbuf;

K1PACK_C( cpntr, aux, faux, ldata, outaux );

}