/* @(#)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 #include #include #define LUTSIZE 256 #define MAXDIM 3 /* */ SUBROUTINE TSCOLR(cbuf,colo) CHARACTER cbuf; fint2c *colo; { *colo = tstcolor(STRIPPED_STRING(cbuf)); } SUBROUTINE ALPTXC(cbuf,xp,yp,colo) CHARACTER cbuf; fint2c *xp; fint2c *yp; fint2c *colo; { Alptxec( STRIPPED_STRING(cbuf), *xp, *yp, *colo ); } SUBROUTINE ALPTXT(cbuf,na,nb,colo) CHARACTER cbuf; fint2c *na; fint2c *nb; fint2c *colo; { Alptext( 99, STRIPPED_STRING(cbuf), *na, *nb, *colo ); } ROUTINE AUXHLP( flag ) fint2c *flag; { auxhelp( *flag ); } ROUTINE AUXWND(flag,info,xya,xyb,stata) fint2c *flag; fint2c *info; fint2c *xya; fint2c *xyb; fint2c *stata; { *stata = Cauxwnd(*flag,info,xya,xyb); } SUBROUTINE BLDGRA(shape,coords,arcs,xfig,yfig,figmax,nop) CHARACTER shape; fint2c *coords; float *arcs; fint2c *xfig; fint2c *yfig; fint2c *figmax; fint2c *nop; { buildgra(CHAR_LOC(shape),coords,arcs,xfig,yfig,*figmax,nop); } ROUTINE CONCHA( dsplay, chan, grflag, value ) fint2c *dsplay; fint2c *chan; fint2c *grflag; fint2c *value; { CONCHA_C( *dsplay, *chan, *grflag, *value ); } 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. */ } } ROUTINE DAZVIS( dsplay, chanl, flag, vis ) fint2c *dsplay; fint2c *chanl; fint2c *flag; fint2c *vis; { (void) Cdazvis( *dsplay,* chanl, *flag, *vis ); } ROUTINE DAZSCR( dsplay, chanl, scrx, scry, stat ) fint2c *dsplay; fint2c *chanl; fint2c *scrx; fint2c *scry; fint2c *stat; { *stat = Cdazscr(*dsplay,*chanl,scrx,scry); } 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]; } 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; { float xya[7], xyb[7]; GetCursor(CHAR_LOC(action),CHAR_LOC(frame),xya,stat1,xyb,stat2); if (*stat1 != 0) getc1(icur1,fp1,wc1,val1,xya,icur2,fp2,wc2,val2,xyb); } SUBROUTINE GETSTR( outstr, dim ) CHARACTER outstr; fint2c *dim; { Cgetstr( CHAR_LOC( outstr ), dim ); } ROUTINE HSIRGB( flag, hsi, rgb ) fint2c *flag; float *hsi; float *rgb; { HSIRGB_C(*flag,hsi,rgb); } 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 ); } 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 ); } 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 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); } } ROUTINE PLOHI(ino) fint2c *ino; { Plox(*ino); } 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); } 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); } ROUTINE REFOVR(stat) fint2c *stat; { *stat = 0; Crefrovr(); } ROUTINE SPLCNT( splcx, splcy ) fint2c (*splcx)[5]; fint2c (*splcy)[5]; { SPLCNT_C( splcx, splcy ); } 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 */ SUBROUTINE PIXXCV(cflag,imno,rbuff,stat) CHARACTER cflag; fint2c *imno; float *rbuff; fint2c *stat; { int ipxx; double dbuf1[MAXDIM], dbuf2[MAXDIM], dbuf3[MAXDIM]; ipxx = pxx(1,CHAR_LOC(cflag),rbuff,dbuf1,dbuf2); if (ipxx == 1) { *stat = Pixconv("INIT",*imno,dbuf1,dbuf2,dbuf3); if (*stat == -1) *stat = 0; /* FORTRAN wants 0 */ } else { *stat = Pixconv(CHAR_LOC(cflag),0,dbuf1,dbuf2,dbuf3); if (*stat == 0) (void) pxx(2,"RES",rbuff,dbuf2,dbuf3); /* store results */ } } ROUTINE WALPHB(chan,flag) fint2c *chan; fint2c *flag; { *flag = 0; Alphamem( *chan ); } 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); } 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); } 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 ); }