fv5.5/tcltk/0000755000220700000360000000000013224715144011641 5ustar birbylheafv5.5/tcltk/plt/0000755000220700000360000000000013224715127012441 5ustar birbylheafv5.5/tcltk/plt/Makefile0000644000220700000360000000116313224715127014102 0ustar birbylheaHD_COMPONENT_NAME = tcltk HD_COMPONENT_VERS = HD_LIBRARY_ROOT = plt HD_LIB_STYLE = ${HD_LIB_STYLE_F77} HD_LIBRARY_SRC_f = actwin.f akima.f akinte.f codsub.f cram.f \ curfit.f dscale.f fit.f fitit.f gamma.f gthelp.f \ hdecod.f ifgrp.f isact.f moment.f pgdev.f pgplot.f \ plconb.f ploger.f pltcct.f pltcur.f plt.f plthis.f \ pltlab.f pltskp.f pltsub.f pltxc.f ptbuf.f rdqdp.f \ rescal.f set_pgdev.f spline.f weight.f wrqdat.f \ wrtcol.f wrtcon.f wrtima.f yorn.f HD_FFLAGS = ${HD_STD_FFLAGS} HD_INSTALL_LIBRARIES = ${HD_LIBRARY_ROOT} HD_INSTALL_HELP = plt.hlp include ${HD_STD_MAKEFILE} fv5.5/tcltk/plt/actwin.f0000644000220700000360000000173513224715127014103 0ustar birbylhea SUBROUTINE ACTWIN(Ipwin, Ngroup, Mxwin, Iactw) INTEGER Ngroup, Mxwin INTEGER Ipwin(*), Iactw(*) C--- C Runs throught the Ipwin array and returns 1 if ICWIN is currently C active, and 0 otherwise C--- C Ipwin I Array telling which window each group is to appear. C Ngroup I Number of plot groups C Mxwin I Number of windows to consider C Iactw O =1 is window contains something to be plotted, =0 otherwise. C--- C 1992-Apr-14 - New routine [AFT] C--- INTEGER ig, iw C--- C Scan through all windows in window list DO 190 iw=1,Mxwin C If any groups being plotted in window, set active window flag and jump C to next window. DO ig=1,Ngroup IF ( Ipwin(ig).EQ.iw ) THEN Iactw(iw) = 1 GOTO 190 END IF END DO C No groups, contour plots or images are being plotted in current window, C so it must be inactive. Iactw(iw) = 0 190 CONTINUE RETURN END fv5.5/tcltk/plt/akima.f0000644000220700000360000002542113224715127013676 0ustar birbylheaC--- PLT user model AKIMA. C--- SUBROUTINE AKLIM(PAR, PLIM, NT, NTERM) REAL PAR(*), PLIM(3,*) INTEGER NT, NTERM C--- C This routine must be called every time a parameter is changed. C Calculates the coefficients and places them into the AKIMA C common block for future reference. C--- C PAR I/O Contain X and Y locations of the knots. C PLIM I/O <0. means parameter is froozen. C NT I C NTERM I C--- C AFT C--- INTEGER MXKNOT PARAMETER (MXKNOT=60) REAL XDEL, YDEL, DIVIDE, YMIN, YMAX INTEGER IND, IX REAL RC INTEGER NKNOT, IPER COMMON /AKICMN/RC(3,MXKNOT), NKNOT, XDEL, YDEL, IPER DATA DIVIDE/500./ C--- NKNOT=NTERM/2 IF(NKNOT.GT.MXKNOT) THEN WRITE(*,101) MXKNOT 101 FORMAT(' AKLIM--Maximum number of knots is=',I6) NKNOT=MXKNOT END IF IF ( NT.EQ.-1 ) THEN NTERM=2*NKNOT RETURN END IF XDEL=(PAR(NT+NKNOT-1)-PAR(NT))/(20.*NKNOT) CALL AJUST(XDEL,PAR,PLIM,NT,NKNOT,YMIN,YMAX) YDEL=(YMAX-YMIN)/DIVIDE IF(YDEL.LE.0.) YDEL=1./DIVIDE IPER=0 IND=NT+2*NKNOT-1 IX=NINT(-PLIM(1,IND)) IF(IX.EQ.NT+NKNOT .AND. PLIM(2,IND).EQ.1.) THEN C- If first and last Y values are equal, force periodic boundary C- condition. IPER=1 END IF CALL AKIMA(PAR(NT),RC,NKNOT,IPER) RETURN END C********* SUBROUTINE AJUST(XDEL, PAR, PLIM, NT, NKNOT, YMIN, YMAX) REAL XDEL, PAR(*), PLIM(3,*), YMIN, YMAX INTEGER NT, NKNOT C--- C This routine adjusts the X-locations of the knots to enforce the C condition that they monotonically increase in X. C--- C XDEL I C PAR I/O C PLIM I C NT I C NKNOT I C YMIN O C YMAX O C--- C AFT C--- REAL TMP INTEGER I, IAGAIN C--- YMIN=PAR(NT+NKNOT) YMAX=YMIN DO 110 I=NT+NKNOT+1,NT+2*NKNOT-1 YMIN=MIN(YMIN,PAR(I)) YMAX=MAX(YMAX,PAR(I)) 110 CONTINUE C--- C- Assume the list can be sorted in a single pass. This should be C- a good assumption for most cases. Under no condition should two C- x-values be the same. 120 IAGAIN=0 DO 180 I=NT,NT+NKNOT-2 IF(PAR(I).EQ.PAR(I+1)) THEN IF(PLIM(1,I).GE.0.) THEN IF(PLIM(1,I+1).GE.0.) THEN C Both free PAR(i)=PAR(i)-XDEL/4. PAR(i+1)=PAR(i+1)+XDEL/4. ELSE C 1st free, 2nd frozen PAR(i)=PAR(i)-XDEL/2. END IF ELSE IF(PLIM(1,I+1).GT.0) THEN C 1st free, 2nd frozen PAR(i+1)=PAR(i+1)+XDEL/2. END IF END IF ELSE IF(PAR(I).GT.PAR(I+1)) THEN IF(PLIM(1,I).GE.0.) THEN IF(PLIM(1,I+1).GE.0.) THEN C- Both free, swap positions TMP=PAR(I) PAR(I) =PAR(I+1) PAR(I+1)=TMP IF(I.GT.NT) THEN C- If previous value messed up, set flag to go again. IF(PAR(I-1).GE.PAR(I)) IAGAIN=1 END IF ELSE C- First free, second frozen, move first PAR(I)=PAR(I+1)-XDEL/2. END IF ELSE IF(PLIM(1,I+1).GT.0) THEN C- First frozen, second free. PAR(I+1)=PAR(I)+XDEL/2. ELSE C- Both frozen, this can only arise if user incorrectly enters data. C- Avoid compounding the error. IF(PAR(I).GE.PAR(I+1)) THEN PAR(I+1)=PAR(I)+XDEL/2. END IF END IF END IF END IF 180 CONTINUE IF(IAGAIN.NE.0) GOTO 120 RETURN END C********* REAL FUNCTION FNAKIM(X, PAR) REAL X, PAR(*) C--- C Uses the coefficient array calculated in the call to AKLIM and C returns the Akima function value. C--- C X I C PAR I C--- C AFT C--- INTEGER MXKNOT PARAMETER (MXKNOT=60) REAL FNXLIM, FNSPLN REAL XT REAL RC, XDEL, YDEL INTEGER NKNOT, IPER COMMON /AKICMN/RC(3,MXKNOT), NKNOT, XDEL, YDEL, IPER C--- XT=FNXLIM(X,PAR(1),PAR(NKNOT),IPER) FNAKIM=FNSPLN(XT,PAR,RC,NKNOT) RETURN END C********* REAL FUNCTION FNXLIM(X, XL, XH, IPER) REAL X, XL, XH INTEGER IPER C--- C Forces X to lie in the range XL to XH. C--- C X I/O C XL I C XH I C IPER I <>0 Force function to be periodic C--- C AFT C--- REAL XT, RANGE C--- XT=X IF(IPER.NE.0) THEN IF(XT.LT.XL) THEN RANGE=XH-XL XT=XT-RANGE*(INT((XT-XL)/RANGE)-1) END IF IF(XT.GT.XH) THEN RANGE=XH-XL XT=XT-RANGE* INT((XT-XL)/RANGE) END IF ELSE XT=MIN(MAX(XL,XT),XH) END IF FNXLIM=XT RETURN END C********* SUBROUTINE AKIMA(PAR, RC, NKNOT, IPER) INTEGER NKNOT, IPER REAL PAR(2*NKNOT), RC(3,NKNOT) C--- C Evaluate Akima coefficients. C See J. of the Ass. for Comp. Mac., 1970, 17, 589. C or PPC Journal, 1985, 12, no. 10, 11. C--- C PAR C C C NKNOT C--- C AFT C--- REAL XDEL, RDIF1, RDIF2, RIM2, RIM1, RIP1 INTEGER I, IP1 C--- DO 120 I=1,NKNOT-1 XDEL=PAR(I+1)-PAR(I) RC(3,I)=(PAR(NKNOT+I+1)-PAR(NKNOT+I))/XDEL 120 CONTINUE IF(IPER.NE.0) THEN RC(3,NKNOT)=RC(3,1) ELSE RC(3,NKNOT)=2.*RC(3,NKNOT-1)-RC(3,NKNOT-2) END IF DO 160 I=1,NKNOT IF(IPER.NE.0) THEN IF(I.LE.2) THEN IF(I.EQ.1) THEN RIM2=RC(3,NKNOT-2) RIM1=RC(3,NKNOT-1) ELSE RIM2=RC(3,NKNOT-1) RIM1=RC(3,1) END IF ELSE RIM2=RC(3,I-2) RIM1=RC(3,I-1) END IF IF(I.LT.NKNOT) THEN RIP1=RC(3,I+1) ELSE RIP1=RC(3,2) END IF ELSE IF(I.LE.2) THEN XDEL=RC(3,1)-RC(3,2) IF(I.EQ.1) THEN RIM2=RC(3,1)+2.*XDEL RIM1=RC(3,1)+ XDEL ELSE RIM2=RC(3,1)+ XDEL RIM1=RC(3,1) END IF ELSE RIM2=RC(3,I-2) RIM1=RC(3,I-1) END IF IF(I.LT.NKNOT) THEN RIP1=RC(3,I+1) ELSE RIP1=RC(3,NKNOT)+RC(3,NKNOT-1)-RC(3,NKNOT-2) END IF END IF RDIF1=ABS(RIP1-RC(3,I)) RDIF2=ABS(RIM1-RIM2) IF(RDIF1+RDIF2.GT.0.) THEN RC(1,I)=(RDIF1*RIM1+RDIF2*RC(3,I))/(RDIF1+RDIF2) ELSE RC(1,I)=(RIP1+RC(3,I))/2. END IF 160 CONTINUE DO 180 I=1,NKNOT-1 IP1=I+1 XDEL=PAR(IP1)-PAR(I) RC(2,I)=(3.*RC(3,I)-2.*RC(1,I)-RC(1,IP1))/XDEL RC(3,I)=(RC(1,I)+RC(1,IP1)-2.*RC(3,I))/(XDEL*XDEL) 180 CONTINUE RETURN END C********* SUBROUTINE AKDERI(X, PAR, PLIM, DERIV, NT, NTERM) REAL X, PAR(*), PLIM(3,*), DERIV(*) INTEGER NT, NTERM C--- C Calculate the derivitive of the AKIMA function with respect to C the parameter values C--- C X C PAR C PLIM C DERIV C NT C NTERM C--- C AFT C--- INTEGER MXKNOT PARAMETER (MXKNOT=60) REAL FNXLIM, FNSPLN REAL RTMP(3,MXKNOT), XT, YT, UFNY0, PXEND, PTMP REAL RC, XDTMP, XDEL, YDEL INTEGER J INTEGER NKNOT, IPER COMMON /AKICMN/RC(3,MXKNOT), NKNOT, XDEL, YDEL, IPER C--- XT=FNXLIM(X,PAR(NT),PAR(NT+NKNOT-1),IPER) UFNY0=FNSPLN(XT,PAR(NT),RC,NKNOT) C- Do X locations DO 130 J=NT,NT+NKNOT-2 IF(NINT(PLIM(1,J)).NE.-1) THEN PTMP=PAR(J) XDTMP=XDEL PAR(J)=PAR(J)+XDTMP IF(PAR(J).GT.PAR(J+1)) THEN XDTMP=(PAR(J+1)-PAR(J))/20. PAR(J)=PTMP+XDTMP END IF IF(J.EQ.NT) THEN C Both endpoints move together. PXEND=PAR(NT+NKNOT-1) PAR(J)=PAR(J)+XDTMP PAR(NT+NKNOT-1)=PAR(NT+NKNOT-1)+XDTMP C Try moving Y knot along spline C PYVAL=PAR(NT+NKNOT) C PAR(NT+NKNOT)=FNSPLN(PAR(J),PAR(NT),RC,NKNOT) C PAR(NT+2*NKNOT-1)=PAR(NT+NKNOT) END IF CALL AKIMA(PAR(NT),RTMP,NKNOT,IPER) YT=FNSPLN(XT,PAR(NT),RTMP,NKNOT) DERIV(J)=(YT-UFNY0)/XDTMP PAR(J)=PTMP IF(J.EQ.NT) THEN PAR(NT+NKNOT-1)=PXEND DERIV(NT+NKNOT-1)=0. C Restore Y values C PAR(NT+NKNOT)=PYVAL C PAR(NT+2*NKNOT-1)=PAR(NT+NKNOT) END IF END IF 130 CONTINUE C- Now do Y values. DO 150 J=NT+NKNOT,NT+2*NKNOT-1 IF(NINT(PLIM(1,J)).NE.-1) THEN PTMP=PAR(J) PAR(J)=PAR(J)+YDEL CALL AKIMA(PAR(NT),RTMP,NKNOT,IPER) YT=FNSPLN(XT,PAR(NT),RTMP,NKNOT) DERIV(J)=(YT-UFNY0)/YDEL PAR(J)=PTMP END IF 150 CONTINUE RETURN END C********* REAL FUNCTION FNSPLN(X, PAR, RC, NKNOT) INTEGER NKNOT REAL X, PAR(2*NKNOT), RC(3,NKNOT) C--- C Evaluates a cubic SPLINE. Returns the value of the spline C approximation given by: C S= ((RC(3,J)*D+RC(2,J))*D+RC(1,J))*D+PAR(NKNOT+J) C where PAR(J).LE.X .LT. PAR(J+1) and D=X-PAR(J). C REMARKS: C 1. The routine assumes that the abscissae of the NKNOT C knots are ordered such that X(I) is less than C X(I+1) for I=1,...,NKNOT-1. C 2. The ordinate Y(NKNOT) is not used by the routine. For C U(K) .GT. X(NKNOT-1), the value of the spline, S(K), is C given by C S(K)=((RC(3,NKNOT-1)*D+RC(2,NKNOT-1))*D+RC(1,NKNOT-1))*D+Y(NKNOT-1) C where D=U(K)-X(NKNOT-1). C C--- C X I The abscissae of the point at which the cubic spline C -is to be evaluated. C PAR I PAR(1) to PAR(NKNOT) contains the abscissae of the C -knots which must be ordered so that PAR(I).LT.PAR(I+1). C -PAR(NKNOT+1) to PAR(2*NKNOT) contains the C -ordinates (or function values) of the knots. C RC I SPLINE coefficients. RC is an NKNOT-1 by 3 matrix. C--- C AFT C--- REAL D, DD INTEGER I DATA I/1/ C--- C- Find the proper interval D=X-PAR(I) C IF(D) 5,20,15 IF ( D.GT.0.0 ) GOTO 15 IF ( D.EQ.0.0 ) GOTO 20 C--- 5 IF(I .EQ. 1) GOTO 20 I=I-1 D=X-PAR(I) IF(D.GE.0) GOTO 20 GOTO 5 C--- 10 I=I+1 D=DD 15 IF(I .GE. NKNOT) THEN I=NKNOT-1 D=X-PAR(I) GOTO 20 END IF DD=X-PAR(I+1) IF(DD .GE. 0.0) GOTO 10 C- Perform evaluation 20 FNSPLN=((RC(3,I)*D+RC(2,I))*D+RC(1,I))*D+PAR(NKNOT+I) RETURN END fv5.5/tcltk/plt/akinte.f0000644000220700000360000001245113224715127014066 0ustar birbylhea SUBROUTINE AKINTE(Xval, Y, Igroup, Iy0, Npts, iper, Init, Yval) REAL Xval, Y(*), Yval INTEGER igroup, Iy0, Npts, iper, Init C--- C Interpolate a value using an Akima spline. This is an PLT internal C routine. C--- C Xval I The X position to interpolate C Y I The data array C Igroup I Used by pltxc to calculate the current X value. C Iy0 I Y(Iy0+I) is the y-value of the Ith data point. C Npts I The last data point in the fit range. C iper I =0 not periodic, <>0 force periodic boundary condition. C Init I/O <>0 force spline coef. to be recalcuated. Set to zero on exit. C Yval O The interpolated Y position C--- C 1991-Nov-20 - AFT C--- REAL NO PARAMETER (NO=-1.2E-34) INTEGER MXDIM PARAMETER (MXDIM=2) C REAL slope(-2:2), xt(MXDIM), x1(MXDIM) REAL rc1(0:1), rc2, rc3 SAVE rc1, rc2, rc3 REAL dx, dd, rdif1, rdif2, rim2, rim1, rip1, sdel, xdel INTEGER ip(-2:3) SAVE ip INTEGER i, itry, j, ndim, iyoff, iyof1 INTEGER inew, ie, is, iyof0 SAVE inew, ie, is, iyof0 C--- IF ( Init.NE.0 ) THEN ip(0)=0 Init=0 DO i=1,Npts CALL PLTXCC(Y, i, Igroup, xt, ndim, iyoff) IF ( Y(Iy0+iyoff).NE.NO .AND. xt(1).NE.NO ) THEN IS=I GOTO 110 END IF END DO 110 CONTINUE DO i=Npts,1,-1 CALL PLTXCC(Y, i, Igroup, xt, ndim, iyoff) IF ( Y(Iy0+iyoff).NE.NO .AND. xt(1).NE.NO ) THEN ie=i GOTO 120 END IF END DO 120 CONTINUE inew=is END IF C C Find the proper interval CALL PLTXCC(Y, inew, igroup, xt, ndim, iyoff) dx = XVAL-xt(1) C IF ( dx ) 130,200,150 IF ( dx.GT.0.0 ) GOTO 150 IF ( dx.EQ.0.0 ) GOTO 200 C--- C Search backwards until Y value<>NO and D becomes positive 130 CONTINUE IF ( inew.EQ.is ) GOTO 200 inew = inew-1 CALL PLTXCC(Y, inew, igroup, xt, ndim, iyoff) IF ( Y(Iy0+iyoff).EQ.NO .OR. xt(1).EQ.NO ) GOTO 130 dx = XVAL-xt(1) IF ( dx.GE.0.0 ) GOTO 200 GOTO 130 C--- C Search forwards until Y value<>NO and next D is negative 150 itry=inew 160 IF ( itry+1.GE.ie ) GOTO 200 itry=itry+1 CALL PLTXCC(Y, itry, igroup, xt, ndim, iyoff) IF ( Y(Iy0+iyoff).EQ.NO .OR. xt(1).EQ.NO ) GOTO 160 dd = XVAL-xt(1) IF ( dd.LT.0.0 ) GOTO 200 dx = dd inew=itry GOTO 160 C--- 200 CONTINUE IF ( inew.NE.ip(0) ) THEN C--- C Set up pointer array for periodic boundary condition. Add Npts before C taking MOD to ensure positive result. ip(-2)=MOD(Npts+inew-3,Npts)+1 ip(-1)=MOD(Npts+inew-2,Npts)+1 ip( 0)=inew ip( 1)=MOD( inew ,Npts)+1 ip( 2)=MOD( inew+1,Npts)+1 ip( 3)=MOD( inew+2,Npts)+1 C--- C Remove any pointers to NO data values DO i=1,3 240 CONTINUE CALL PLTXCC(Y, ip(i), igroup, xt, ndim, iyoff) IF ( Y(Iy0+iyoff).EQ.NO .OR. xt(1).EQ.NO ) THEN DO J=I,3 ip(J)=MOD(ip(J),Npts)+1 END DO IF(ip(3).LT.IE) GOTO 240 END IF END DO DO i=-1,-2,-1 260 CONTINUE CALL PLTXCC(Y, ip(i), igroup, xt, ndim, iyoff) IF ( Y(Iy0+iyoff).EQ.NO .OR. xt(1).EQ.NO ) THEN DO J=I,-2,-1 ip(J)=MOD(Npts+ip(J)-2,Npts)+1 END DO IF(ip(-2).GT.IS) GOTO 260 END IF END DO C C Calculate slopes assuming periodic boundary condition. DO i=-2,2 CALL PLTXCC(Y, ip(i), igroup, x1, ndim, iyoff) CALL PLTXCC(Y, ip(i+1), igroup, xt, ndim, iyof1) xdel=xt(1) - x1(1) slope(I)=(Y(Iy0+iyof1)-Y(Iy0+iyoff))/xdel END DO C--- C If not periodic, then fix up ends if needed. IF ( iper.EQ.0 ) THEN IF ( ip(0).EQ.IS ) THEN sdel=slope(0)-slope(1) slope(-2)=slope(0)+2.*sdel slope(-1)=slope(0)+ sdel ELSE IF ( ip(0).EQ.IS+1 ) THEN sdel=slope(-1)-slope(0) slope(-2)=slope(-1)+ sdel ELSE IF ( ip(0).EQ.IE-2 ) THEN slope(2)=2*slope(1)-slope(0) ELSE IF ( ip(0).EQ.IE-1 ) THEN slope(1)=2*slope(0)-slope(-1) slope(2)=slope(1)+slope(0)-slope(-1) END IF END IF C--- C Calcuate parameters for Akima Spline. DO i=0,1 rim2=slope(I-2) rim1=slope(I-1) rip1=slope(I+1) rdif1=ABS(rip1-slope(I)) rdif2=ABS(rim1-rim2) IF ( rdif1+rdif2.GT.0. ) THEN rc1(i)=(rdif1*rim1+rdif2*slope(i))/(rdif1+rdif2) ELSE rc1(i)=(rip1+slope(I))/2. END IF END DO C CALL PLTXCC(Y, ip(0), Igroup, x1, ndim, iyof0) CALL PLTXCC(Y, ip(1), Igroup, xt, ndim, iyoff) xdel = xt(1) - x1(1) rc2=(3.*slope(0)-2.*rc1(0)-rc1(1))/xdel rc3=(rc1(0)+rc1(1)-2.*slope(0))/(xdel*xdel) END IF C--- C Calculate function value. Yval=((rc3*dx+rc2)*dx+rc1(0))*dx+Y(Iy0+iyof0) RETURN END fv5.5/tcltk/plt/codsub.f0000644000220700000360000012150213224715127014070 0ustar birbylheaC Contains entry points for: C CODFIL C CODLIS C CODTOK C FNCOD C FNCLOA C CODADD SUB Add a word in the user dictionary C CODCTI SUB Convert word to integer token C CODITC SUB Convert integer token to word C CODWOR SUB Find a word in the dictionary C CODDER C--- SUBROUTINE CODFIL(Cbuf, Lbuf, Kp, Nterm, Ier) CHARACTER Cbuf*(*) INTEGER Lbuf, Kp, Nterm, Ier C Entry codfqc/codfsc INTEGER Ichata C--- C COmponent DEFination FILe. C Reads a disk COD file into program memory. C--- C Cbuf I C Lbuf I C Kp I/O C Nterm O C Ier O C--- C 1989-Feb-13 - latest mod [AFT] C--- REAL NO PARAMETER (NO=-1.2E-34) C- REAL FNCLOA, FNCOD INTEGER LENACT C- CHARACTER ctmp*256 CHARACTER ctok*132 CHARACTER clib*120 CHARACTER cdisk*12, cdir*12 REAL tmp, X, PAR(1) INTEGER ichat SAVE ichat INTEGER icode, idelpc, idelsp, ientry, itry, itmp, ios INTEGER llib, ltmp, ltok, lun, newt DATA cdisk/'$XANADU'/, cdir/'xanlib/cod'/ DATA ichat/100/ C--- 11 FORMAT(A) C--- clib=' ' CALL PTEND(cdisk,cdir,clib) llib=LENACT(clib) CALL GETlun(lun) newt=0 Ier=0 IF ( Cbuf(Kp+1:Kp+1).EQ.'$' ) Kp=Kp+1 ctok=Cbuf(Kp+1:) C- First search the current directory for the file. itry=0 100 CONTINUE CALL XTEND(ctok,'cod') CALL OPENWR(lun,ctok,'OLD',' ',' ',0,1,ios) IF ( ios.NE.0 ) THEN IF ( itry.EQ.0 ) THEN C- Look in a standard library for file. itry=1 ctok=clib(:llib)//Cbuf(Kp+1:) CALL CONC(ctok(llib+1:)) GOTO 100 END IF Ier=1 GOTO 910 END IF C--- 120 CONTINUE READ(lun,11,ERR=500,END=500) ctmp ltmp=LENACT(ctmp) IF ( ichat.GT.0 ) WRITE(*,*) ctmp(:ltmp) Kp=0 CALL ALF(ctmp,ltmp,Kp,ctok,ltok) IF ( ctok(1:1).EQ.'!' ) GOTO 120 C--- Kp=0 150 CONTINUE CALL ALF(ctmp,ltmp,Kp,ctok,ltok) IF ( ltok.EQ.0 ) GOTO 120 CALL CODTOK(+1,ctok,ltok,icode,idelpc,idelsp,Ier) IF ( Ier.NE.0 ) GOTO 900 IF ( idelpc.LE.0 ) GOTO 150 tmp=FNCOD(-1,icode,X,PAR,-1,Ier) IF ( ctok(:ltok).EQ.':' ) THEN tmp=FNCLOA(-7,ientry,itmp,0.) END IF IF ( icode.GE.4000 .AND. icode.LT.6000 ) THEN C- Count parameters newt=MAX(newt,icode-4000) END IF GOTO 150 C--- 500 CONTINUE Nterm=newt ientry=ientry+1 tmp=FNCLOA(+4,ientry,0,0.) IF ( ichat.GE.50 ) WRITE(*,*) 'Nterm=',newt CLOSE(UNIT=lun) CALL FRElun(lun) RETURN C--- C- Error return 900 CONTINUE WRITE(*,*) 'CODFIL--Illegal token=',ctok(:ltok) 910 Nterm=0 CLOSE(UNIT=lun) CALL FRElun(lun) Ier=1 RETURN C********* ENTRY CODFSC(ichata) ichat = Ichata RETURN C********* ENTRY CODFQC(ichata) Ichata = ichat RETURN END C********* SUBROUTINE CODLIS C--- C List the current COD program in a FORTRAN style. Note this will C only work for simple COD programs. C--- C 1988-Nov-30 - [AFT] C--- INTEGER MXSTAC PARAMETER (MXSTAC=10) C- REAL FNCLOA INTEGER LENACT C- CHARACTER cbuf*80, cstac(MXSTAC)*80 CHARACTER ctok*80 REAL tmp INTEGER lstac(MXSTAC), isum(MXSTAC) INTEGER icnt, icode, idelpc, idelsp, ier, indent, ipnt INTEGER lbuf, lev, lpc, ltok C--- icnt=0 lpc=1 C 90 CONTINUE cstac(1)='Stack1' lstac(1)=LENACT(cstac(1)) ipnt=1 indent=1 lev=0 100 CONTINUE tmp=FNCLOA(-1,lpc,icode,tmp) IF ( icode.EQ.0 ) THEN C- END statement GOTO 900 END IF C- Get token form CALL CODTOK(-1,ctok,ltok,icode,idelpc,idelsp,ier) IF ( ctok(1:ltok).EQ.'IF' ) THEN C- IF IF ( ipnt.LE.0 ) GOTO 800 IF ( lstac(ipnt).GT.0 ) THEN ctok=' ' WRITE(*,*) ctok(:indent),'IF ',cstac(ipnt)(:lstac(ipnt)) END IF indent=indent+3 ipnt=ipnt-1 ELSE IF ( ctok(1:ltok).EQ.'ELSE' ) THEN C- ELSE IF ( ipnt.LE.0 ) GOTO 800 IF ( lstac(ipnt).GT.0 ) THEN ctok=' ' WRITE(*,*) ctok(:indent),cstac(ipnt)(:lstac(ipnt)) END IF WRITE(*,*) ctok(:indent-3),'ELSE' ELSE IF ( ctok(1:ltok).EQ.'THEN' ) THEN C- THEN IF ( ipnt.LE.0 ) GOTO 800 IF ( lstac(ipnt).GT.0 ) THEN ctok=' ' WRITE(*,*) ctok(:indent),cstac(ipnt)(:lstac(ipnt)) END IF indent=indent-3 WRITE(*,*) ctok(:indent),'THEN' ELSE IF ( ctok(1:ltok).EQ. ':' ) THEN C- : WRITE(*,*) ctok(:ltok) ELSE IF ( ctok(1:ltok).EQ.';' ) THEN C- ; IF ( ipnt.EQ.0 ) THEN WRITE(*,111) 111 FORMAT('; Return: ',A) ELSE WRITE(*,111) cstac(ipnt)(:lstac(ipnt)) END IF WRITE(*,*) lpc=lpc+idelpc GOTO 90 ELSE IF ( ctok(1:2).EQ.'DR' .OR. ctok(1:ltok).EQ.'.' ) THEN C- DRop . IF ( ipnt.LE.0 ) GOTO 800 ipnt=ipnt-1 ELSE IF ( ctok(1:2).EQ.'DU' ) THEN C- DUp IF ( ipnt.LE.0 ) GOTO 800 cstac(ipnt+1)=cstac(ipnt) lstac(ipnt+1)=lstac(ipnt) isum(ipnt+1)=isum(ipnt) ipnt=ipnt+1 ELSE IF ( ctok(1:2).EQ.'SW' ) THEN C- SWap IF ( ipnt.LE.1 ) GOTO 800 cbuf=cstac(ipnt) cstac(ipnt)=cstac(ipnt-1) cstac(ipnt-1)=cbuf lbuf=lstac(ipnt) lstac(ipnt)=lstac(ipnt-1) lstac(ipnt-1)=lbuf ELSE IF ( idelsp.EQ.1 ) THEN C- Push number onto stack IF ( ipnt.GE.MXSTAC ) GOTO 800 ipnt=ipnt+1 cstac(ipnt)=ctok(:ltok) lstac(ipnt)=ltok isum(ipnt)=0 ELSE IF ( idelsp.EQ.-1 ) THEN C- Binary operation, first check that each of the two terms being C- combined does not contain a + or - operator signaled by isum.NE.0. C- If this is true then the term will need to be enclosed in '()'. IF ( ipnt.LE.1 ) GOTO 800 IF ( isum(ipnt-1).GT.0 .OR. : (ctok(1:1).EQ.'^' .AND. isum(ipnt-1).NE.0) ) THEN cbuf='('//cstac(ipnt-1)(:lstac(ipnt-1))//')' cstac(ipnt-1)=cbuf lstac(ipnt-1)=lstac(ipnt-1)+2 END IF IF ( isum(ipnt).GT.0 .OR. : (ctok(1:1).EQ.'^' .AND. isum(ipnt).NE.0) ) THEN cbuf='('//cstac(ipnt)(:lstac(ipnt))//')' cstac(ipnt)=cbuf lstac(ipnt)=lstac(ipnt)+2 END IF C- cbuf=cstac(ipnt-1)(:lstac(ipnt-1))//ctok(:ltok)// : cstac(ipnt)(:lstac(ipnt)) ipnt=ipnt-1 lstac(ipnt)=LENACT(cbuf) cstac(ipnt)=cbuf(:lstac(ipnt)) IF ( ctok(1:1).EQ.'+' .OR. ctok(1:1).EQ.'-' ) THEN isum(ipnt)= 1 ELSE isum(ipnt)=-1 END IF ELSE C- Uniary operator IF ( ipnt.LE.0 ) GOTO 800 IF ( ctok(2:2).EQ.'+' .OR. ctok(2:2).EQ.'-' ) THEN C- Special treatment for 1+, 1-, 2+ and 2- cbuf='('//cstac(ipnt)(:lstac(ipnt))//')'// : ctok(2:2)//ctok(1:1) isum(ipnt)=1 ELSE cbuf=ctok(:ltok)//'('//cstac(ipnt)(:lstac(ipnt))//')' isum(ipnt)=0 END IF cstac(ipnt)=cbuf lstac(ipnt)=LENACT(cbuf) END IF C- IF ( ipnt.GT.0 .AND. lstac(ipnt).GE.40 ) THEN icnt=icnt+1 cbuf='T' lbuf=1 CALL CRAMI(icnt,cbuf,lbuf) WRITE(*,211) cbuf(:lbuf),cstac(ipnt)(:lstac(ipnt)) 211 FORMAT(1X,A4,'==',A) cstac(ipnt)=cbuf lstac(ipnt)=lbuf isum(ipnt)=0 END IF C WRITE(*,*) I,ipnt,' ',cstac(ipnt)(:lstac(ipnt)) lpc=lpc+idelpc GOTO 100 C--- 800 CONTINUE WRITE(*,*) 'CODLIS--Stack error.' WRITE(*,*) cstac(ipnt)(:lstac(ipnt)) RETURN C--- 900 RETURN END C********* SUBROUTINE CODTOK(Idir, Ctok, Ltok, Icode, Idelpc, Idelsp, Ier) INTEGER Idir, Ltok, Icode, Idelsp, Idelpc, Ier CHARACTER Ctok*(*) C--- C If Idir.LT.0 then C disassemble Icode into Ctok, Idelsp=change in stack C Idir.GT.0 C compile Ctok(:Ltok) to Icode, Idelpc=number of program steps used. C--- C 1989-Jan-29 - [AFT] C--- REAL NO PARAMETER (NO=-1.2E-34) INTEGER MXTOK, MXDEF PARAMETER (MXTOK=67, MXDEF=16) C REAL FPNUM, FNCLOA INTEGER ISNUM, LENACT C CHARACTER code(MXTOK)*4, cdef(MXDEF)*6 SAVE code, cdef CHARACTER ctmp*132 REAL tmp, VALUE INTEGER I, itmp, iend, LDEF, LOC INTEGER INAME SAVE INAME INTEGER NDEL(MXTOK), IDEFS(MXDEF) SAVE NDEL, IDEFS C DATA code/ : '+ ', '- ', '* ', '/ ', '^ ', 'DEPt', 'DRop', : 'DUP', 'OVer', 'PICK', 'ROLL', 'ROT', 'SWap', '?Dup', : 'ABS', 'NEG', '1/', 'PI', 'LN', 'EXP', 'LOG', : 'ALog', 'SQrt', 'COS', 'SIN', 'TAN', 'ACos', 'ASin', : 'ATan', 'A2tn', 'HCos', 'HSin', 'HTan', 'INT', 'NInt', : 'MOD', '/MOD', 'TSIg', 'DTor', 'RTod', 'DMsd', 'DDms', : 'ERFC', 'ERF', 'GAMM', : '<', '=', '>', '0<', '0=', '0>', 'NOT', : '.', '1+', '1-', '2+', '2-', 'MIN', 'MAX', : 'STO', '+STO', 'RCL', '?', 'VAR', ':', ';', : 'ABO'/ DATA NDEL/ : -1, -1, -1, -1, -1, 1, -1, : 0, 1, 0, 0, 0, 0, 1, : 0, 0, 0, 1, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, : 0, -1, 0, 0, 0, 0, 0, : -1, -1, -1, 0, 0, 0, 0, : 0, 0, 0, : -1, -1, -1, 0, 0, 0, 0, : -1, 0, 0, 0, 0, -1, -1, : -2, -2, 1, -1, 0, 0, 0, : -999/ DATA cdef/ : 'X', 'IF', 'ELSE', 'THEN', 'FOR', 'LOOP', '+LOOP', : 'I', 'J', 'LEAVE', 'BEGIN', 'UNTIL', 'WHILE','REPEAT', : 'EXIT','Y'/ DATA IDEFS/ : 1, -1, 0, 0, -1, 0, -1, : 1, 1, 0, 0, -1, -1, 0, : 0, 1/ DATA INAME/0/ C--- Idelsp=0 Idelpc=1 Ier=0 IF ( Idir.LT.0 ) THEN IF ( Icode.GT.6000 ) THEN C- VAR's and : name. CALL CODITC(Icode, Ctok, Ltok, Ier) ELSE IF ( Icode.GT.4000 ) THEN Ctok='P' Ltok=1 itmp=Icode-4000 CALL CRAMI(itmp,Ctok,Ltok) ELSE IF ( Icode.GT.2000 ) THEN LOC=Icode-2000 tmp=FNCLOA(-2,LOC,0,VALUE) Ltok=0 CALL CRAMF(VALUE,Ctok,Ltok) ELSE IF ( 0.LT.Icode .AND. Icode.LE.MXTOK ) THEN Ctok=code(Icode) Ltok=LENACT(Ctok) ELSE IF ( -MXDEF.LE.Icode .AND. Icode.LT.0 ) THEN Ctok=cdef(-Icode) Ltok=LENACT(Ctok) ELSE Ctok='END' Ltok=3 END IF ELSE C- Compile the token CALL UPC(Ctok) Icode=0 DO I=1,MXTOK IF ( Ctok(1:2).EQ.code(I)(1:2) ) THEN C- First two characters match. Look for non-upper case to decide where C- match should end. iend = 4 itmp=ICHAR(code(I)(4:4)) IF ( itmp.LT.65 .OR. 90.LT.itmp ) iend=3 itmp=ICHAR(code(I)(3:3)) IF ( itmp.LT.65 .OR. 90.LT.itmp ) iend=2 itmp=ICHAR(code(I)(2:2)) IF ( itmp.LT.65 .OR. 90.LT.itmp ) iend=1 IF ( ltok.GE.iend ) THEN C User entered at least minimum, match all the user typed. ctmp = code(i) CALL UPC(ctmp) itmp = MIN(ltok,LENACT(ctmp)) IF ( Ctok(1:ltok).EQ.ctmp(:itmp) ) THEN Icode=I GOTO 300 END IF END IF END IF END DO C--- C- Now consider words that can only appear in programs. IF ( Ltok.LT.LEN(Ctok) ) Ctok(Ltok+1:)=' ' DO I=1,MXDEF LDEF=LENACT(cdef(I)) IF ( LDEF.EQ.Ltok ) THEN C- Must be exact length IF ( Ctok(:LDEF).EQ.cdef(I)(:LDEF) ) THEN Icode=-I GOTO 300 END IF END IF END DO C--- C- Check for special cases (parameter or constant) IF ( ISNUM(Ctok,Ltok).NE.0 ) THEN C- A constant tmp=FPNUM(Ctok,Ltok,Ier) tmp=FNCLOA(2,0,Icode,tmp) GOTO 300 END IF IF ( Ctok(1:1).EQ.'P' ) THEN IF ( ISNUM(Ctok(2:),Ltok-1).NE.0 ) THEN C- Parameter number. Ltok=Ltok-1 Icode=4000+MIN(NINT(FPNUM(Ctok(2:Ltok),Ltok,Ier)),100) GOTO 300 END IF END IF C- Last chance, check user-defined dictionary word. CALL CODCTI(Ctok, Ltok, Icode, Ier) C--- C- Check for VARiable definations when compiling. 300 CONTINUE IF ( Ier.EQ.0 ) THEN C- Got a match, make sure not in VARiable defination. IF ( INAME.NE.0 ) THEN Idelpc=0 Icode=0 WRITE(*,*) 'CODTOK--Not allowed to redefine key word.' Ier=1 END IF C- Set flag to indicate that next token should go into dictionary. IF ( Ctok(1:Ltok).EQ.'VAR' ) THEN Idelpc=0 INAME=1 ELSE IF ( Ctok(1:Ltok).EQ.':' ) THEN INAME=2 END IF ELSE C- No match IF ( INAME.NE.0 ) THEN C- We have a new dictionary word. Idelpc=0 IF ( INAME.EQ.1 ) THEN tmp=FNCLOA(+3,0,Icode,VALUE) ELSE tmp=FNCLOA(-6,itmp,Icode,VALUE) Icode=8000+itmp END IF CALL CODADD(Ctok, Ltok, Icode, Ier) INAME=0 END IF END IF END IF C--- 800 CONTINUE IF ( Ier.EQ.0 ) THEN IF ( Icode.EQ.-2 .OR. Icode.EQ.-3 .OR. Icode.EQ.-5 .OR. : Icode.EQ.-6 .OR. Icode.EQ.-7 .OR. Icode.EQ.-13 ) Idelpc=2 IF ( Icode.GT.2000 .AND. Icode.LT.8000 ) THEN C- 2000, 4000, 6000 (const, parameter, variable) Idelsp=1 ELSE IF ( 0.LT.Icode .AND. Icode.LE.MXTOK ) THEN Idelsp=NDEL(Icode) ELSE IF ( -MXDEF.LE.Icode .AND. Icode.LT.0 ) THEN Idelsp=IDEFS(-Icode) ELSE Idelsp=0 END IF END IF END C********* REAL FUNCTION FNCOD(ISTEP, INTER, X, PAR, NTERM, ier) REAL X(2), PAR(*) INTEGER ISTEP, INTER, NTERM, ier C--- C On input: C If ISTEP.LT.0 then execute the program step in INTER C If ISTEP.EQ.0 then run program pointed at by IENTRY C If ISTEP.GT.0 then take a single step C On output C ier= 0 for no error. C ier= -1 if ISTEP<0 and INTER>0 and program is not compiling C ier=100 when attempting to single step past final ; C--- C ISTEP I Single step command C X I The current value of X C PAR(NTERM) I The parameter array C--- C 1989-Jan-29 - Latest mod [AFT] C--- REAL NO, INF PARAMETER (NO=-1.2E-34, INF= 1.2E+34) INTEGER MXPROG PARAMETER (MXPROG=1500) INTEGER MXSTAC, MXMEM, MXPROC PARAMETER (MXSTAC=50, MXMEM=100, MXPROC=50) C Note, ERF is an intinsic for g77. REAL ERF, ERFC, GAMMA C CHARACTER ctmp*8 INTEGER*2 IPROG(MXPROG), IRET(MXSTAC), IPLOC(MXPROC) SAVE IPROG, IRET, IPLOC INTEGER IRPT, ISPT SAVE IRPT, ISPT INTEGER ltok REAL STACK(MXSTAC), FMEM(MXMEM) SAVE STACK, FMEM C REAL tmp, RSEC INTEGER I, icnt, IDEG, IMIN, INEW, INSTR, Itmp INTEGER ICOMP, idelpc, idelsp, IENTRY, IPC SAVE ICOMP, idelpc, idelsp, IENTRY, IPC INTEGER IPCNT, LCLOC, lpc, LVAR SAVE IPCNT, LCLOC, lpc, LVAR INTEGER J, lev C Used in ENTRY points REAL FNCLOA, FNPMAT INTEGER IFUNC, ILOC, Icode, K, LOC, IPNUM REAL VALUE C DATA IPC/1/, ICOMP/0/, lpc/0/, IENTRY/2/ C--- FNCOD=0. IF ( ICOMP.NE.0 ) THEN IF ( INTER.LT.0 ) THEN GOTO( 100,6020,6030,6040,6020,6060,6060, 100, 100, 100, : 100, 100, 100,6020, 100) -INTER END IF 100 IF ( lpc.GE.MXPROG ) GOTO 950 lpc=lpc+1 IPROG(lpc)=INTER C Number is MXTOK-1 IF ( INTER.EQ.66 ) ICOMP=0 RETURN ELSE IF ( ISTEP.LT.0 .AND. INTER.LT.0 ) THEN C- Trying to interpret an instruction that can only be compiled. ier=-1 RETURN END IF END IF C--- IF ( ISTEP.LT.0 ) THEN C- Run code step passed in INTER IPC=IPC-1 INSTR=INTER ELSE IF ( ISTEP.EQ.0 ) THEN C- Reset and run entire program IRPT=0 ISPT=0 IPC=IENTRY INSTR=IPROG(IPC) ELSE C- Single step from current position INSTR=IPROG(IPC) END IF C--- 5 CONTINUE GOTO(1010,1020,1030,1040,1050,1060,1070,1080,1090,1100, : 1110,1120,1130,1140,1150,1160,1170,1180,1190,1200, : 1210,1220,1230,1240,1250,1260,1270,1280,1290,1300, : 1310,1320,1330,1340,1350,1360,1370,1380,1390,1400, : 1410,1420,1430,1440,1450,1460,1470,1480,1490,1500, : 1510,1520,1530,1540,1550,1560,1570,1580,1590,1600, : 1610,1620,1630,1640,1650,1660,1670) INSTR C- IF ( INSTR.LT.0 ) THEN GOTO(5010,5020,5030,5040,5050,5060,5070,5080,5090,5100, : 5110,5120,5130,5140,5150,5160) -INSTR GOTO 900 ELSE IF ( INSTR.GE.8000 ) THEN C- GSB subroutine. IF ( IRPT.GE.MXSTAC ) GOTO 920 IRPT=IRPT+1 IRET(IRPT)=IPC Itmp=INSTR-8000 IF ( Itmp.GT.IPCNT ) GOTO 930 IPC=IPLOC(Itmp) ELSE IF ( INSTR.GT.6000 ) THEN C- Push variable address onto stack IF ( ISPT.GE.MXSTAC ) GOTO 920 Itmp=INSTR-6000 ISPT=ISPT+1 STACK(ISPT)=Itmp ELSE IF ( INSTR.GT.4000 ) THEN C- Push a parameter onto the stack IF ( ISPT.GE.MXSTAC ) GOTO 920 Itmp=INSTR-4000 ISPT=ISPT+1 STACK(ISPT)=PAR(Itmp) ELSE IF ( INSTR.GE.2000 ) THEN C- Push a constant onto the stack IF ( ISPT.GE.MXSTAC ) GOTO 920 ISPT=ISPT+1 Itmp=INSTR-2000 STACK(ISPT)=FMEM(Itmp) ELSE GOTO 900 END IF GOTO 880 C--- C- + 1010 IF ( ISPT.LE.1 ) GOTO 910 STACK(ISPT-1)=STACK(ISPT-1)+STACK(ISPT) ISPT=ISPT-1 GOTO 880 C- - 1020 IF ( ISPT.LE.1 ) GOTO 910 STACK(ISPT-1)=STACK(ISPT-1)-STACK(ISPT) ISPT=ISPT-1 GOTO 880 C- * 1030 IF ( ISPT.LE.1 ) GOTO 910 STACK(ISPT-1)=STACK(ISPT-1)*STACK(ISPT) ISPT=ISPT-1 GOTO 880 C- / 1040 IF ( ISPT.LE.1 ) GOTO 910 IF ( STACK(ISPT).NE.0. ) THEN STACK(ISPT-1)=STACK(ISPT-1)/STACK(ISPT) ELSE STACK(ISPT-1)=INF END IF ISPT=ISPT-1 GOTO 880 C- ^ 1050 IF ( ISPT.LE.1 ) GOTO 910 IF ( STACK(ISPT-1).EQ.0.0 ) THEN IF ( STACK(ISPT).EQ.0.0 ) GOTO 970 C zero to non-zero power. STACK(ISPT-1)=0.0 ELSE IF ( STACK(ISPT-1).LT.0. ) GOTO 970 tmp=STACK(ISPT)*LOG(STACK(ISPT-1)) IF ( tmp.LE.78. ) THEN STACK(ISPT-1)=EXP(tmp) ELSE STACK(ISPT-1)=INF END IF END IF ISPT=ISPT-1 GOTO 880 C- DEPth Return the current stack depth 1060 IF ( ISPT.GE.MXSTAC ) GOTO 920 STACK(ISPT+1)=ISPT ISPT=ISPT+1 GOTO 880 C- DROP Lose top of stack 1070 IF ( ISPT.GE.1 ) ISPT=ISPT-1 GOTO 880 C- DUP Duplicate top of stack 1080 IF ( ISPT.LE.0 ) GOTO 910 IF ( ISPT.GE.MXSTAC ) GOTO 920 STACK(ISPT+1)=STACK(ISPT) ISPT=ISPT+1 GOTO 880 C- OVER Duplicate second item from top 1090 IF ( ISPT.LT.2 ) GOTO 910 IF ( ISPT.GE.MXSTAC ) GOTO 920 STACK(ISPT+1)=STACK(ISPT-1) ISPT=ISPT+1 GOTO 880 C- PICK Duplicate nth item on top of stack 1100 IF ( ISPT.LE.0 ) GOTO 910 Itmp=ISPT-NINT(STACK(ISPT)) IF ( Itmp.LE.0 .OR. Itmp.GE.ISPT ) GOTO 910 STACK(ISPT)=STACK(Itmp) GOTO 880 C- ROLL Rotate nth item to top 1110 IF ( ISPT.LE.0 ) GOTO 910 Itmp=ISPT-NINT(STACK(ISPT)) ISPT=ISPT-1 IF ( Itmp.LE.0 .OR. Itmp.GE.ISPT ) GOTO 910 tmp=STACK(Itmp) DO 1115 J=Itmp,ISPT-1 STACK(J)=STACK(J+1) 1115 CONTINUE STACK(ISPT)=tmp GOTO 880 C- ROTRotate third item to top 1120 IF ( ISPT.LT.3 ) GOTO 910 tmp=STACK(ISPT-2) STACK(ISPT-2)=STACK(ISPT-1) STACK(ISPT-1)=STACK(ISPT) STACK(ISPT)=tmp GOTO 880 C- SWAP Reverse top two stack items 1130 IF ( ISPT.LT.2 ) GOTO 910 tmp=STACK(ISPT-1) STACK(ISPT-1)=STACK(ISPT) STACK(ISPT)=tmp GOTO 880 C- ?DUP Duplicate only if non-zero 1140 IF ( ISPT.LE.0 ) GOTO 910 IF ( STACK(ISPT).NE.0. ) THEN IF ( ISPT.GE.MXSTAC ) GOTO 920 STACK(ISPT+1)=STACK(ISPT) ISPT=ISPT+1 END IF GOTO 880 C- ABS Absolute value 1150 STACK(ISPT)=ABS(STACK(ISPT)) GOTO 880 C- NEG Negate 1160 STACK(ISPT)=-STACK(ISPT) GOTO 880 C- 1/ (reciprocal) 1170 IF (ABS(STACK(ISPT)) .LE. 1.0E-34) THEN STACK(ISPT)=INF ELSE STACK(ISPT)=1.0/STACK(ISPT) END IF GOTO 880 C- PI (Pi) 1180 IF ( ISPT.GE.MXSTAC ) GOTO 920 STACK(ISPT+1)=ATAN2(0.0,-1.0) ISPT=ISPT+1 GOTO 880 C- LN (natural log) 1190 IF ( STACK(ISPT).LE.0. ) GOTO 970 STACK(ISPT)=LOG(STACK(ISPT)) GOTO 880 C- EXP 1200 tmp=MAX(-80.,MIN(STACK(ISPT),80.)) STACK(ISPT)=EXP(tmp) GOTO 880 C- LOG (common log) 1210 IF ( STACK(ISPT).LE.0. ) GOTO 970 STACK(ISPT)=LOG10(STACK(ISPT)) GOTO 880 C- ALOG (Anti common log) 1220 tmp=MAX(-34.,MIN(STACK(ISPT),34.)) STACK(ISPT)=10.0**tmp GOTO 880 C- SQRT (square root) 1230 STACK(ISPT)=SQRT(ABS(STACK(ISPT))) GOTO 880 C- COS 1240 STACK(ISPT)=COS(STACK(ISPT)) GOTO 880 C- SIN 1250 STACK(ISPT)=SIN(STACK(ISPT)) GOTO 880 C- TAN 1260 STACK(ISPT)=TAN(STACK(ISPT)) GOTO 880 C- ACOS (arc cosine) 1270 IF (ABS(STACK(ISPT)) .LE. 1.0) THEN STACK(ISPT)=ACOS(STACK(ISPT)) ELSE STACK(ISPT)=INF END IF GOTO 880 C- ASIN (arc sin) 1280 IF (ABS(STACK(ISPT)) .LE. 1.0) THEN STACK(ISPT)=ASIN(STACK(ISPT)) ELSE STACK(ISPT)=INF END IF GOTO 880 C- ATAN (arc tan) 1290 STACK(ISPT)=ATAN(STACK(ISPT)) GOTO 880 C- A2TN (arc tan 2 arguments) 1300 IF ( ISPT.LE.1 ) GOTO 910 IF ( STACK(ISPT).EQ.0.0 .AND. STACK(ISPT-1).EQ.0.0 ) THEN STACK(ISPT-1)=0.0 ELSE STACK(ISPT-1)=ATAN2(STACK(ISPT-1),STACK(ISPT)) END IF ISPT=ISPT-1 GOTO 880 C- HCOS (Hyperbolic cosine) 1310 STACK(ISPT)=COSH(STACK(ISPT)) GOTO 880 C- HSIN (Hyperbolic sine) 1320 STACK(ISPT)=SINH(STACK(ISPT)) GOTO 880 C- HTAN (Hyperbolic tangent) 1330 STACK(ISPT)=TANH(STACK(ISPT)) GOTO 880 C- INT (Integer truncation) 1340 STACK(ISPT)=INT(STACK(ISPT)) GOTO 880 C- NINT (Nearest integer) 1350 STACK(ISPT)=NINT(STACK(ISPT)) GOTO 880 C- MOD (Remainder a1-a2*[a1/a2]) 1360 IF ( ISPT.LE.1 ) GOTO 910 STACK(ISPT-1)=MOD(STACK(ISPT-1),STACK(ISPT)) ISPT=ISPT-1 GOTO 880 C- /MOD (Remainder a1-a2*[a1/a2], INT(a1/a2) 1370 IF ( ISPT.LE.1 ) GOTO 910 tmp=STACK(ISPT-1) STACK(ISPT-1)=MOD(STACK(ISPT-1),STACK(ISPT)) STACK(ISPT)=INT(tmp/STACK(ISPT)) GOTO 880 C- TSig (Transfer of sign |a1| Sign a2) 1380 IF ( ISPT.LE.1 ) GOTO 910 STACK(ISPT-1)=SIGN(STACK(ISPT-1),STACK(ISPT)) ISPT=ISPT-1 GOTO 880 C- DTor (Convert degrees to radians) 1390 STACK(ISPT)=STACK(ISPT)*ATAN2(0.0,-1.0)/180.0 GOTO 880 C- RTod (Convert radians to degrees) 1400 STACK(ISPT)=STACK(ISPT)*180.0/ATAN2(0.0,-1.0) GOTO 880 C- DMsd (Convert a number from DDDMMSS.S format to decimal degrees) 1410 IDEG=INT(STACK(ISPT)/1.0E4) IMIN=INT((STACK(ISPT) - IDEG*1.0E4)/1.0E2) RSEC=STACK(ISPT) - IDEG*1.0E4 - IMIN*1.0E2 STACK(ISPT)=IDEG + IMIN/60.0 + RSEC/3600.0 GOTO 880 C- DDms (Convert a number from decimal degrees to DDDMMSS.S format) 1420 IDEG=INT(STACK(ISPT)) IMIN=INT((STACK(ISPT) - IDEG)*60.0) RSEC=STACK(ISPT) - IDEG - IMIN/60.0 STACK(ISPT)=IDEG*1.0E4 + IMIN*1.0E2 + RSEC GOTO 880 C- ERFC 1430 CONTINUE STACK(ISPT)=ERFC(STACK(ISPT)) GOTO 880 C- ERF 1440 CONTINUE STACK(ISPT)=ERF(STACK(ISPT)) GOTO 880 C- Gamma 1450 CONTINUE STACK(ISPT)=GAMMA(STACK(ISPT)) GOTO 880 C- < 1460 IF ( ISPT.LE.1 ) GOTO 910 IF ( STACK(ISPT-1).LT.STACK(ISPT) ) THEN STACK(ISPT-1)=1.0 ELSE STACK(ISPT-1)=0.0 END IF ISPT=ISPT-1 GOTO 880 C- = 1470 IF ( ISPT.LE.1 ) GOTO 910 IF ( STACK(ISPT-1).EQ.STACK(ISPT) ) THEN STACK(ISPT-1)=1.0 ELSE STACK(ISPT-1)=0.0 END IF ISPT=ISPT-1 GOTO 880 C- > 1480 IF ( ISPT.LE.1 ) GOTO 910 IF ( STACK(ISPT-1).GT.STACK(ISPT) ) THEN STACK(ISPT-1)=1.0 ELSE STACK(ISPT-1)=0.0 END IF ISPT=ISPT-1 GOTO 880 C- 0< 1490 IF ( ISPT.LE.0 ) GOTO 910 IF ( STACK(ISPT).LT.0.0 ) THEN STACK(ISPT)=1.0 ELSE STACK(ISPT)=0.0 END IF GOTO 880 C- 0= 1500 IF ( ISPT.LE.0 ) GOTO 910 IF ( STACK(ISPT).EQ.0.0 ) THEN STACK(ISPT)=1.0 ELSE STACK(ISPT)=0.0 END IF GOTO 880 C- 0> 1510 IF ( ISPT.LE.0 ) GOTO 910 IF ( STACK(ISPT).GT.0.0 ) THEN STACK(ISPT)=1.0 ELSE STACK(ISPT)=0.0 END IF GOTO 880 C- NOT 1520 IF ( ISPT.LE.0 ) GOTO 910 IF ( STACK(ISPT).EQ.0.0 ) THEN STACK(ISPT)=1.0 ELSE STACK(ISPT)=0.0 END IF GOTO 880 C- . (Print the number at the top of the stack). 1530 IF ( ISPT.LE.0 ) GOTO 910 WRITE(*,*) STACK(ISPT) ISPT=ISPT-1 GOTO 880 C- 1+ 1540 IF ( ISPT.LE.0 ) GOTO 910 STACK(ISPT)=STACK(ISPT)+1. GOTO 880 C- 1- 1550 IF ( ISPT.LE.0 ) GOTO 910 STACK(ISPT)=STACK(ISPT)-1. GOTO 880 C- 2+ 1560 IF ( ISPT.LE.0 ) GOTO 910 STACK(ISPT)=STACK(ISPT)+2. GOTO 880 C- 2- 1570 IF ( ISPT.LE.0 ) GOTO 910 STACK(ISPT)=STACK(ISPT)-2. GOTO 880 C- MIN 1580 IF ( ISPT.LE.1 ) GOTO 910 ISPT=ISPT-1 STACK(ISPT)=MIN(STACK(ISPT),STACK(ISPT+1)) GOTO 880 C- MAX 1590 IF ( ISPT.LE.1 ) GOTO 910 ISPT=ISPT-1 STACK(ISPT)=MAX(STACK(ISPT),STACK(ISPT+1)) GOTO 880 C- STO 1600 IF ( ISPT.LT.2 ) GOTO 910 Itmp=STACK(ISPT) IF ( Itmp.LE.0 .OR. Itmp.GT.LVAR ) GOTO 940 FMEM(Itmp)=STACK(ISPT-1) ISPT=ISPT-2 GOTO 880 C- +STO 1610 IF ( ISPT.LT.2 ) GOTO 910 Itmp=STACK(ISPT) IF ( Itmp.LE.0 .OR. Itmp.GT.LVAR ) GOTO 940 FMEM(Itmp)=FMEM(Itmp)+STACK(ISPT-1) ISPT=ISPT-2 GOTO 880 C- RCL 1620 IF ( ISPT.LE.0 ) GOTO 910 Itmp=STACK(ISPT) IF ( Itmp.LE.0 .OR. Itmp.GT.LVAR ) GOTO 940 STACK(ISPT)=FMEM(Itmp) GOTO 880 C- ? 1630 IF ( ISPT.LE.0 ) GOTO 910 Itmp=STACK(ISPT) IF ( Itmp.LE.0 .OR. Itmp.GT.LVAR ) GOTO 940 WRITE(*,*) FMEM(Itmp) ISPT=ISPT-1 GOTO 880 C- VAR (NOP) 1640 GOTO 880 C- : (Begin colon defination). Cannot execute when compiling or C- running a program. 1650 IF ( ISTEP.GE.0 .OR. ICOMP.NE.0 ) GOTO 930 ICOMP=1 IF ( lpc.GE.MXPROG ) GOTO 950 lpc=lpc+1 IPROG(lpc)=INSTR IF ( IPCNT.GE.MXPROC ) GOTO 920 IPCNT=IPCNT+1 IPLOC(IPCNT)=lpc RETURN C- ; 1660 IF ( ICOMP.NE.0 ) THEN ICOMP=0 RETURN ELSE IF ( IRPT.LE.0 ) THEN IF ( ISTEP.GT.0 ) ier=100 GOTO 900 END IF IRPT=IRPT-1 IPC=IRET(IRPT+1) END IF GOTO 880 C- ABOrt 1670 IPC=1 IRPT=0 ISPT=0 FNCOD=NO RETURN C--- C- X (place current X into stack). 5010 IF ( ISPT.GE.MXSTAC ) GOTO 920 ISPT=ISPT+1 STACK(ISPT)=X(1) GOTO 880 C- IF 5020 IF ( ISPT.LE.0 ) GOTO 910 ISPT=ISPT-1 IPC=IPC+1 IF ( STACK(ISPT+1).EQ.0.0 ) THEN C- Not true, search for ELSE or THEN statement IF ( IPROG(IPC).GT.0 ) THEN IPC=IPROG(IPC) C- Special treatment for ELSE. IF ( IPROG(IPC).EQ.-3 ) IPC=IPC+1 GOTO 880 ELSE GOTO 950 END IF END IF GOTO 880 6020 IF ( lpc.GE.MXPROG-1 ) GOTO 950 lpc=lpc+1 IPROG(lpc)=INTER lpc=lpc+1 IPROG(lpc)=0 IRPT=IRPT+1 IRET(IRPT)=lpc RETURN C- ELSE, Assume correct nesting, search for closing THEN statement 5030 lev=0 IPC=IPC+1 IF ( IPROG(IPC).GT.0 ) THEN IPC=IPROG(IPC) GOTO 880 ELSE GOTO 950 END IF GOTO 880 6030 IF ( lpc.GE.MXPROG-1 ) GOTO 950 lpc=lpc+1 IPROG(lpc)=INTER IF ( IRPT.LE.0 ) GOTO 950 IF ( IPROG(IRET(IRPT)).NE.0 ) GOTO 950 IPROG(IRET(IRPT))=lpc lpc=lpc+1 IRET(IRPT)=lpc RETURN C- THEN, Assume correctly stuctured program. 5040 GOTO 880 6040 IF ( lpc.GE.MXPROG-1 ) GOTO 950 lpc=lpc+1 IPROG(lpc)=INTER IF ( IRPT.LE.0 ) GOTO 950 IF ( IPROG(IRET(IRPT)).NE.0 ) GOTO 950 IPROG(IRET(IRPT))=lpc IRPT=IRPT-1 RETURN C- FOR 5050 IF ( IRPT+3.GT.MXSTAC ) GOTO 920 IF ( ISPT.LE.1 ) GOTO 910 IPC=IPC+1 IF ( IPROG(IPC).LE.0 ) GOTO 930 IRPT=IRPT+3 IRET(IRPT)=IPROG(IPC) IRET(IRPT-1)=NINT(STACK(ISPT)) IRET(IRPT-2)=NINT(STACK(ISPT-1)) ISPT=ISPT-2 GOTO 880 C- LOOP 5060 IF ( IRPT.LT.3 ) GOTO 910 IRET(IRPT-1)=IRET(IRPT-1)+1 IF ( IRET(IRPT-1).LE.IRET(IRPT-2) ) THEN IPC=IPROG(IPC+1) ELSE IRPT=IRPT-3 IPC=IPC+1 END IF GOTO 880 C--- 6060 IF ( lpc.GE.MXPROG-1 ) GOTO 950 lpc=lpc+1 IPROG(lpc)=INTER lpc=lpc+1 IF ( IRPT.LE.0 ) GOTO 950 IF ( IPROG(IRET(IRPT)).NE.0 ) GOTO 950 IPROG(IRET(IRPT))=lpc IPROG(lpc)=IRET(IRPT) IRPT=IRPT-1 RETURN C- +LOOP 5070 IF ( IRPT.LT.3 ) GOTO 910 IF ( ISPT.LE.0 ) GOTO 920 Itmp=IRET(IRPT-1)-IRET(IRPT-2) IRET(IRPT-1)=IRET(IRPT-1)+NINT(STACK(ISPT)) INEW=IRET(IRPT-1)-IRET(IRPT-2) ISPT=ISPT-1 IF ( (Itmp.LE.0 .AND. INEW.GT.0) .OR. : (Itmp.GE.0 .AND. INEW.LT.0) ) THEN C- terminate IRPT=IRPT-3 IPC=IPC+1 ELSE C- loop IPC=IPROG(IPC+1) END IF GOTO 880 C- I 5080 IF ( IRPT.LT.3 ) GOTO 930 IF ( ISPT.GE.MXSTAC ) GOTO 920 ISPT=ISPT+1 Itmp=IRPT 5085 IF ( IPROG(IRET(Itmp)-1).EQ.-6 ) THEN STACK(ISPT)=IRET(Itmp-1) GOTO 880 END IF Itmp=Itmp-1 IF ( Itmp.GT.0 ) GOTO 5085 GOTO 930 C- J 5090 IF ( IRPT.LT.6 ) GOTO 930 IF ( ISPT.GE.MXSTAC ) GOTO 920 ISPT=ISPT+1 Itmp=IRPT icnt=0 5095 IF ( IPROG(IRET(Itmp)-1).EQ.-6 ) THEN STACK(ISPT)=IRET(Itmp-1) IF ( icnt.EQ.1 ) GOTO 880 icnt=icnt+1 Itmp=Itmp-2 END IF Itmp=Itmp-1 IF ( Itmp.GT.0 ) GOTO 5095 GOTO 930 C- LEAVE 5100 IF ( IRPT.LT.3 ) GOTO 910 IPC=IRET(IRPT) IRPT=IRPT-3 GOTO 880 C- BEGIN 5110 IF ( IRPT.GE.MXSTAC ) GOTO 920 IRPT=IRPT+1 IRET(IRPT)=IPC GOTO 880 C- UNTIL 5120 IF ( ISPT.LE.0 ) GOTO 910 ISPT=ISPT-1 IF ( STACK(ISPT+1).NE.0.0 ) THEN C- TRUE IRPT=IRPT-1 ELSE C- FALSE IPC=IRET(IRPT) END IF GOTO 880 C- WHILE 5130 IF ( ISPT.LE.0 ) GOTO 910 ISPT=ISPT-1 IPC=IPC+1 IF ( STACK(ISPT+1).NE.0.0 ) THEN C- TRUE GOTO 880 ELSE C- FALSE IRPT=IRPT-1 IF ( IPROG(IPC).GT.0 ) THEN IPC=IPROG(IPC) GOTO 880 ELSE lev=0 J=IPC+1 5135 CONTINUE IF ( IPROG(J).EQ.0 ) GOTO 930 Itmp=IPROG(J) CALL CODTOK(-1,ctmp,ltok,Itmp,idelpc,idelsp,ier) IF ( IPROG(J).LT.0 ) THEN IF ( ctmp(1:5).EQ.'BEGIN' ) THEN C- Nested BEGIN lev=lev+1 ELSE IF ( ctmp(1:5).EQ.'UNTIL' ) THEN C- Nested UNTIL lev=lev-1 ELSE IF ( ctmp(1:6).EQ.'REPEAT' ) THEN C- REPEAT IF ( lev.LE.0 ) THEN IPROG(IPC)=J IPC=J GOTO 880 END IF lev=lev-1 END IF END IF J=J+idelpc IF ( J.LT.MXPROG ) GOTO 5135 END IF END IF GOTO 930 C- REPEAT 5140 IF ( IRPT.LE.0 ) GOTO 910 IPC=IRET(IRPT) GOTO 880 C- EXIT 5150 DO 5155 I=IRPT,1,-1 IF ( IPROG(IRET(I)).GT.8000 ) THEN IPC=IRET(I) IRPT=I-1 GOTO 880 END IF 5155 CONTINUE GOTO 930 C- Y (place current Y onto stack). 5160 IF ( ISPT.GE.MXSTAC ) GOTO 920 ISPT=ISPT+1 STACK(ISPT)=X(2) GOTO 880 C--- 880 CONTINUE IPC=IPC+1 IF ( IPC.GT.0 ) INSTR=IPROG(IPC) IF ( ISTEP.EQ.0 ) GOTO 5 C- Interactive, and a colon def IF ( ISTEP.LT.0 .AND. IRPT.GT.0 ) GOTO 5 C--- 900 IF ( ISPT.GT.0 ) THEN FNCOD=STACK(ISPT) ELSE FNCOD=NO END IF RETURN C--- 910 WRITE(*,*) 'FNCOD--Stack empty' ISPT=0 ier=1 GOTO 980 C--- 920 WRITE(*,*) 'FNCOD--Stack overflow' ier=2 GOTO 980 C--- 930 WRITE(*,*) 'FNCOD--Error in structure or nesting' ier=3 GOTO 980 C-- 940 WRITE(*,*) 'FNCOD--Illegal variable address' ier=4 GOTO 980 C--- 950 WRITE(*,*) 'FNCOD--Out of program memory' ier=5 GOTO 980 C--- C- Undefined operation 970 FNCOD=NO STACK(ISPT)=NO IF ( ISTEP.NE.0 ) WRITE(*,*) 'FNCOD--Math error.' RETURN C--- 980 IF ( ISTEP.GE.0 ) THEN WRITE(*,*) 'At line',IPC END IF FNCOD=NO RETURN C--- ENTRY FNCLOA(IFUNC, ILOC, Icode, VALUE) FNCLOA = 0. IF ( IFUNC.EQ.1 ) THEN C- Complete reset. DO 996 I=1,lpc IPROG(I)=0 996 CONTINUE ICOMP=0 IPCNT=0 LCLOC=MXMEM+1 LVAR=0 lpc=0 C- reset the dictionary. CALL CODADD(' ',-1,0,Itmp) ELSE IF ( IFUNC.EQ.2 ) THEN C- Return the code value for a constant term VALUE. Icode=0 DO 998 I=LCLOC,MXMEM IF ( FMEM(I).EQ.VALUE ) THEN Icode=2000+I RETURN END IF 998 CONTINUE IF ( LCLOC.LE.LVAR ) STOP 'FNCOD--OUT OF FLOATING MEMORY.' Itmp=LCLOC-1 C- Only allocate memory, if code is being compiled. IF ( ICOMP.NE.0 ) LCLOC=LCLOC-1 FMEM(Itmp)=VALUE Icode=2000+Itmp ELSE IF ( IFUNC.EQ.3 ) THEN C- Allocate memory to a new variable. IF ( LVAR.GE.LCLOC ) STOP 'FNCOD--OUT OF FLOATING MEMORY.' LVAR=LVAR+1 Icode=6000+LVAR ELSE IF ( IFUNC.EQ.4 ) THEN IENTRY=ILOC IPC=ILOC ELSE IF ( IFUNC.EQ.-1 ) THEN C- Program at specified location Icode=IPROG(ILOC) ELSE IF ( IFUNC.EQ.-2 ) THEN C- Read constant VALUE=FMEM(ILOC) ELSE IF ( IFUNC.EQ.-3 ) THEN C- Prepare to run program IF ( ISPT.GT.0 ) THEN VALUE=STACK(ISPT) ELSE VALUE=NO END IF IPC=IENTRY IRPT=0 ISPT=0 ELSE IF ( IFUNC.EQ.-4 ) THEN C- Print stack IF ( ICOMP.EQ.0 ) THEN WRITE(*,*) (STACK(K),K=1,ISPT) END IF ELSE IF ( IFUNC.EQ.-5 ) THEN C- Read code at current PC ILOC=IPC Icode=IPROG(IPC) ELSE IF ( IFUNC.EQ.-6 ) THEN ILOC=IPCNT ELSE IF ( IFUNC.EQ.-7 ) THEN C- Read last valid program location ILOC=lpc END IF RETURN C--- ENTRY FNPMAT(LOC, IPNUM, ier) FNPMAT = 0. DO I=1,IPCNT IF ( LOC.EQ.IPLOC(I) ) THEN IPNUM=I ier=0 RETURN END IF END DO IPNUM=0 ier=1 RETURN END C********* SUBROUTINE CODADD(CWORD, LWORD, IVAL, ier) CHARACTER CWORD*(*) INTEGER LWORD, IVAL, ier C Entry CODCTI CHARACTER CWORD1*(*) INTEGER LWORD1, IVAL1, ier1 C Entry CODITC CHARACTER CWORD2*(*) INTEGER Icode2, LWORD2, ier2 C Entry CODWOR CHARACTER CWORD3*(*) INTEGER IWNUM, LWORD3, ier3 C--- C Add a word to the dictionary. The structure of a dictionary C entry is: C length : contains C ------ -------- C 1 LWORD, length of the current word in bytes C 1 LPAR, length of the parameter field in bytes C LWORD CWORD(:LWORD) the word C IPAR the parameter field (currently is only the I*2 code). C--- C 1989-Feb-13 - Latest mod [AFT] C--- INTEGER MXDIC PARAMETER (MXDIC=1000) CHARACTER CDIC*(MXDIC) SAVE CDIC CHARACTER C2tmp*2 INTEGER icnt, IPAR, IPOS, Itmp, ltok, LPAR INTEGER LDIC SAVE LDIC DATA LDIC/0/ C--- IF ( LWORD.LT.0 ) THEN LDIC=0 ELSE IF ( LDIC+LWORD+4.GT.MXDIC ) THEN ier=1 ELSE ier=0 CDIC(LDIC+1:LDIC+1)=CHAR(LWORD) CDIC(LDIC+2:LDIC+2)=CHAR(2) CDIC(LDIC+3:LDIC+2+LWORD)=CWORD(:LWORD) CALL I4TOC2(IVAL, C2tmp) CDIC(LDIC+3+LWORD:LDIC+4+LWORD)=C2tmp LDIC=LDIC+4+LWORD END IF RETURN C--- ENTRY CODCTI(CWORD1, LWORD1, IVAL1, ier1) C--- C Find the character CWORD in the dictionary. C--- IPOS=0 200 IF ( IPOS.LT.LDIC ) THEN ltok=ICHAR(CDIC(IPOS+1:IPOS+1)) LPAR=ICHAR(CDIC(IPOS+2:IPOS+2)) Itmp=IPOS+2+ltok+LPAR IF ( LWORD1.EQ.ltok ) THEN IF ( CWORD1(:LWORD1).EQ.CDIC(IPOS+3:IPOS+2+ltok) ) THEN ier1=0 CALL C2TOI4(CDIC(Itmp-1:Itmp), IVAL1) RETURN END IF END IF IPOS=Itmp GOTO 200 END IF ier1=1 RETURN C--- ENTRY CODITC(Icode2, CWORD2, LWORD2, ier2) C--- C Find the code, Icode2, in the dictionary. C--- IPOS=0 300 IF ( IPOS.LT.LDIC ) THEN ltok=ICHAR(CDIC(IPOS+1:IPOS+1)) LPAR=ICHAR(CDIC(IPOS+2:IPOS+2)) Itmp=IPOS+2+ltok+LPAR C2tmp=CDIC(Itmp-1:Itmp) CALL C2TOI4(C2tmp, IPAR) IF ( IPAR.EQ.Icode2 ) THEN LWORD2=ltok CWORD2(:LWORD2)=CDIC(IPOS+3:IPOS+2+LWORD2) ier2=0 RETURN END IF IPOS=Itmp GOTO 300 END IF LWORD2=0 CWORD2(1:2)=' ' ier2=1 RETURN C--- ENTRY CODWOR(IWNUM, CWORD3, LWORD3, ier3) C--- C Return the token corresponding to word number IWNUM. C--- icnt=0 IPOS=0 400 IF ( IPOS.LT.LDIC ) THEN icnt=icnt+1 ltok=ICHAR(CDIC(IPOS+1:IPOS+1)) LPAR=ICHAR(CDIC(IPOS+2:IPOS+2)) IF ( icnt.EQ.IWNUM ) THEN LWORD3=ltok CWORD3(:LWORD3)=CDIC(IPOS+3:IPOS+2+LWORD3) ier3=0 RETURN END IF IPOS=IPOS+2+ltok+LPAR GOTO 400 END IF ier3=1 RETURN END C********* SUBROUTINE CODDER(X, PAR, PLIM, DERIV, NT, NTERM) REAL X(2), PAR(*), PLIM(3,*), DERIV(*) INTEGER NT, NTERM C--- C This routine takes the derivative of the FNCOD function with C respect to the various parameters. This is done numerically. C--- C 1988-Nov-30 - [AFT] C--- REAL FNCOD REAL DX, FNY0, Ptmp, tmp INTEGER I, ier C--- FNY0 = FNCOD(0,0,X,PAR(NT),NTERM,ier) DO I=NT,NT+NTERM-1 IF ( PLIM(1,I).GE.0. ) THEN Ptmp = PAR(I) tmp = ABS(Ptmp) IF ( tmp.GT.0.01 .AND. tmp.LT.100. ) THEN C- For scaled parameters, use a fixed step size. This is more C- numerically stable. DX = .001 ELSE IF ( tmp.LT.1.E-15 ) THEN C- Near zero, avoid divide by zero problems. DX = .001 ELSE DX = .001*tmp END IF PAR(I) = PAR(I)+DX DERIV(I) = (FNCOD(0,0,X,PAR(NT),NTERM,ier)-FNY0)/DX PAR(I) = Ptmp END IF END DO RETURN END C********* SUBROUTINE C2TOI4(cbuf, I4BUF) CHARACTER cbuf*2 INTEGER I4BUF C--- C Convert a CHARACTER*2 into an INTEGER. C--- CHARACTER c2tmp*2 INTEGER*2 i2tmp EQUIVALENCE (c2tmp,i2tmp) C--- c2tmp = cbuf I4BUF = i2tmp RETURN END C********* SUBROUTINE I4TOC2(I4BUF, cbuf) INTEGER I4BUF CHARACTER cbuf*2 C--- C Convert an INTEGER*4 into a CHARACTER*2 C--- CHARACTER c2tmp*2 INTEGER*2 i2tmp EQUIVALENCE (c2tmp,i2tmp) C--- i2tmp = I4BUF cbuf = c2tmp RETURN END fv5.5/tcltk/plt/cram.f0000644000220700000360000002735013224715127013541 0ustar birbylheaC--- CRAM.FOR contains entry points for: C CRAMDF C CRAMFF C CRAMF C CRAMI C CRAMI8 C CRAMIF C CRAM C********* SUBROUTINE CRAMDF(Dnum, Nspace, Ndig, Cbuf, Lbuf) DOUBLE PRECISION Dnum INTEGER Nspace, Ndig, Lbuf CHARACTER Cbuf*(*) C--- C Do a formatted conversion of Dnum into ASCII characters. If NDIG>0 C then the NDIG right of decimal point will be diplayed using an F format. C If this would cause more than MXDIG digits to be displayed, then E C format with maximum accuracy will be used instead. If NDIG<0 then C only ABS(NDIG) of the number will be displayed, in F format it possible, C G format otherwise. Using NDIG=0 is equivalent to calling CRAMF. C In all cases a minimum of NSPACE characters are used in CBUF and leading C blanks are used to fill in the extra space. If the number cannot C be expressed in NSPACE characters, then the additional space is C allocated to the buffer to write the number. This messes up a nice C neat column format, I like this better than not seeing the number C at all. C--- C Dnum I Number to convert C NSPACE I Number of spaces to use in CBUF C NDIG I Number of digits to output. NDIG=0 outputs all digits. C CBUF I/O Character buffer C LBUF I/O Number of valid characters in CBUF C--- C 2003-Jan-24 - Extracted from CRAMFF [AFT] C--- DOUBLE PRECISION NO PARAMETER (NO=-1.2D-34) C MXDIG is the maximum number of digits that can be represented in a C single precision floating point number. INTEGER MXDIG PARAMETER (MXDIG=14) INTEGER LENACT C CHARACTER cdum*32, cform*32 INTEGER i, iexp, itmp, kp, ldum, nf, ng C--- IF ( Dnum.EQ.NO ) THEN C No data magic number cdum = 'NO' ldum = 2 ELSE IF ( Dnum.NE.Dnum ) THEN C Must be a IEEE NaN, output as No data cdum = 'NO' ldum = 2 ELSE IF ( Dnum.EQ.0. ) THEN C Zero, special case cdum = ' 0' ldum = 2 ELSE IF ( Ndig.EQ.0 ) THEN C Write all digits of number. WRITE (cdum,*) Dnum C 171 FORMAT(1PG14.7) CALL CRAM(cdum,ldum) ELSE C IEXP is the exponent when number is expressed in scientific notation. iexp = INT(500.+LOG10(ABS(Dnum))) - 500 C IF ( Ndig.GT.0 ) THEN C Display NDIG right of decimal point nf = MIN(Ndig,MXDIG) ng = MXDIG - 1 ELSE C Display ABS(NDIG) total ng = MIN(ABS(Ndig),MXDIG) - 1 nf = ng - iexp END IF C--- C If only displaying 0 to MXDIG digits right of decimal point AND if C fewer than MXDIG total digits are to be displayed, IF ( 0.LE.nf .AND. nf.LE.Nspace .AND. (nf+iexp+1).LE.MXDIG ) & THEN C then use F format, IF ( nf.LE.9 ) THEN WRITE (cform,121) nf 121 FORMAT ('(F14.',I1,')') ELSE WRITE (cform,131) nf 131 FORMAT ('(F14.',I2,')') END IF ELSE C else use G Format. Note, there is a bug in that if the number is displayed C in an F FORMAT, then the scale factor is not applied, and one too few C digits is displayed. IF ( ng.LE.9 ) THEN WRITE (cform,141) ng 141 FORMAT ('(1PE20.',I1,')') ELSE WRITE (cform,151) ng 151 FORMAT ('(1PE20.',I2,')') END IF C--- END IF WRITE (cdum,cform) Dnum ldum = LENACT(cdum) C--- C Now strip leading blanks (if any). kp = 0 CALL ALFSKS(cdum,ldum,kp) IF ( kp.GT.0 ) THEN DO 100 i = 1, ldum - kp cdum(i:i) = cdum(i+kp:i+kp) 100 CONTINUE ldum = ldum - kp END IF END IF END IF C--- C Copy to output buffer, right justified. IF ( ldum.LE.Nspace ) THEN itmp = Nspace - ldum Cbuf(Lbuf+1:Lbuf+itmp) = ' ' Cbuf(Lbuf+itmp+1:Lbuf+Nspace) = cdum(:ldum) Lbuf = Lbuf + Nspace ELSE Cbuf(Lbuf+1:Lbuf+ldum) = cdum(:ldum) Lbuf = Lbuf + ldum END IF RETURN END C********* SUBROUTINE CRAMFF(Fnum,Nspace,Ndig,Cbuf,Lbuf) REAL Fnum INTEGER Nspace, Ndig, Lbuf CHARACTER Cbuf*(*) C--- C Do a formatted conversion of FNUM into ASCII characters. If NDIG>0 C then the NDIG right of decimal point will be diplayed using an F format. C If this would cause more than MXDIG digits to be displayed, then E C format with maximum accuracy will be used instead. If NDIG<0 then C only ABS(NDIG) of the number will be displayed, in F format it possible, C G format otherwise. Using NDIG=0 is equivalent to calling CRAMF. C In all cases a minimum of NSPACE characters are used in CBUF and leading C blanks are used to fill in the extra space. If the number cannot C be expressed in NSPACE characters, then the additional space is C allocated to the buffer to write the number. This messes up a nice C neat column format, I like this better than not seeing the number C at all. C--- C FNUM I Number to convert C NSPACE I Number of spaces to use in CBUF C NDIG I Number of digits to output. NDIG=0 outputs all digits. C CBUF I/O Character buffer C LBUF I/O Number of valid characters in CBUF C--- C 1992-Sep-01 - rewrite [AFT] C 1994-May-12 - Add test for NaN [AFT] C--- REAL NO PARAMETER (NO=-1.2E-34) C MXDIG is the maximum number of digits that can be represented in a C single precision floating point number. INTEGER MXDIG PARAMETER (MXDIG=7) INTEGER LENACT C CHARACTER cdum*32, cform*32 INTEGER i, iexp, itmp, kp, ldum, nf, ng C--- IF ( Fnum.EQ.NO ) THEN C No data magic number cdum = 'NO' ldum = 2 ELSE IF ( Fnum.NE.Fnum ) THEN C Must be a IEEE NaN, output as No data cdum = 'NO' ldum = 2 ELSE IF ( Fnum.EQ.0. ) THEN C Zero, special case cdum = ' 0' ldum = 2 ELSE IF ( Ndig.EQ.0 ) THEN C Write all digits of number. WRITE (cdum,*) Fnum C 171 FORMAT(1PG14.7) CALL CRAM(cdum,ldum) ELSE C IEXP is the exponent when number is expressed in scientific notation. iexp = INT(500.+LOG10(ABS(Fnum))) - 500 C IF ( Ndig.GT.0 ) THEN C Display NDIG right of decimal point nf = MIN(Ndig,MXDIG) ng = MXDIG - 1 ELSE C Display ABS(NDIG) total ng = MIN(ABS(Ndig),MXDIG) - 1 nf = ng - iexp END IF C--- C If only displaying 0 to MXDIG digits right of decimal point AND if C fewer than MXDIG total digits are to be displayed, IF ( 0.LE.nf .AND. nf.LE.MXDIG .AND. (nf+iexp+1).LE.MXDIG ) & THEN C then use F format, WRITE (cform,121) nf 121 FORMAT ('(F14.',I1,')') ELSE C else use G Format. Note, there is a bug in that if the number is displayed C in an F FORMAT, then the scale factor is not applied, and one too few C digits is displayed. WRITE (cform,141) ng 141 FORMAT ('(1PE14.',I1,')') C--- END IF WRITE (cdum,cform) Fnum ldum = LENACT(cdum) C--- C Now strip leading blanks (if any). kp = 0 CALL ALFSKS(cdum,ldum,kp) IF ( kp.GT.0 ) THEN DO 100 i = 1, ldum - kp cdum(i:i) = cdum(i+kp:i+kp) 100 CONTINUE ldum = ldum - kp END IF END IF END IF C--- C Copy to output buffer, right justified. IF ( ldum.LE.Nspace ) THEN itmp = Nspace - ldum Cbuf(Lbuf+1:Lbuf+itmp) = ' ' Cbuf(Lbuf+itmp+1:Lbuf+Nspace) = cdum(:ldum) Lbuf = Lbuf + Nspace ELSE Cbuf(Lbuf+1:Lbuf+ldum) = cdum(:ldum) Lbuf = Lbuf + ldum END IF RETURN END C********* SUBROUTINE CRAMF(Fnum,Cbuf,Lbuf) REAL Fnum CHARACTER Cbuf*(*) INTEGER Lbuf C--- C Convert floating point number into ASCII characters and C append to CBUF. C--- C FNUM I Number to convert C CBUF I/O Character buffer C LBUF I/O Number of valid characters in CBUF C--- C AFT C--- REAL NO PARAMETER (NO=-1.2E-34) CHARACTER cdum*32 INTEGER ldum C--- IF ( Fnum.NE.NO ) THEN WRITE (cdum,*) Fnum C 121 FORMAT(1PG14.7) CALL CRAM(cdum,ldum) ELSE cdum = 'NO' ldum = 2 END IF Cbuf(Lbuf+1:Lbuf+ldum) = cdum Lbuf = Lbuf + ldum RETURN END C********* SUBROUTINE CRAMI(Inum,Cbuf,Lbuf) INTEGER Inum, Lbuf CHARACTER Cbuf*(*) C--- C Convert integer number into ASCII characters and C append to CBUF. C--- C INUM I Number to convert C CBUF I/O Character buffer C LBUF I/O Number of valid characters in CBUF C--- C AFT C--- CHARACTER cdum*32 INTEGER ldum C--- WRITE (cdum,101) Inum 101 FORMAT (I32) CALL CRAM(cdum,ldum) Cbuf(Lbuf+1:Lbuf+ldum) = cdum Lbuf = Lbuf + ldum RETURN END C********* SUBROUTINE CRAMI8(I8num,Cbuf,Lbuf) INTEGER*8 I8num INTEGER Lbuf CHARACTER Cbuf*(*) C--- C Convert integer number into ASCII characters and C append to CBUF. C--- C I8NUM I Number to convert C CBUF I/O Character buffer C LBUF I/O Number of valid characters in CBUF C--- C 2008-May-15 - Extract from CRAMI - AFT C--- CHARACTER cdum*32 INTEGER ldum C--- WRITE (cdum,101) I8num 101 FORMAT (I32) CALL CRAM(cdum,ldum) Cbuf(Lbuf+1:Lbuf+ldum) = cdum Lbuf = Lbuf + ldum RETURN END C********* SUBROUTINE CRAMIF(Inum,Nspace,Cbuf,Lbuf) INTEGER Inum, Nspace, Lbuf CHARACTER Cbuf*(*) C--- C Convert integer number into ASCII characters and append to CBUF. C--- C INUM I Number to convert C NSPACE I Number of characters to pack number into C CBUF I/O Character buffer C LBUF I/O Number of valid characters in CBUF C--- C AFT C--- CHARACTER cdum*32 INTEGER ldum, il, nc C--- WRITE (cdum,101) Inum 101 FORMAT (I32) CALL CRAM(cdum,ldum) nc = MAX(Nspace,ldum) il = 1 + nc - ldum Cbuf(Lbuf+il:Lbuf+nc) = cdum Lbuf = Lbuf + nc RETURN END C********* SUBROUTINE CRAM(Cdum,Ldum) CHARACTER Cdum*(*) INTEGER Ldum C--- C Remove redundant information. C--- C CBUF I/O Character buffer C LBUF O Number of valid characters in CBUF C--- C AFT C--- INTEGER LENACT INTEGER i, id, ie C--- C- Remove leading blanks. i = 1 100 IF ( Cdum(i:i).EQ.' ' ) THEN i = i + 1 GOTO 100 END IF Cdum = Cdum(i:) C- Remove 0 in E+0x or E-0x ie = INDEX(Cdum,'E+0') IF ( ie.LE.0 ) ie = INDEX(Cdum,'E-0') IF ( ie.GT.0 ) Cdum(ie+2:) = Cdum(ie+3:) // ' ' C- Remove trailing E+0 Ldum = LENACT(Cdum) IF ( Ldum.GT.2 ) THEN IF ( Cdum(Ldum-2:).EQ.'E+0' ) THEN Cdum(Ldum-2:Ldum) = ' ' Ldum = Ldum - 3 END IF END IF C- Remove trailing zeros. id = INDEX(Cdum,'.') IF ( id.NE.0 ) THEN ie = INDEX(Cdum,'E') - 1 IF ( ie.LE.0 ) ie = Ldum DO 130 i = ie, id + 1, -1 IF ( Cdum(i:i).NE.'0' ) GOTO 190 Cdum(i:) = Cdum(i+1:) // ' ' 130 CONTINUE END IF C 190 Ldum = LENACT(Cdum) C- Remove trailing . IF ( Cdum(Ldum:Ldum).EQ.'.' ) Ldum = Ldum - 1 IF ( Ldum.EQ.0 ) THEN C- CRAM will transform .000000 into a blank string, which really should C- be zero. Ldum = 1 Cdum(1:1) = '0' ELSE C- Blank fill. DO 200 i = Ldum + 1, LEN(Cdum) Cdum(i:i) = ' ' 200 CONTINUE END IF RETURN END fv5.5/tcltk/plt/curfit.f0000644000220700000360000003006313224715127014106 0ustar birbylhea SUBROUTINE CURFIT(Rdat, Igrp, iy0, Iery, Mxrow, Low, Npts, & Xmin, Xmax, Ichat, Niter, Istat, Icomp, Idoun, Nterm, & Fdelmn, Pval, Plim, Chisq) INTEGER Igrp, iy0, Iery, Mxrow, Low, Npts INTEGER Ichat, Niter, Icomp(*), Idoun, Nterm, Istat REAL Rdat(*), Xmin(*), Xmax(*), Pval(*), Plim(3, *) REAL Fdelmn, Chisq C--- C Closely parallels CURFIT given in Bevington p.238 C Contains a vector-subset capability, used by setting Plim(1, I)<0. C--- C Rdat I The data array C Igrp I Used by pltxc to calculate the X coordinate(s). C Iy0 I Y(iy0+I) is the y-value of the Ith data point. C Iery I Errors, <0 statistical, =0 none, >0 explicit errors. C Mxrow I Used by function WEIGHT (needed for explicit errors) C Low I The first data point in the fit range (typically=1). C Npts I The last data point in the fit range. C Xmin I The smallest X to include in fit. C Xmax I The largest X to include in fit. C Ichat I >0 display messages and questions, =0 display messages C -but no questions, -1 no messages or questions C -2 total quiet C Niter I Number of iterations (0 defaults to 10) C Istat I The statistic to be used: 0=Chi-squared, 1=M-L C Icomp I Passed to FITLIM, FNFIT and MDERIV. C Idoun I =1 estimate uncertainties, =0 don't estimate uncertainties. C Nterm I The number of terms. C Fdelmn I Stop when delta less than (0 defaults to 0.05 or 0.001 2D) C Pval I/O The whole reason for calling CURFIT. C Plim I/O PLIM(1, I)<0 indicates parameter is frozen. C Chisq O The value of Chi-squared. -N insensitive to parameter N. C--- C 1998-09-30 - Changed the ML statistic to the current version used C by xspec (the famous Castor priv comm function). Multiplied C by Rdat*Weight to convert to rates to counts. Finally C do not allow the model to fall below 1.0E-6 counts/bin. C--- REAL NO PARAMETER (NO=-1.2E-34) INTEGER MXDIM, MXPAR, MXFREE PARAMETER (MXDIM=2, MXPAR=120, MXFREE=100) REAL FNFIT, WEIGHT C REAL xt(MXDIM) REAL chisq1, chil, del, delmin, derj, dif, flamda, fudge REAL rcon, rlndat, rlnmod, tot, wtmp, rmod INTEGER idef SAVE idef INTEGER i, ians, icnt, ihit, iycol, iyi, iyoff INTEGER j, ji, k, ndim, nidim, ntry, nvar C Length of CURFIT common block is 3*MXFREE*(MXFREE+2). INTEGER Index, Ik, Jk REAL Beta, B, Deriv, Alpha DOUBLE PRECISION Aray COMMON /CURCMN/ Index(MXFREE), Ik(MXFREE), Jk(MXFREE), & Beta(MXFREE), B(MXFREE), Deriv(MXPAR), & Alpha(MXFREE, MXFREE), Aray(MXFREE, MXFREE) DATA idef/ -1/ C--- IF ( Fdelmn.GT.0.0 ) THEN delmin=Fdelmn ELSE delmin = 0.05 CALL PLTXCC(Rdat, 1, Igrp, xt, nidim, iyoff) IF ( nidim.GT.1 ) delmin=0.001 END IF ntry = 10 IF ( Niter.NE.0 ) ntry = Niter flamda = .001 Chisq = 0. icnt = 0 nvar = 0 DO j = 1, Nterm IF ( Plim(1,j).GE.0. ) THEN nvar = nvar + 1 IF ( nvar.GT.MXFREE ) THEN WRITE(*, 101) MXFREE 101 FORMAT(' CURFIT--Can only vary', I6, & ' parameters at a time.') RETURN END IF Index(nvar) = j END IF END DO C- Clear BETA and ALPHA. 120 CONTINUE chil = Chisq DO j = 1, nvar Beta(j) = 0. DO k = 1, j Alpha(j, k) = 0. END DO END DO C- Evaluate derivatives, CHISQ, ALPHA and BETA at starting point. chisq1 = 0. rcon = 1.0 DO 160 i = Low, Npts CALL PLTXCC(Rdat, i, Igrp, xt, ndim, iyoff) IF ( xt(1).EQ.NO ) GOTO 160 IF ( xt(1).LT.XMIN(1) .OR. xt(1).GT.XMAX(1) ) GOTO 160 IF ( nidim.GT.1 ) THEN IF ( xt(2).LT.XMIN(2) .OR. xt(2).GT.XMAX(2) ) GOTO 160 END IF iyi = iy0 + iyoff rmod = FNFIT(xt, Icomp, Pval, Nterm) IF ( rmod.EQ.NO .OR. Rdat(iyi).EQ.NO ) GOTO 160 wtmp = WEIGHT(Rdat(iyi), Mxrow, Iery) IF ( Istat.EQ.0 ) THEN dif = Rdat(iyi) - rmod IF ( ABS(dif).LT.1.E15 ) THEN chisq1 = chisq1 + wtmp*dif*dif ELSE chisq1 = chisq1 + 1.E32 END IF ELSE C rcon is the divisor that converted counts to flux. For Iery.LE.0 C rcon=1.0 which is set outside the loop. IF ( Rdat(iyi).EQ.0.0 ) THEN IF ( Iery.GT.0 ) rcon = SQRT(wtmp) rlndat = 0.0 ELSE IF ( Iery.GT.0 ) rcon = wtmp*Rdat(iyi) rlndat = LOG(rcon*Rdat(iyi)) END IF C Assume exact value of the model becomes useless below 1.0E-6 count/bin. rmod = MAX(rmod, 1.0E-6/rcon) dif = Rdat(iyi)/rmod rlnmod = LOG(rcon*rmod) C chisq1 = chisq1 + 2*((rcon*rmod+ C & GAMMLN(rcon*Rdat(iyi)+1))-rcon*Rdat(iyi)*rlnmod) chisq1 = chisq1 + 2*rcon*(rmod+ & Rdat(iyi)*(rlndat-rlnmod-1.0)) END IF IF ( nvar.LE.0 ) GOTO 160 CALL MDERIV(xt, Icomp, Pval, Plim, Nterm, Deriv) DO j = 1, nvar ji = Index(j) IF ( Istat.EQ.0 ) THEN Beta(j) = Beta(j) + wtmp*dif*Deriv(ji) derj = wtmp*Deriv(ji) ELSE Beta(j) = Beta(j) + rcon*(dif-1.)*Deriv(ji) derj = rcon*dif*Deriv(ji)/rmod END IF DO k = 1, j Alpha(j, k) = Alpha(j, k) + derj*Deriv(Index(k)) END DO END DO 160 CONTINUE IF ( nvar.LE.0 ) GOTO 900 C- Symmetrize ALPHA. DO j = 1, nvar IF ( Alpha(j, j).EQ.0. ) GOTO 810 DO k = 1, j Alpha(k, j) = Alpha(j, k) END DO END DO DO j = 1, Nterm B(j) = Pval(j) END DO C- Modify and invert the curvature matrix. 190 CONTINUE DO j = 1, nvar DO k = 1, nvar Aray(j, k) = Alpha(j, k)/SQRT(Alpha(j, j)*Alpha(k, k)) END DO Aray(j, j) = 1. + flamda END DO CALL MATINV(Aray, MXFREE, nvar, Ik, Jk) C- Construct the trial parameter set. DO j = 1, nvar tot = 0. DO k = 1, nvar tot = tot + Beta(k)*Aray(j, k)/SQRT(Alpha(j, j)*Alpha(k, k)) END DO Pval(Index(j)) = B(Index(j)) + tot END DO CALL FITLIM(Icomp, Pval, Plim, Nterm, ihit) C--- C- Compute new CHISQ. Chisq = 0. rcon = 1.0 DO 280 i = Low, Npts CALL PLTXCC(Rdat, i, igrp, xt, ndim, iyoff) IF ( xt(1).EQ.NO ) GOTO 280 IF ( xt(1).LT.XMIN(1) .OR. xt(1).GT.XMAX(1) ) GOTO 280 IF ( nidim.GT.1 ) THEN IF ( xt(2).LT.XMIN(2) .OR. xt(2).GT.XMAX(2) ) GOTO 280 END IF iyi = iy0 + iyoff rmod = FNFIT(xt, Icomp, Pval, Nterm) IF ( rmod.EQ.NO .OR. Rdat(iyi).EQ.NO ) GOTO 280 wtmp = WEIGHT(Rdat(iyi), Mxrow, Iery) IF ( Istat.EQ.0 ) THEN dif = MIN(ABS(Rdat(iyi)-rmod), 1.E15) Chisq = Chisq + wtmp*dif*dif ELSE IF ( Rdat(iyi).EQ.0.0 ) THEN IF ( Iery.GT.0 ) rcon = SQRT(wtmp) rlndat = 0.0 ELSE IF ( Iery.GT.0 ) rcon = wtmp*Rdat(iyi) rlndat = LOG(rcon*Rdat(iyi)) END IF rmod = MAX(rmod, 1.0E-6/rcon) rlnmod = LOG(rcon*rmod) Chisq = Chisq + 2*rcon*(rmod+ & Rdat(iyi)*(rlndat-rlnmod-1.0)) END IF 280 CONTINUE C- If CHI SQUARED increased, increase FLAMDA and try again. IF ( Chisq.GT.chisq1 ) THEN IF ( flamda.LT.0.9E10 ) THEN flamda = 10.*flamda GOTO 190 END IF C- Trick to force termination condition. chil = Chisq END IF C--- IF ( Ichat.GE.0 ) WRITE (*, 301) NINT(LOG10(flamda)), Chisq 301 FORMAT (' (', I3, ') W-VAR=', 1PG10.4) C- IF ( flamda.GT.1.E-20 ) flamda = flamda/10. icnt = icnt + 1 del = ABS(chil-Chisq) C- Unweighted, consider relative change. IF ( Iery.EQ.0 .AND. Chisq.GT.0. ) del = del/Chisq IF ( Chisq.LE.0. .OR. del.LE.delmin ) GOTO 330 C- Keep trying until ICNT.GE.NTRY. IF ( icnt.LT.ntry ) GOTO 120 icnt = 0 IF ( Ichat.GT.0 ) THEN CALL YORN('Continue fitting', idef, ians) IF ( ians.GT.0 ) GOTO 120 END IF WRITE (*, 321) 321 FORMAT (' CURFIT--Minimum not found.') C--- C- Exit. Evaluate uncertainties by inverting matrix with FLAMDA=0. 330 CONTINUE IF ( Idoun.NE.0 ) THEN DO j = 1, nvar DO k = 1, nvar Aray(j, k) = Alpha(j, k) END DO END DO CALL MATINV(Aray, MXFREE, nvar, Ik, Jk) fudge = 1.0 IF ( Iery.EQ.0 .AND. Istat.EQ.0) THEN C For unweighted chisq, scale the uncertainty. IF ( Chisq.GT.0. ) fudge=(Pval(nterm+2)-nvar)/Chisq END IF DO j = 1, nvar ji = Index(j) Plim(1, ji) = SQRT(ABS(Aray(j, j))/fudge) END DO END IF RETURN C--- 810 CONTINUE IF ( ichat.GT.-2 ) THEN WRITE(*, 811) Index(j) 811 FORMAT(' CURFIT--Model insensitive to parameter', I6) END IF Chisq = -Index(j) RETURN C--- 900 CONTINUE Chisq = chisq1 IF ( Ichat.GE.0 ) WRITE (*, 301) NINT(LOG10(flamda)), Chisq RETURN END C********* SUBROUTINE MATINV(Aray, Mxfree, Norder, Ik, Jk) INTEGER Mxfree, Norder, Ik(Mxfree), Jk(Mxfree) DOUBLE PRECISION Aray(Mxfree, Mxfree) C--- C This subroutine replaces a real, square, symmetric matrix with C its inverse see P.R.Bevington, "Data Reduction and Error Analysis C For the Physical Sciences" McGraw-Hill, N.Y., 1969 p.302. C--- C Aray I/O C Mxfree I C Norder I C Ik O C Jk O C--- DOUBLE PRECISION amax, save INTEGER i, j, k, l C--- DO k = 1, Norder C- Find largest element in matrix. amax = 0. DO 150 i = k, Norder DO j = k, Norder C IF ( DABS(amax)-DABS(Aray(i, j)) ) 130, 130, 150 IF ( DABS(amax)-DABS(Aray(i, j)).GT.0.0 ) GOTO 150 130 amax = Aray(i, j) Ik(k) = i Jk(k) = j END DO 150 CONTINUE C- Interchange rows and columns to put AMAX in ARAY(K, K) C IF ( amax ) 180, 420, 180 IF ( amax.EQ.0.0 ) GOTO 420 180 i = Ik(k) C IF ( i-k ) 210, 210, 190 IF ( i-k.LE.0 ) GOTO 210 190 CONTINUE DO j = 1, Norder save = Aray(k, j) Aray(k, j) = Aray(i, j) Aray(i, j) = -save END DO 210 j = Jk(k) C IF ( j-k ) 240, 240, 220 IF ( j-k.LE.0 ) GOTO 240 220 CONTINUE DO i = 1, Norder save = Aray(i, k) Aray(i, k) = Aray(i, j) Aray(i, j) = -save END DO C- Accumulate the elements of the inverse martix. 240 CONTINUE DO i = 1, Norder IF ( i.NE.k ) Aray(i, k) = -Aray(i, k)/amax END DO DO i = 1, Norder DO j = 1, Norder IF ( i.NE.k .AND. j.NE.k ) Aray(i, j) = Aray(i, j) & + Aray(i, k)*Aray(k, j) END DO END DO DO j = 1, Norder IF ( j.NE.k ) Aray(k, j) = Aray(k, j)/amax END DO Aray(k, k) = 1./amax END DO C--- C- Restore ordering of the matrix. DO 410 l = 1, Norder k = Norder - l + 1 j = Ik(k) C IF ( j-k ) 380, 380, 360 IF ( j-k.LE.0 ) GOTO 380 360 CONTINUE DO i = 1, Norder save = Aray(i, k) Aray(i, k) = -Aray(i, j) Aray(i, j) = save END DO 380 CONTINUE i = Jk(k) C IF ( i-k ) 410, 410, 390 IF ( i-k.LE.0 ) GOTO 410 390 CONTINUE DO j = 1, Norder save = Aray(k, j) Aray(k, j) = -Aray(i, j) Aray(i, j) = save END DO 410 CONTINUE 420 RETURN END fv5.5/tcltk/plt/dscale.f0000644000220700000360000002550713224715127014054 0ustar birbylhea SUBROUTINE DSCALE(Y, Iery, Mxrow, Mxwin, Mx2d, Ngroup, Mxpar, & Igap, Rgap, Idoall, Iskip, Newmod, Iactw, Logx, Logy, Imaster, & Igrpos, Ipwin, Icont, Image, Ipmod, Icomp, Pval, Nterm, & Imnmx, Xymnmx, Ermnmx, Xyscal) INTEGER Mxrow, Mxwin, Mx2d, Ngroup, Mxpar INTEGER Igap, Idoall, Iskip, Newmod, Imnmx INTEGER Iery(*), Ipwin(*), Iactw(*), Logx(*), Logy(*) INTEGER Igrpos(3, *), Icont(*), Image(*) INTEGER Ipmod(*), Icomp(2*Mxpar, *), Nterm(*), Imaster(2,*) REAL Rgap REAL Y(*), Pval(Mxpar, *) REAL Xymnmx(4, *), Ermnmx(4, *), Xyscal(4, *) C--- C Find the min and max data values, and set the default PLT scales. C We must set the scale for each window. The default is plot group N C is plotted in window N. C--- C Y I C Iery I C Mxrow I C Mxwin I Maximum number of windows C Mx2d I Maximum number of 2D plots C Ngroup I C Mxpar I C Igap I =0 ignore errors, <>0 include error bar in min/max. C Rgap I C Idoall I C Iskip I C Newmod I C Iactw I per window C Logx I Per window C Logy I Per window C Imaster I per window C Igrpos I Per group C Ipwin I Per group C Icont I Per group C Image I per group C Ipmod I per group C Pval I per model C Nterm I per model C Imnmx I/O C Xymnmx I/O The data min/max values by group, xmin, ymin, xmax, ymax C Ermnmx I/O The min/max values with errors, xmin, xmax, ymin, ymax C Xyscal I/O The window min/max values, xmin, xmax, ymin, ymax C--- C 1990-Feb-26 - Extracted from PLT [AFT] C--- REAL NO PARAMETER (NO=-1.2E-34) REAL RMAX PARAMETER (RMAX=1.E35) INTEGER MXDIM PARAMETER (MXDIM=2) REAL FNFIT C REAL xt(MXDIM) REAL tmplo, tmphi, tmp1, tmp2, xcen, xm, xp, yerr, yt INTEGER i, i2drow, igroup, itmp, iwnum, iy0, iyi, iyoff INTEGER lery, ndim C--- C If new data or SKIP has changed, then the plot groups may have C changed. For this case scan all the groups and reset the Data min C and max values IF ( Iskip.NE.Imnmx .OR. Newmod.NE.0 ) THEN DO 130 igroup = 1, Ngroup IF ( igrpos(1,igroup).LT.0 ) GOTO 130 IF ( Iskip.EQ.Imnmx .AND. Newmod.NE.ABS(ipmod(igroup)) ) & GOTO 130 Xymnmx(1,igroup) = RMAX Xymnmx(3,igroup) = -RMAX Xymnmx(2,igroup) = RMAX Xymnmx(4,igroup) = -RMAX C Ermnmx(1, igroup) = RMAX Ermnmx(2, igroup) = -RMAX Ermnmx(3, igroup) = RMAX Ermnmx(4, igroup) = -RMAX yerr = 0.0 C iy0 = Igrpos(1, igroup) lery = Iery(Igrpos(3, igroup)) IF ( lery.GT.0 ) THEN i2drow = Mxrow*(lery+1) ELSE i2drow = Mxrow END IF DO 120 i = 1, Igrpos(2, igroup) CALL PLTXCC(Y, i, igroup, xt, ndim, iyoff) IF ( xt(1).EQ.NO ) GOTO 120 xcen = xt(1) iyi = iy0 + iyoff yt = Y(iyi) IF ( ipmod(igroup).LT.0 .AND. yt.NE.NO ) THEN C ipmod.LT.0 means plot residuals itmp = ABS(ipmod(igroup)) yt = yt - FNFIT(xcen,ICOMP(1,itmp), & PVAL(1,itmp),nterm(itmp)) END IF Xymnmx(1,igroup) = MIN(Xymnmx(1,igroup), xcen) Xymnmx(3,igroup) = MAX(Xymnmx(3,igroup), xcen) CALL PLTXCE(Y, i, igroup, 1, xm, xp) Ermnmx(1, igroup) = MIN(Ermnmx(1, igroup), xcen+xm) Ermnmx(2, igroup) = MAX(Ermnmx(2, igroup), xcen+xp) IF ( yt.NE.NO ) THEN C Min/Max of data Xymnmx(2,igroup) = MIN(Xymnmx(2,igroup), yt) Xymnmx(4,igroup) = MAX(Xymnmx(4,igroup), yt) C Now calculate error IF ( lery.NE.0 ) THEN IF ( lery.GT.0 ) THEN yerr = Y(iyi+Mxrow) ELSE IF ( Y(iyi).GT.0.0 ) THEN yerr = SQRT(Y(iyi)) ELSE yerr = 1.0 END IF END IF END IF C Min/Max of data with error Ermnmx(3, igroup) = MIN(Ermnmx(3, igroup), yt-yerr) Ermnmx(4, igroup) = MAX(Ermnmx(4, igroup), yt+yerr) END IF 120 CONTINUE 130 CONTINUE Imnmx = Iskip Newmod = 0 END IF C--- C Now set default min and max values in each window. DO 290 iwnum = 1, Mxwin IF ( Iactw(iwnum).EQ.0 ) GOTO 290 IF ( Xyscal(1, iwnum).EQ.NO .OR. Xyscal(3, iwnum).EQ.NO ) THEN C Find min/max X values for all groups plotted in the current window. tmp1 = RMAX tmp2 = -RMAX DO igroup = 1, Ngroup IF ( igrpos(1,igroup).GE.0 ) THEN IF ( Idoall.NE.0 ) THEN IF ( Ipwin(igroup).GT.0 ) THEN IF ( Igap.EQ.0 ) THEN tmp1 = MIN(tmp1, Xymnmx(1,igroup)) tmp2 = MAX(tmp2, Xymnmx(3,igroup)) ELSE tmp1 = MIN(tmp1, Ermnmx(1, igroup)) tmp2 = MAX(tmp2, Ermnmx(2, igroup)) END IF END IF ELSE IF ( Ipwin(igroup).EQ.iwnum ) THEN IF ( Igap.EQ.0 ) THEN tmp1 = MIN(tmp1, Xymnmx(1,igroup)) tmp2 = MAX(tmp2, Xymnmx(3,igroup)) ELSE tmp1 = MIN(tmp1, Ermnmx(1, igroup)) tmp2 = MAX(tmp2, Ermnmx(2, igroup)) END IF END IF END IF END IF END DO IF ( tmp1.NE.RMAX ) THEN CALL PLTGAP(tmp1, tmp2, Rgap, Logx(iwnum), tmplo, tmphi) ELSE CALL PLTGAP(Xymnmx(1,iwnum), Xymnmx(3,iwnum), Rgap, & Logx(iwnum), tmplo, tmphi) END IF IF ( Xyscal(1, iwnum).EQ.NO ) Xyscal(1, iwnum) = tmplo IF ( Xyscal(3, iwnum).EQ.NO ) Xyscal(3, iwnum) = tmphi END IF IF ( Xyscal(2, iwnum).EQ.NO .OR. Xyscal(4, iwnum).EQ.NO ) THEN C Now find min/max of all y coordinate values. Since contours and C images are handled differently do them first. If no contour/image C then set scale the old fashion way. tmp1 = RMAX tmp2 = -RMAX xm = 0.0 xp = 0.0 DO igroup = 1, mx2d IF ( Ipwin(igroup).EQ.iwnum ) THEN IF ( Icont(igroup).GT.0 .OR. & Image(igroup).GT.0 ) THEN C If a contour/image appears in the current window, then the default C ymax is set by the corners of the 2D array being plotted CALL PLTXCC(Y, 1, igroup, xt, ndim, iyoff) IF ( ndim.NE.2 ) GOTO 180 IF ( igap.NE.0 ) THEN CALL PLTXCE(Y, 1, igroup, 2, xm, xp) END IF tmp1 = MIN(tmp1, xt(2)+xm) tmp2 = MAX(tmp2, xt(2)+xp) CALL PLTXCC(Y,igrpos(2,igroup),igroup, & xt,ndim,iyoff) IF ( igap.NE.0 ) THEN CALL PLTXCE(Y,igrpos(2,igroup),igroup,2,xm,xp) END IF tmp1 = MIN(tmp1, xt(2)+xm) tmp2 = MAX(tmp2, xt(2)+xp) END IF END IF END DO IF ( tmp1.NE.RMAX ) GOTO 190 C C No contour/images in the current window, use the data min/max of C the plot groups that appear in the window. 180 CONTINUE tmp1 = RMAX tmp2 = -RMAX DO igroup = 1, Ngroup IF ( Ipwin(igroup).EQ.iwnum ) THEN IF ( Igap.EQ.0 ) THEN tmp1 = MIN(tmp1, Xymnmx(2,igroup)) tmp2 = MAX(tmp2, Xymnmx(4,igroup)) ELSE tmp1 = MIN(tmp1, Ermnmx(3, igroup)) tmp2 = MAX(tmp2, Ermnmx(4, igroup)) END IF END IF END DO 190 CONTINUE IF ( tmp1.NE.RMAX ) THEN CALL PLTGAP(tmp1, tmp2, Rgap, Logy(iwnum), tmplo, tmphi) IF ( Xyscal(2, iwnum).EQ.NO ) Xyscal(2, iwnum) = tmplo IF ( Xyscal(4, iwnum).EQ.NO ) Xyscal(4, iwnum) = tmphi END IF END IF C--- C Check for negative scales when using a LOG plot. IF ( Logy(iwnum).NE.0 .AND. Xyscal(2, iwnum).LT.0. ) THEN tmp1 = RMAX tmp2 = -RMAX DO igroup = 1, Ngroup IF ( Ipwin(igroup).EQ.iwnum ) THEN iy0 = Igrpos(1, igroup) lery = Iery(Igrpos(3, igroup)) IF ( lery.GT.0 ) THEN i2drow = Mxrow*(lery+1) ELSE i2drow = Mxrow END IF DO i = 1, Igrpos(2, igroup) CALL PLTXCC(Y, i, igroup, xt, ndim, iyoff) iyi = iy0 + iyoff IF ( xt(1).NE.NO .AND. Y(iyi).GT.0. ) THEN tmp1 = MIN(tmp1, Y(iyi)) tmp2 = MAX(tmp2, Y(iyi)) END IF END DO END IF END DO CALL PLTGAP(tmp1,tmp2,Rgap,Logy(iwnum),Xyscal(2,iwnum),yt) IF ( Xyscal(4, iwnum).LT.0. ) Xyscal(4, iwnum) = yt END IF C IF ( Logx(iwnum).NE.0 .AND. Xyscal(1, iwnum).LT.0. ) THEN tmp1 = RMAX tmp2 = -RMAX DO igroup = 1, Ngroup IF ( Ipwin(igroup).EQ.iwnum ) THEN DO i = 1, Igrpos(2, igroup) CALL PLTXCC(Y, i, igroup, xt, ndim, iyoff) IF ( xt(1).NE.NO .AND. xt(1).GT.0 ) THEN tmp1 = MIN(tmp1, xt(1)) tmp2 = MAX(tmp2, xt(1)) END IF END DO END IF END DO CALL PLTGAP(tmp1,tmp2,Rgap,Logx(iwnum),Xyscal(1,iwnum),yt) IF ( Xyscal(3, iwnum).LT.0. ) Xyscal(3,iwnum) = yt END IF 290 CONTINUE C--- C Now define scales for the slaves DO iwnum=1,MXWIN IF ( Imaster(1,iwnum).GT.0 ) THEN C Have an X master Xyscal(1, iwnum) = Xyscal(1,imaster(1,iwnum)) Xyscal(3, iwnum) = Xyscal(3,imaster(1,iwnum)) END IF IF ( Imaster(2,iwnum).GT.0 ) THEN C Have a Y master Xyscal(2, iwnum) = Xyscal(2,imaster(2,iwnum)) Xyscal(4, iwnum) = Xyscal(4,imaster(2,iwnum)) END IF END DO C--- RETURN END fv5.5/tcltk/plt/edicmn.inc0000644000220700000360000000057713224715127014404 0ustar birbylheaC edicmn.inc C C IUP..IEOF are the user-defined control keys. C IFTYPE is the number returned by FORTYP. C ICEDIT is <>0 if line editing has been switched on. C INTEGER IUP, IDOWN, ILEFT, IRIGHT, IBEG, IEND INTEGER IWRITE, IERASE, IEOF, IFTYPE, ICEDIT C COMMON/EDICMN/ IUP, IDOWN, ILEFT, IRIGHT, IBEG, IEND, : IWRITE, IERASE, IEOF, IFTYPE, ICEDIT fv5.5/tcltk/plt/fit.f0000644000220700000360000013027313224715127013400 0ustar birbylheaC FIT.FOR C- Contains entry points for: C MODEL C CPARM C FRETHA C FIT C FITVIS C UNCERT C FITLIM C FNFIT C MDERIV C--- BLOCK DATA FITBLK C--- C Number of terms per model. C--- C AFT C--- INTEGER MXCNUM, MXCOD PARAMETER (MXCNUM=27, MXCOD=1) REAL XMIN, XMAX INTEGER ISTAT, NTER COMMON/FITCMN/XMIN(2),XMAX(2),ISTAT,NTER(MXCNUM+MXCOD) SAVE /FITCMN/ DATA ISTAT/0/ DATA NTER/ 1, 1, 1, 1, 1, 1, 2, 1 3, 3, 3, 3, 2 3, 4, 3 4, 5, 4 3, 3, 2, 5 3, 4, 4, 6, 6, 1, 6 0, 0, 0, 0/ END C********* SUBROUTINE MODEL(CBUF, Xmini, Xmaxi, MXPAR, Cmd, Ncmd, Icmd, : ICOMP, PVAL, PLIM, NTERM) CHARACTER CBUF*(*) CHARACTER Cmd(*)*(*) REAL Xmini(2), Xmaxi(2), PVAL(*), PLIM(3,*) INTEGER MXPAR, Ncmd, Icmd, NTERM INTEGER ICOMP(*) C--- C This routines handles the PLT commands, FReeze, MOdel, NEwpar, THaw, C and WModel. C--- C CBUF I Sub-command string C Xmini I Lower limit for spline models C Xmaxi I Upper limit for spline models C MXPAR I Maximun number of terms allowed C Cmd I PLT CMD array C Ncmd I Number of valid commands in CMD C Icmd I/O Number of commands actually used C ICOMP I/O Component number C PVAL O Parameter values C PLIM O Parameter errors/limits C NTERM I/O Number of parameters C--- C AFT C--- REAL NO PARAMETER (NO=-1.2E-34) INTEGER MXCNUM, MXCOD PARAMETER (MXCNUM=27, MXCOD=1) C CHARACTER CPARM*4 REAL FNCLOA, FPNUM INTEGER ISNUM, LENACT C CHARACTER CNAM*256, ctmp*256, CTOK*256, ctoku*256 CHARACTER CCOD(MXCOD)*72 SAVE CCOD CHARACTER CLAB(MXCNUM)*4 REAL TMP, DX INTEGER I, ICNUM, IE, IER, IFIRST, IHIT, ILOCAL, INEW, IOLD INTEGER IS, ITMP, IOS INTEGER K, KP, KP1, LKP INTEGER LNAM, LOCLAB, ltmp, LTOK, LUN, NCOD, NCTER, NT, NKNOT SAVE IFIRST C EXTERNAL FITBLK REAL XMIN, XMAX INTEGER ISTAT, NTER COMMON/FITCMN/XMIN(2),XMAX(2),ISTAT,NTER(MXCNUM+MXCOD) C- The model labels. DATA CLAB/ 'CONS', 'LINR', 'QUAD','CUBI','X4 ','X5 ','POWR', 1 'SIN ', 'GAUS', 'NGAU', 'EXP ', 2 'AEXP', 'BURS', 3 'SBUR', 'PEAR', 4 'WIND', 'KING', 'LN ', 5 'LORE', 'CGAU', 'NCGA', 'EGAU', 'NEGA', 'LY ', 6 'USER', 'SPLN', 'AKIM'/ DATA IFIRST/1/ C--- 11 FORMAT(A) C--- IF(IFIRST.NE.0) THEN IFIRST=0 CALL UINFO(0, CLAB(MXCNUM-2), NTER(MXCNUM-2)) CALL UPC(CLAB(MXCNUM-2)) END IF ctmp=CBUF ltmp=LENACT(ctmp) KP=0 LUN=0 CALL ALF(ctmp,ltmp,KP,CTOK,LTOK) CALL UPC(CTOK) IF(CTOK(1:1).EQ.'F') THEN C- Freeze sub-command CALL FRETHA(-1., ctmp, ltmp, KP, PLIM, NTERM) RETURN ELSE IF(CTOK(1:1).EQ.'M') THEN C- Model sub-command CALL ALFSKS(ctmp, ltmp, KP) IF(ctmp(KP+1:KP+1).EQ.'?') THEN GOTO 890 ELSE IF(ctmp(KP+1:KP+1).EQ.'@') THEN KP=KP+1 CALL ALF(ctmp, ltmp, KP, CTOK, LTOK) NTERM=0 CNAM='default' IF(LTOK.GT.1) CNAM=CTOK(:LTOK) CALL XTEND(CNAM,'mod') CALL GETLUN(LUN) CALL OPENWR(LUN,CNAM,'OLD',' ',' ',0,1,IOS) IF(IOS.NE.0) GOTO 930 READ(LUN,11,ERR=930,END=930) ctmp KP=0 ltmp=LENACT(ctmp) END IF ELSE IF(CTOK(1:1).EQ.'N') THEN C- Newpar sub-command GOTO 500 ELSE IF(CTOK(1:1).EQ.'T') THEN C- Thaw sub-command CALL FRETHA( 0., ctmp, ltmp, KP, PLIM, NTERM) RETURN ELSE IF(CTOK(1:1).EQ.'W') THEN C- Wmodel sub-command IF(CTOK(2:2).EQ.'L') THEN C WLun LUN CALL ALF(ctmp, ltmp, KP, CTOK, LTOK) LUN=FPNUM(CTOK, LTOK, IER) ctmp='MODEL ' ltmp=6 ILOCAL=0 ELSE C Wmodel filename CNAM=' ' CALL ALF(ctmp, ltmp, KP, CNAM, LNAM) CALL XTEND(CNAM, 'MOD') CALL GETLUN(LUN) CALL OPENWR(LUN, CNAM, 'NEW', ' ', 'L', 0, 0, IOS) IF(IOS.NE.0) THEN ITMP=LENACT(CNAM) WRITE(*,*) 'FIT--Error, unable to open file ',CNAM(:ITMP) CALL FRELUN(LUN) RETURN END IF ctmp=' ' ltmp=0 ILOCAL=1 END IF NT=1 150 CONTINUE IF ( ICOMP(NT).LE.MXCNUM ) THEN C- Standard component WRITE(ctmp(ltmp+1:),151) CLAB(ICOMP(NT)) 151 FORMAT(1X,A) ltmp=LENACT(ctmp) ELSE C- COD file ITMP=ICOMP(NT)-MXCNUM WRITE(ctmp(ltmp+1:),151) CCOD(ITMP)(:LENACT(CCOD(ITMP))) ltmp=LENACT(ctmp) END IF C- Special treatment for components that require a parameter IF ( ICOMP(NT).EQ.MXCNUM-1 ) THEN C- Spline WRITE(ctmp(ltmp+1:),161) NTER(ICOMP(NT))/2 161 FORMAT(1X,I3) ltmp=ltmp+5 ELSE IF ( ICOMP(NT).EQ.MXCNUM ) THEN C- Akima WRITE(ctmp(ltmp+1:),161) NTER(ICOMP(NT))/2 ltmp=ltmp+5 END IF NT=NT+NTER(ICOMP(NT)) IF(NT.LE.NTERM) GOTO 150 WRITE(LUN,11) ctmp(:ltmp) DO I=1,NTERM CTOK=CPARM(ICOMP,I,NTERM) WRITE(ctmp,*) PVAL(I),PLIM(1,I),PLIM(2,I),PLIM(3,I) ltmp = LENACT(ctmp) IF ( ltmp.LT.40 ) THEN ctmp(ltmp:40)=' ' ltmp = 40 END IF ctmp(ltmp+1:ltmp+2)=' !' ltmp = ltmp+2 CALL CRAMIF(i,4,ctmp,ltmp) WRITE(LUN,11) ctmp(:ltmp)//' '//ctok(1:2) END DO IF(PVAL(NTERM+1).GE.0.) THEN ctmp='! WVAR=' ltmp=8 CALL CRAMF(PVAL(NTERM+1),ctmp,ltmp) WRITE(LUN,11) ctmp(:ltmp) ctmp='! NBIN=' ltmp=8 CALL CRAMF(PVAL(NTERM+2),ctmp,ltmp) WRITE(LUN,11) ctmp(:ltmp) END IF IF(ILOCAL.NE.0) THEN CLOSE(UNIT=LUN) CALL FRELUN(LUN) END IF RETURN ELSE IF ( LTOK.LE.0 ) THEN GOTO 890 ELSE RETURN END IF C--- C- Fall through to start reading a model C- Reset all of COD's internal pointers. TMP=FNCLOA(+1,0,0,0.) NTERM=0 NCOD=0 C- Get component token 200 CONTINUE CALL ALF(ctmp,ltmp,KP,CTOK,LTOK) IF ( LTOK.LE.0 ) THEN PVAL(NTERM+1)=-1. GOTO 500 END IF IF ( CTOK(1:1).EQ.'/' ) RETURN CTOKU = CTOK CALL UPC(CTOKU) LOCLAB=1 IF(2.LE.LTOK .AND. LTOK.LE.4) THEN C- Built-in components can only be specified with 2-4 characters. DO ICNUM=1,MXCNUM IF ( CLAB(ICNUM)(1:LTOK).EQ.CTOKU(1:LTOK) ) GOTO 250 LOCLAB=LOCLAB+NTER(ICNUM) END DO END IF C- Now try a COD file DO I=1,NCOD ctok = ccod(i)(:ltok) CALL UPC(ctok) IF ( ctok(1:LTOK).EQ.CTOKU(1:LTOK)) THEN ICNUM=MXCNUM+I GOTO 350 END IF END DO KP1=0 CALL CODFIL(CTOK,LTOK,KP1,NCTER,IER) IF ( IER.EQ.0 ) THEN IF ( NCOD.GE.MXCOD ) THEN WRITE(*,231) MXCOD 231 FORMAT(' MODEL--Can only use',I6,' COD files.') NTERM=0 RETURN END IF NCOD=NCOD+1 ICNUM=MXCNUM+NCOD CCOD(NCOD)=CTOK NTER(ICNUM)=NCTER GOTO 350 END IF C--- C- Typo WRITE(*,211) CTOK(1:LTOK) 211 FORMAT(' Illegal component: "',A,'"') GOTO 890 C--- C- Get number of terms for components with variable number of terms. 250 CONTINUE IF ( ICNUM.EQ.MXCNUM-1 .OR. ICNUM.EQ.MXCNUM ) THEN C- Spline or Akima LKP=KP CALL ALF(ctmp,ltmp,KP,CTOK,LTOK) IF(ISNUM(CTOK,LTOK).NE.0) THEN NKNOT=FPNUM(CTOK,LTOK,IER) ELSE KP=LKP END IF IF(NKNOT.LE.1) NKNOT=2 NTER(ICNUM)=2*NKNOT IF ( ICNUM.EQ.MXCNUM-1 ) THEN CALL SPLIM(PVAL, PLIM, -1, NTER(ICNUM)) ELSE CALL AKLIM(PVAL, PLIM, -1, NTER(ICNUM)) ENDIF NKNOT=NTER(ICNUM)/2 END IF C--- C- Make sure we will not overflow the parameter arrays 350 CONTINUE IF ( NTERM+NTER(ICNUM).GT.MXPAR ) THEN WRITE(*,351) MXPAR 351 FORMAT(' MODEL--Can only contain',I6,' terms.') NTERM=0 RETURN END IF C--- C- Fill the ICOMP array DO I=1,NTER(ICNUM) ITMP=NTERM+I C- If parameter is not the same as the old then unfreeze. IF ( ICOMP(ITMP).NE.ICNUM ) THEN PLIM(1,ITMP)=0. END IF ICOMP(ITMP)=ICNUM END DO C--- C- Special initial conditions for Spline or Akima components IF ( ICNUM.EQ.MXCNUM-1 .OR. ICNUM.EQ.MXCNUM ) THEN XMIN(1) = Xmini(1) XMAX(1) = Xmaxi(1) XMIN(2) = Xmini(2) XMAX(2) = Xmaxi(2) IF ( XMIN(1).EQ.XMAX(1) ) XMAX(1) = XMIN(1)+1. DX=(XMAX(1)-XMIN(1))/(NKNOT-1) DO I=1,NKNOT C- To start, evenly distribute X-locations of knots and freeze ITMP=NTERM+I PVAL(ITMP) =XMIN(1)+DX*(I-1) PLIM(1,ITMP)=-1. PLIM(1,ITMP+NKNOT)=0. END DO END IF C--- C- Increment number of terms and loop NTERM=NTERM+NTER(ICNUM) GOTO 200 C--- C- 500 IF(NTERM.LE.0) GOTO 890 C--- C- Now read initial parameter values. CALL ALF(ctmp,ltmp,KP,CTOK,LTOK) IF ( LTOK.GT.0 ) THEN IS=FPNUM(CTOK,LTOK,IER) IE=IS ELSE IS=1 IE=NTERM END IF IS=MIN(MAX(IS,1),NTERM) IE=MIN(MAX(IE,1),NTERM) DO I=IS,IE IF ( KP.GE.ltmp ) THEN KP=0 IF ( LUN.GT.0 ) THEN C Reading a model file 510 CONTINUE READ(LUN,11,ERR=930,END=930) ctmp ltmp=LENACT(ctmp) C Skip lines starting with ! IF ( ctmp(1:1).EQ.'!') GOTO 510 ELSE 520 CONTINUE IF ( icmd.GE.0 .AND. icmd.LT.Ncmd ) THEN C Still be reading from the PLT CMD array IF ( LENACT(Cmd(icmd+1)).LE.0 ) THEN icmd = icmd+1 GOTO 520 END IF CALL STWARN(1) CALL LDBUF1(Cmd(icmd+1),Ier) icmd = icmd+1-Ier ELSE C No other place to read, must prompt the user directly. CTOK=CPARM(ICOMP,I,NTERM) WRITE(*,521) I,CTOK,PVAL(I),(PLIM(K,I),K=1,3) 521 FORMAT(I3,' ',A2,': VAL(',1PG11.4,'), SIG(',G11.4, : '), PLO(',G11.4,'), PHI(',G11.4,')?') END IF CALL GTBUF(' ',IER) IF ( IER.LT.0 ) GOTO 700 CALL GTREST(ctmp,ltmp) CALL ALFSKS(ctmp, ltmp, kp) IF ( ctmp(kp+1:kp+1).EQ.'"' ) kp = kp + 1 END IF END IF C Get parameter value CALL ALF(ctmp,ltmp,KP,CTOK,LTOK) IF(LTOK.GT.0) THEN TMP=FPNUM(CTOK,LTOK,IER) IF(PVAL(I).NE.TMP) PVAL(NTERM+1)=-1. PVAL(I)=TMP END IF C Get sigma or constraint CALL ALF(ctmp,ltmp,KP,CTOK,LTOK) IF(LTOK.GT.0) THEN IOLD=NINT(PLIM(1,I)) PLIM(1,I)=FPNUM(CTOK,LTOK,IER) INEW=NINT(PLIM(1,I)) IF(INEW.LT.-1) THEN C Constrained freeze, ensure factor is correct. PLIM(2,I)=1.0 ELSE IF(INEW.GE.0 .AND. IOLD.LT.-1) THEN C Thawed a constrainded parameter. Lower limit is meaningless, so reset. PLIM(2,I)=0.0 END IF END IF C Get lower limit or factor CALL ALF(ctmp,ltmp,KP,CTOK,LTOK) IF(LTOK.GT.0) PLIM(2,I)=FPNUM(CTOK,LTOK,IER) C Get upper limit CALL ALF(ctmp,ltmp,KP,CTOK,LTOK) IF(LTOK.GT.0) PLIM(3,I)=FPNUM(CTOK,LTOK,IER) IF ( ctmp(kp+1:kp+1).EQ.'!' ) kp=ltmp END DO C--- C- For constrained parameters, force parameter to be equal to another C- valid parameter. 700 CONTINUE DO i=1,NTERM C Avoid integer overflows on numbers with BIG sigmas. IF(PLIM(1,i).LT.0.) THEN IF(NINT(-PLIM(1,i)).GT.1) THEN PLIM(1,i)=MIN(MAX(-FLOAT(NTERM),PLIM(1,i)),-2.) C Parameter cannot be a constant times itself, just freeze it. IF(NINT(PLIM(1,i)).EQ.-i) THEN PLIM(1,i)=-1. PLIM(2,i)=0. END IF END IF END IF END DO C- CALL FITLIM(ICOMP, PVAL, PLIM, NTERM, IHIT) IF(LUN.NE.0) THEN CLOSE(UNIT=LUN) CALL FRELUN(LUN) END IF RETURN C--- 890 WRITE(*,891) (CLAB(K),K=1,MXCNUM) 891 FORMAT(' Possible components are:'/(9(2X,A4))) RETURN C- 930 WRITE(*,931) 931 FORMAT(' Unable to Open (or Read) full model file.') CLOSE(UNIT=LUN) CALL FRELUN(LUN) RETURN C--- END C********* CHARACTER*(*) FUNCTION CPARM(ICOMP, IPAR, NTERM) INTEGER ICOMP(*), IPAR, NTERM C--- C Find the label associated with parameter IPAR. C--- C ICOMP I C IPAR I C NTERM I C--- C 1990-Mar-02 - New routine [AFT] C--- INTEGER MXTERM PARAMETER (MXTERM=68) INTEGER MXCNUM, MXCOD PARAMETER (MXCNUM=27, MXCOD=1) C CHARACTER CTLAB(MXTERM)*2 INTEGER I, ICNUM, IOFF, ITMP, LABPOS C REAL XMIN, XMAX INTEGER ISTAT, NTER COMMON/FITCMN/XMIN(2),XMAX(2),ISTAT,NTER(MXCNUM+MXCOD) C The (first three) term labels. DATA CTLAB/'CO', 'LI', 'QU', 'CU', 'X4', 'X5', 'IN','PN', 1 'PE','PH','SN', 'GC','GW','GN', 'Gc', 'Gw', 'Gn', 2 'EC','EW','EN', 'EC','EW','EN', 'ST','PT','DT','BN', 3 'TS','RR','DT','BN', 'K ','X0','A1','M1','M2', 4 'T1','T2','LE', 'RC','IN','S0', 'XC','NL', 5 'LC','LW','LN', 'Xc','Yc','Gw','Gn', 'Xc','Yc','Gw','Gn', 6 'Xc','Sx','Yc','Sy','TH','Gn', 7 'Xc','Sx','Yc','Sy','TH','Gn', 'Ly'/ C--- IF(IPAR.EQ.NTERM+1) THEN CPARM='WV' RETURN ELSE IF(IPAR.GT.NTERM) THEN CPARM=' N' RETURN END IF C--- C Must first scan through to find out the parameter offset into the C current component. IOFF=1 120 IF(IOFF+NTER(ICOMP(IOFF)).LE.IPAR) THEN IOFF=IOFF+NTER(ICOMP(IOFF)) GOTO 120 END IF IOFF=IPAR-IOFF C ICNUM=ICOMP(IPAR) IF(ICNUM.LE.MXCNUM-3) THEN LABPOS=1 DO I=1,ICNUM-1 LABPOS=LABPOS+NTER(I) END DO CPARM=CTLAB(LABPOS+IOFF) ELSE IF(ICNUM.EQ.MXCNUM-2) THEN CALL UINFO(IOFF+1, CPARM, ITMP) ELSE IF(ICNUM.EQ.MXCNUM-1) THEN IF(IOFF.LT.NTER(ICNUM)/2) THEN CPARM='SX' ELSE CPARM='SY' END IF ELSE IF(ICNUM.EQ.MXCNUM) THEN IF(IOFF.LT.NTER(ICNUM)/2) THEN CPARM='AX' ELSE CPARM='AY' END IF ELSE IF(ICNUM.GT.MXCNUM) THEN CPARM='P'//CHAR(ICHAR('0')+MOD(IOFF+1,10)) END IF C--- RETURN END C********* SUBROUTINE FRETHA(PARVAL, Ctmp, Ltmp, KP, PLIM, NTERM) REAL PARVAL, PLIM(3,*) INTEGER Ltmp, KP, NTERM CHARACTER Ctmp*(*) C--- C Set PLIM(IPAR,1)=PARVAL for all IPAR values listed in Ctmp. C--- C PARVAL I The value to set. C Ctmp I C Ltmp I C KP I/O C PLIM I/O C NTERM I C--- C 1989-Oct-02 - [AFT] C--- CHARACTER CTOK*32 INTEGER I, IHI, ILO, LTOK, IER C--- 110 CALL ALF(Ctmp, Ltmp, KP, CTOK, LTOK) IF(LTOK.LE.0) RETURN CALL IRANGE(CTOK, LTOK, 1, 0, ILO, IHI, IER) IF(ILO.LE.0 .OR. IHI.GT.NTERM) THEN WRITE(*,*) ILO,'--Illegal parameter' RETURN END IF DO I=ILO, IHI PLIM(1,I)=PARVAL END DO GOTO 110 END C********* SUBROUTINE FIT(CBUF, IFIT, Y, MXROW, Ngroup, ICWIN, : Ipwin, IPYER, IWIN, IGRPOS, XYSCAL, : ICOMP, PVAL, PLIM, NTERM) CHARACTER CBUF*(*) REAL Y(*), XYSCAL(4,*), PVAL(*), PLIM(3,*) INTEGER IFIT, MXROW, Ngroup, ICWIN INTEGER Ipwin(*), IPYER(*), IWIN(*), IGRPOS(3,*) INTEGER ICOMP(*), NTERM C--- C This routine executes the PLT commands, FIT and FIT ERROR. C--- C CBUF I The string containing possible sub-commands. C IFIT I/O The number of the group fitted. C Y I C MXROW I C Ngroup I C Icwin I/O The (first) window containing the plot group being fitted. C Ipwin C IPYER I C Iwin C IGRPOS I Need to pass entire array since Ifit can change C XYSCAL I C ICOMP I C PVAL I/O C PLIM I C NTERM I C--- C AFT C--- REAL NO PARAMETER (NO=-1.2E-34) REAL FPNUM INTEGER ISNUM, LENACT C CHARACTER CTOK*32 REAL FDEL SAVE FDEL REAL CHI, CHIM, PLO, PHI, xt(2) INTEGER IEGOOD, IHIP, ILOP, ISGOOD, NITER SAVE IEGOOD, IHIP, ILOP, ISGOOD, NITER INTEGER I, ICNT, IDONE, IER INTEGER IPAR, ITMP, IX, iy0 INTEGER KP, LB, LTOK, ndim C INTEGER MXCNUM, MXCOD PARAMETER (MXCNUM=27, MXCOD=1) REAL XMIN, XMAX INTEGER ISTAT, NTER COMMON/FITCMN/XMIN(2),XMAX(2),ISTAT,NTER(MXCNUM+MXCOD) DATA NITER/10/,ILOP,IHIP/1,1/ DATA FDEL/2.7/ C--- IF ( NTERM.LE.0 ) THEN WRITE(*,*) 'FIT--Error, No model defined.' RETURN END IF C--- C Scan for sub-commands LB=LENACT(CBUF) KP=0 IDONE=0 CALL ALF(CBUF, LB, KP, CTOK, LTOK) 100 CONTINUE CALL UPC(CTOK) IF(CTOK(1:1).EQ.'U') THEN C 'UNcertainty' subcommand IF ( istat.NE.0 ) THEN WRITE(*,*) 'Using likelihood.' END IF GOTO 300 ELSE IF(CTOK(1:1).EQ.'I') THEN C 'Iteration' sub-command CALL ALF(CBUF, LB, KP, CTOK, LTOK) IF(LTOK.GT.0) THEN NITER=NINT(FPNUM(CTOK,LTOK,IER)) END IF ELSE IF(CTOK(1:1).EQ.'S') THEN C 'Statistic' sub-command CALL ALF(CBUF, LB, KP, CTOK, LTOK) CALL UPC(CTOK) IF(LTOK.EQ.0) THEN ISTAT=0 ELSE IF(CTOK(1:1).EQ.'C') THEN ISTAT=0 WRITE(*,*) 'Using chi^2.' ELSE IF(CTOK(1:1).EQ.'M') THEN ISTAT=1 END IF ELSE IF(ISNUM(CTOK,LTOK).NE.0) THEN C # sub-command ITMP=FPNUM(CTOK,LTOK,IER) C%%% C This allows user to ask to fit defined groups, but the fitting engine C only fits the original data. IF(ITMP.GT.0 .AND. ITMP.LE.Ngroup .AND. : igrpos(1,itmp).GE.0 ) THEN C%%% IFIT=ITMP ELSE WRITE(*,*) 'FIT--',itmp,' is not a valid data group.' END IF ICWIN=IWIN(IFIT) CALL PLTXCC(Y, 1, ifit, xt, ndim, itmp) XMIN(1)=MIN(XYSCAL(1,ICWIN),XYSCAL(3,ICWIN)) XMAX(1)=MAX(XYSCAL(1,ICWIN),XYSCAL(3,ICWIN)) XMIN(2)=MIN(XYSCAL(2,ICWIN),XYSCAL(4,ICWIN)) XMAX(2)=MAX(XYSCAL(2,ICWIN),XYSCAL(4,ICWIN)) WRITE(*,231) IFIT,XMIN(1),XMAX(1) IF ( ndim.GT.1) WRITE(*,241) XMIN(2),XMAX(2) CALL FITIT(Y, IPYER(IFIT), MXROW, ifit, : IGRPOS(1,IFIT), IGRPOS(2,IFIT), Xmin, Xmax, ISGOOD, IEGOOD, : NITER, ISTAT, ICOMP, PVAL, PLIM, NTERM, CHI) IDONE=1 END IF CALL ALF(CBUF, LB, KP, CTOK, LTOK) IF(LTOK.GT.0) GOTO 100 IF ( istat.NE.0 ) THEN WRITE(*,*) 'Using likelihood.' END IF C--- IF ( IDONE.EQ.0 ) THEN CALL FITVIS(Ipwin, Ngroup, IFIT) ICWIN=IWIN(IFIT) CALL PLTXCC(Y, 1, ifit, xt, ndim, itmp) XMIN(1)=MIN(XYSCAL(1,ICWIN),XYSCAL(3,ICWIN)) XMAX(1)=MAX(XYSCAL(1,ICWIN),XYSCAL(3,ICWIN)) XMIN(2)=MIN(XYSCAL(2,ICWIN),XYSCAL(4,ICWIN)) XMAX(2)=MAX(XYSCAL(2,ICWIN),XYSCAL(4,ICWIN)) WRITE(*,231) IFIT,XMIN(1),XMAX(1) 231 FORMAT(' Fitting group',I4,', from',1PG11.3,' to',G11.3) IF ( ndim.GT.1) WRITE(*,241) XMIN(2),XMAX(2) 241 FORMAT(' And bounded in Y by',1PG11.3,' to',G11.3) CALL FITIT(Y, IPYER(IFIT), MXROW, IFIT, : IGRPOS(1,IFIT), IGRPOS(2,IFIT), Xmin, Xmax, ISGOOD, IEGOOD, : NITER, ISTAT, ICOMP, PVAL, PLIM, NTERM, CHI) END IF RETURN C--- C Come here to compute uncertainties. C Read up to three optional numbers. 300 CONTINUE ICNT=0 DO I=1,3 CALL ALF(CBUF,LB,KP,CTOK,LTOK) IF(LTOK.LE.0) GOTO 340 IX=INDEX(CTOK(:LTOK),'.') IF(IX.GT.0) THEN C Reset default delta CHI^2 FDEL=FPNUM(CTOK,LTOK,IER) ELSE C Reset parameter range over which to determine errors. ITMP=FPNUM(CTOK,LTOK,IER) ITMP=MIN( MAX(1,ITMP), NTERM) IF(ICNT.EQ.0) THEN ILOP=ITMP ELSE IF(ITMP.GT.ILOP) THEN IHIP=ITMP ELSE IHIP=ILOP ILOP=ITMP END IF END IF ICNT=ICNT+1 END IF END DO 340 IF(ICNT.EQ.1) IHIP=ILOP C--- C For each parameter in the given range. Find the error. CHIM=PVAL(NTERM+1) NITER=10 iy0=IGRPOS(1,IFIT) DO IPAR=ILOP,IHIP CALL UNCERT(Y, Ifit, iy0, IPYER(IFIT), MXROW, Xmin, Xmax, & ISGOOD, IEGOOD, 1, ISTAT, ICOMP, PVAL, PLIM, NTERM, CHIM, : IPAR, FDEL, PLO, PHI, IER) IF(IER.GT.0) THEN IF(IER.EQ.1) THEN WRITE(*,371) CHIM 371 FORMAT(' New minimum found. CHI^2=',1PG10.4) END IF RETURN END IF WRITE(*,411) IPAR,FDEL,PLO,PHI 411 FORMAT(' Parameter ',I3,', Delta CHI^2=',1PG11.4,2G12.4) END DO C--- RETURN END C********* SUBROUTINE FITVIS(Ipwin, Ngroup, IFIT) INTEGER Ipwin(*), Ngroup, IFIT C--- C Return the plot group to actually fit in Ifit. This will be unchanged C unless Ifit is 0 (not defined) or the group being fitted is no longer C being plotted (i.e., was colored off). In this case, find the smallest C number corresponding to a plot group this is visible. C--- C Ipwin I >0 group is being plotted, <=0 otherwise C Ngroup I C IFIT I/O C--- C 1990-Mar-07 - [AFT] C--- INTEGER ig C--- IF ( IFIT.EQ.0 .OR. Ipwin(IFIT).LE.0 ) THEN DO ig=1,Ngroup IF ( Ipwin(ig).GT.0 ) THEN IFIT=ig GOTO 230 END IF END DO C Everything is colored of. Guess a random group. IFIT = 2 END IF C 230 CONTINUE RETURN END C********* SUBROUTINE UNCERT(Y, Igroup, iy0, LERY, MXROW, Xmin, Xmax, & ISGOOD, IEGOOD, ICHAT, ISTAT, ICOMP, PVAL, PLIM, NTERM, CHIM, : IPAR, VVREQ, PLO, PHI, IER) INTEGER NTERM REAL Y(*), Xmin(*), Xmax(*), PVAL(*), PLIM(3,*) REAL CHIM, VVREQ, PLO, PHI INTEGER Igroup, iy0, LERY, MXROW, ISGOOD, IEGOOD INTEGER ICHAT, ISTAT, ICOMP(NTERM) INTEGER IPAR, IER C--- C Finds delta chi^2. C--- C Y I C Igroup I The group number C MXROW I C LERY I C ISGOOD I C IEGOOD I C ICHAT I C PVAL I/O Parameter values at minimum. C PLIM I/O Bevington's errors at minimum. C CHIM I Minimun chi square. C IPAR I Index of parameter to find error. C VVREQ I Requested value of delta chi squared. C PLO O Low value of the parameter. C PHI O Hi value for parameter C IER O =0 Value found, C =1 New minimum found. C =2 Model insensitive to changes in some par. C =3 Parameter frozen. C <0 Gave up at least once. C--- C AFT C--- REAL NO PARAMETER (NO=-1.2E-34) INTEGER MXPAR PARAMETER (MXPAR=120) C REAL PTRY(MXPAR), SAVSIG(MXPAR) REAL CHI, DELCO, DELP, FUDGE, P1, P2 REAL V1, V2, VNEW, VREQ INTEGER I, ICNT, IFL, IHIT, NITER, NDOF, NFIT, NFPAR C DATA NITER/20/ C--- IF ( PVAL(NTERM+1).LT.0.0 ) THEN C User has not done a Fit hence chi^2 is not defined. WRITE(*,*) 'UNCERT--Must do a Fit before UNcertainty.' IER=3 RETURN END IF C IF(PLIM(1,IPAR).LT.0.) THEN WRITE(*,*) : 'UNCERT--Not allowed to find error of frozen parameter.' IER=3 RETURN END IF IER=0 FUDGE=1.0 IF ( LERY.EQ.0 .AND. Istat.EQ.0) THEN C--- C No errors, must compute fudge factor that makes reduced CHI^2 C equal to 1.0. NFPAR=0 DO I=1,NTERM IF(PLIM(1,I).GE.0) NFPAR=NFPAR+1 END DO NFIT=PVAL(NTERM+2) NDOF=NFIT-NFPAR IF(CHIM.GT.0.) FUDGE=(NFIT-NFPAR)/CHIM WRITE(*,131) FUDGE 131 FORMAT(' W-VAR is being multiplied by',1PG9.2, : ' to convert to Chi^2') END IF VREQ=SQRT(VVREQ) DELP=-VREQ*PLIM(1,IPAR) IF(ICHAT.GT.0) WRITE(*,181) 181 FORMAT(' Delta parm Delta Chi^2') C--- DO I=1,NTERM PTRY(I)=PVAL(I) SAVSIG(I)=PLIM(1,I) END DO PLIM(1,IPAR)=-1. IFL=1 C--- 300 CONTINUE ICNT=0 P1=0. V1=0. C--- 350 CONTINUE PTRY(IPAR)=PVAL(IPAR)+DELP IF(PLIM(2,IPAR).LT.PLIM(3,IPAR)) THEN C Hard limit PTRY(IPAR)=MIN( MAX(PLIM(2,IPAR),PTRY(IPAR)) ,PLIM(3,IPAR)) END IF CALL FITLIM(ICOMP, PTRY, PLIM, NTERM, IHIT) CALL CURFIT(Y, Igroup, iy0, LERY, MXROW, ISGOOD, IEGOOD, : Xmin, Xmax, -1, NITER, ISTAT, ICOMP, 0, NTERM, & 0.0, PTRY, PLIM, CHI) IF(CHI.LT.0.) THEN C Model insensitive to changes in parameter value. DO I=1,NTERM PLIM(1,I)=SAVSIG(I) END DO IER=2 RETURN END IF C DELCO=(CHI-CHIM)*FUDGE IF(ICHAT.GT.0) WRITE(*,361) DELP,DELCO 361 FORMAT(1X,1PG10.3,4X,G10.3) IF(DELCO.LT.0.) THEN C Found a new lower value of Chi^2, return new parameters to user. DO I=1,NTERM PVAL(I)=PTRY(I) END DO PLIM(1,IPAR)=0. CHIM=CHI IER=1 RETURN END IF IF(ABS(DELCO-VVREQ).LT..01) GOTO 400 VNEW=SQRT(DELCO) IF(ICNT.EQ.0) THEN P2=DELP V2=VNEW ELSE IF(VNEW.LT.VREQ) THEN P1=DELP V1=VNEW ELSE P2=DELP V2=VNEW END IF END IF IF(ABS(V2-V1).GT.1.E-12 .AND. ICNT.LT.10) THEN DELP=P1+(VREQ-V1)*(P2-P1)/(V2-V1) IF(IFL.NE.0) THEN IF(DELP.GT.0.) GOTO 390 ELSE IF(DELP.LT.0.) GOTO 390 END IF IF(ICNT.GT.5) THEN IF(V1.EQ.0. ) DELP= .9*DELP IF(V2.LT.VREQ) DELP=1.1*DELP END IF ICNT=ICNT+1 GOTO 350 END IF 390 CONTINUE WRITE(*,391) 391 FORMAT(' UNCERT--Give up.') IER=-1 C--- 400 CONTINUE IF(IFL.NE.0) THEN IFL=0 PLO=PTRY(IPAR) DELP=-DELP GOTO 300 END IF PHI=PTRY(IPAR) C Restore the original sigmas. DO I=1,NTERM PLIM(1,I)=SAVSIG(I) END DO C Note, splines keep internal parameters that need to be restored. CALL FITLIM(ICOMP, PVAL, PLIM, NTERM, IHIT) RETURN END C********* SUBROUTINE FITLIM(ICOMP, PVAL, PLIM, NTERM, IHIT) INTEGER NTERM INTEGER ICOMP(NTERM) REAL PVAL(NTERM), PLIM(3,NTERM) C--- C This routine should be called just after parameters have been C changed to make sure the parameters are in legal bounds. C--- C ICOMP I Component defination. C PVAL I/O Parameter values, can be altered to meet limits. C PLIM I The limit array. C IHIT O If non-zero, is the number of a parameter that C -was altered. C--- C AFT C--- INTEGER MXCNUM, MXCOD PARAMETER (MXCNUM=27, MXCOD=1) C REAL tmp INTEGER I, IACOMP, IHIT, IX, NT C REAL XMIN, XMAX INTEGER ISTAT, NTER COMMON/FITCMN/XMIN(2),XMAX(2),ISTAT,NTER(MXCNUM+MXCOD) C--- IHIT=0 NT=1 C--- C Do the general parameter ajustments. 100 IACOMP=ICOMP(NT) DO 110 I=NT,NT+NTER(IACOMP)-1 C Avoid integer overflows on numbers with BIG sigmas IF(PLIM(1,I).LT.0.) THEN IX=NINT(-PLIM(1,I)) IF(IX.GT.1) THEN IF(PLIM(2,I).NE.0.) THEN C Constrained to be a constant times another parameter. PVAL(I)=PLIM(2,I)*PVAL(IX) ELSE C Constrained to be a constant added to another parameter. PVAL(I)=PLIM(3,I)+PVAL(IX) END IF END IF ELSE IF(PLIM(2,I).LT.PLIM(3,I)) THEN C Hard limit IF(PVAL(I).LT.PLIM(2,I)) THEN IHIT=I PVAL(I)=PLIM(2,I) ELSE IF(PVAL(I).GT.PLIM(3,I)) THEN IHIT=I PVAL(I)=PLIM(3,I) END IF END IF 110 CONTINUE C Now check for special cases GOTO (890,890,890,890,890,890,890,890,320,320,890,890,890,890, : 890,890,890,890,890,650,650,660,660,890, : 800,820,860,890) IACOMP C C- Gaussian/Ngaus (force width to be positive) 320 CONTINUE PVAL(NT+1)=ABS(PVAL(NT+1)) IF ( Pval(nt+1).EQ.0.0 ) Pval(nt+1) = 1.0E-6 GOTO 890 C C- CGaus/NCgaus (force width to be positive) 650 CONTINUE Pval(nt+2)=ABS(Pval(nt+2)) IF ( Pval(nt+1).EQ.0.0 ) Pval(nt+1) = 1.0E-6 GOTO 890 C C- EGaus/NEgaus (force width to be positive) 660 CONTINUE C Sigma cannot be negative nor zero. Pval(nt+1)=ABS(Pval(nt+1)) IF ( Pval(nt+1).EQ.0.0 ) Pval(nt+1) = 1.0E-6 Pval(nt+3)=ABS(Pval(nt+3)) IF ( Pval(nt+3).EQ.0.0 ) Pval(nt+3) = 1.0E-6 C Require sigx to be larger than sigy IF ( Pval(nt+3).GT.Pval(nt+1) ) THEN C But only if sigx, sigy, and theta are all free IF ( Plim(1,nt+1).GE.0.0 .AND. Plim(1,nt+3).GE.0.0 .AND. & Plim(1,nt+4).GE.0.0 ) THEN tmp = Pval(nt+3) Pval(nt+3) = Pval(nt+1) Pval(nt+1) = tmp Pval(nt+4) = Pval(nt+4)+90. END IF END IF C Make sure angle is in range -90 +90 tmp = MOD(Pval(nt+4)+90.,180.) IF ( tmp.LT.0.0 ) tmp=tmp+180. Pval(nt+4)=tmp-90. GOTO 890 C C- User model. 800 CALL ULIMIT(PVAL, PLIM, NT, NTER(IACOMP)) GOTO 890 C C- SPLN Spline 820 CALL SPLIM(PVAL, PLIM, NT, NTER(IACOMP)) GOTO 890 C C- AKIMA model. 860 CALL AKLIM(PVAL, PLIM, NT, NTER(IACOMP)) GOTO 890 C--- 890 NT=NT+NTER(IACOMP) IF(NT.LE.NTERM) GOTO 100 C--- RETURN END C********* REAL FUNCTION FNFIT(Xt, ICOMP, PVAL, NTERM) INTEGER ICOMP(*), NTERM REAL Xt(2), PVAL(NTERM) C--- C Compute the function value. C--- C Xt I The (possibly 2 dimensional) independent variable C ICOMP I C PVAL(*) I C PLIM(3,*) I C--- C AFT C--- REAL NO PARAMETER (NO=-1.2E-34) INTEGER MXCNUM, MXCOD PARAMETER (MXCNUM=27, MXCOD=1) REAL FNAKIM, FNCOD, FNSP, UFNY C REAL A2, ca, DEM, EX, FAC, P1, sa, T, T1LOG, T2LOG REAL TC, TMP, TT, X, X1, X2, XC, xs, y, ys, z2 INTEGER IACOMP, IER, NT C REAL XMIN, XMAX INTEGER ISTAT, NTER COMMON/FITCMN/XMIN(2),XMAX(2),ISTAT,NTER(MXCNUM+MXCOD) REAL rtd DATA rtd/57.2957795/ C--- X=Xt(1) Y=Xt(2) C FNFIT=0. NT=1 100 CONTINUE IACOMP=ICOMP(NT) GOTO (200,210,220,230,240,250,260,300,320,320,360,360,400,450, : 500,550,600,620,640,650,650,660,660,670, : 800,820,860,880) IACOMP C- CONS 200 FNFIT=FNFIT+PVAL(NT) GOTO 890 C- LINR 210 FNFIT=FNFIT+PVAL(NT)*X GOTO 890 C- QUAD 220 FNFIT=FNFIT+PVAL(NT)*X*X GOTO 890 C- CUBI 230 FNFIT=FNFIT+PVAL(NT)*X*X*X GOTO 890 C- X4 240 X2=X*X FNFIT=FNFIT+PVAL(NT)*X2*X2 GOTO 890 C- X5 250 X2=X*X FNFIT=FNFIT+PVAL(NT)*X2*X2*X GOTO 890 C- POWR 260 IF(X.GT.0.) THEN IF(PVAL(NT+1).GT.0.) THEN TMP=PVAL(NT)*LOG(X)+LOG( PVAL(NT+1)) TMP=MIN(MAX(-70.,TMP),70.) FNFIT=FNFIT+EXP(TMP) ELSE IF(PVAL(NT+1).LT.0.) THEN TMP=PVAL(NT)*LOG(X)+LOG(-PVAL(NT+1)) TMP=MIN(MAX(-70.,TMP),70.) FNFIT=FNFIT-EXP(TMP) END IF END IF GOTO 890 C- SIN 300 IF(PVAL(NT).NE.0.) FNFIT=FNFIT+PVAL(NT+2)*SIN((X-PVAL(NT+1))* : 6.28318531/PVAL(NT)) GOTO 890 C- GAUS/NGAU 320 CONTINUE xs = (X-PVAL(NT))/PVAL(NT+1) ex = 0. IF ( ABS(xs).LT.12.0 ) ex = EXP(-xs*xs/2.) IF ( IACOMP.EQ.9 ) THEN C GAus FNFIT=FNFIT+PVAL(NT+2)*ex ELSE C NGaus FNFIT=FNFIT+PVAL(NT+2)*ex/(2.50662827*PVAL(NT+1)) END IF GOTO 890 C- EXP and AEXP 360 xs=0. IF ( PVAL(NT+1).NE.0. ) xs=(X-PVAL(NT))/PVAL(NT+1) IF ( IACOMP.EQ.12 ) xs=ABS(xs) EX=0. IF ( ABS(xs).LT.80. ) EX=EXP(-xs) FNFIT=FNFIT+PVAL(NT+2)*EX GOTO 890 C- BURS 400 xs=0. IF ( X.GT.PVAL(NT) ) THEN IF ( X.LT.PVAL(NT+1) ) THEN FNFIT=FNFIT+PVAL(NT+3)*(X-PVAL(NT))/(PVAL(NT+1)-PVAL(NT)) ELSE IF ( PVAL(NT+2).NE.0.) xs=(X-PVAL(NT+1))/PVAL(NT+2) EX=0. IF ( ABS(xs).LT.70. ) EX=EXP(-xs) FNFIT=FNFIT+PVAL(NT+3)*EX END IF END IF GOTO 890 C- SBUR 450 T=X-PVAL(NT) IF(T.GT.0) THEN FAC=1. IF(PVAL(NT+1).NE.0.) FAC=2.718281828/ABS(PVAL(NT+1)*PVAL(NT+2)) TC=LOG(FAC*T) P1=PVAL(NT+1)*TC-T/PVAL(NT+2) EX=0. IF(ABS(P1).LT.80.) EX=EXP(P1) FNFIT=FNFIT+PVAL(NT+3)*EX END IF GOTO 890 C- PEAR 500 A2=PVAL(NT+2)*PVAL(NT+4)/PVAL(NT+3) X1=(X-PVAL(NT+1))/PVAL(NT+2) X2=(X-PVAL(NT+1))/A2 IF ( -1.0.LT.X1 .AND. X2.LT.1.0 ) THEN IF(ABS(X1).GT.1.E-5) THEN T1LOG=LOG(1.+X1) ELSE T1LOG= X1-X1*X1/2. END IF IF(ABS(X2).GT.1.E-5) THEN T2LOG=LOG(1.-X2) ELSE T2LOG=-X2-X2*X2/2. END IF TT=PVAL(NT+3)*T1LOG+PVAL(NT+4)*T2LOG TT=MIN(MAX(-80.,TT),+80.) FNFIT=FNFIT+PVAL(NT)*EXP(TT) END IF GOTO 890 C- WIND 550 IF(X.GE.PVAL(NT) .AND. X.LE.PVAL(NT+1)) FNFIT=FNFIT+PVAL(NT+2) GOTO 890 C- KING 600 IF(PVAL(NT).GT.0.) THEN TMP=XT(1)/PVAL(NT) FNFIT=FNFIT+PVAL(NT+2)*(1.+TMP*TMP)**(-PVAL(NT+1)) END IF GOTO 890 C- LN Natural LOG 620 XC=X-PVAL(NT) IF(XC.GT.0.) FNFIT=FNFIT+PVAL(NT+1)*LOG(XC) GOTO 890 C- LORE Lorentz 640 IF(PVAL(NT+1).EQ.0.) GOTO 890 XC=2.*(X-PVAL(NT))/PVAL(NT+1) DEM=1.+XC*XC FNFIT=FNFIT+PVAL(NT+2)/DEM GOTO 890 C- CGaus/NCgaus 650 CONTINUE xs = (X-PVAL(NT ))/PVAL(NT+2) ys = (Y-PVAL(NT+1))/PVAL(NT+2) z2 = xs*xs + ys*ys ex = 0. IF ( z2.LT.144.0 ) ex = EXP(-z2/2.) IF ( IACOMP.EQ.20 ) THEN C CGaus FNFIT=FNFIT+PVAL(NT+3)*ex ELSE C NCgaus FNFIT=FNFIT+Pval(Nt+3)*ex/(6.283185307*Pval(Nt+2)*Pval(Nt+2)) END IF GOTO 890 C- EGaus/NEgaus 660 CONTINUE ca = COS(Pval(Nt+4)/rtd) sa = SIN(Pval(Nt+4)/rtd) xs = ca*(xt(1)-Pval(Nt )) + sa*(xt(2)-Pval(Nt+2)) ys =-sa*(xt(1)-Pval(Nt )) + ca*(xt(2)-Pval(Nt+2)) z2 = (xs/Pval(Nt+1))**2 + (ys/Pval(Nt+3))**2 ex = 0. IF ( z2.LT.144.0 ) ex = EXP(-z2/2.) IF ( IACOMP.EQ.22 ) THEN C Egaus FNFIT = FNFIT + Pval(nt+5)*ex ELSE C NEgaus FNFIT = FNFIT+Pval(Nt+5)*ex/(6.283185307*Pval(Nt+1)*Pval(Nt+3)) END IF GOTO 890 C- LY Linear in Y 670 CONTINUE FNFIT=FNFIT+Pval(Nt)*Y GOTO 890 C- USER 800 FNFIT=FNFIT+UFNY(XT,PVAL,NT,NTER(IACOMP)) GOTO 890 C- SPLN Spline 820 FNFIT=FNFIT+FNSP(XT,PVAL(NT)) GOTO 890 C- AKIM Akima 860 FNFIT=FNFIT+FNAKIM(XT,PVAL(NT)) GOTO 890 C- COD 880 FNFIT=FNFIT+FNCOD(0,0,XT,PVAL(NT),NTER(IACOMP),IER) GOTO 890 C--- 890 NT=NT+NTER(IACOMP) IF(NT.LE.NTERM) GOTO 100 RETURN END C********* SUBROUTINE MDERIV(Xt, Icomp, Pval, Plim, Nterm, Deriv) INTEGER Nterm REAL Xt(2), Pval(Nterm), Plim(3,*), Deriv(Nterm) INTEGER Icomp(*) C--- C Compute the Derivative with respect to the parameter values. C--- C Xt I The (possibly 2 dimensional) independent variable C Icomp I C Pval(*) I C Plim(3,*) I C Nterm I C Deriv(*) O C--- C AFT C--- REAL NO PARAMETER (NO=-1.2E-34) INTEGER MXCNUM, MXCOD PARAMETER (MXCNUM=27, MXCOD=1) C REAL A2, BT, ca, DEM, EX, FAC, fny0, P1, sa REAL T, T1, T2, TC, TIM, TMP REAL TT, T1LOG, T2LOG, X, X1, X2, XC, xs, XLOG, y, ys, z2 INTEGER I, IACOMP, IX, NT C REAL XMIN, XMAX INTEGER ISTAT, NTER COMMON/FITCMN/XMIN(2),XMAX(2),ISTAT,NTER(MXCNUM+MXCOD) REAL rtd DATA rtd/57.2957795/ C--- x = Xt(1) y = Xt(2) DO I=1,Nterm Deriv(I)=0. END DO C NT=1 100 CONTINUE IACOMP=Icomp(NT) GOTO (200,210,220,230,240,250,260,300,320,320,360,360,400,450, : 500,550,600,620,640,650,650,660,660,670, : 800,820,860,880) IACOMP C- CONS 200 Deriv(NT)=1. GOTO 890 C- LINR 210 Deriv(NT)=X GOTO 890 C- QUAD 220 Deriv(NT)=X*X GOTO 890 C- CUBI 230 Deriv(NT)=X*X*X GOTO 890 C- X4 240 Deriv(NT)=X*X*X*X GOTO 890 C- X5 250 Deriv(NT)=X*X*X*X*X GOTO 890 C- POWR 260 IF(X.GT.0.) THEN XLOG=LOG(X) TMP=Pval(NT)*XLOG TMP=MIN(MAX(-70.,TMP),70.) Deriv(NT+1)=EXP(TMP) Deriv(NT )=Pval(NT+1)*Deriv(NT+1)*XLOG END IF GOTO 890 C- SIN 300 IF(Pval(NT).NE.0) THEN TMP=6.28318531/Pval(NT) TIM=(X-Pval(NT+1)) Deriv(NT+1)=-Pval(NT+2)*TMP*COS(TMP*TIM) Deriv(NT )= Deriv(NT+1)*TIM/Pval(NT) Deriv(NT+2)= SIN(TMP*TIM) END IF GOTO 890 C- GAUS/NGAU 320 CONTINUE xs=(X-Pval(NT))/Pval(NT+1) EX=0. IF ( ABS(xs).LT.12.0 ) EX=EXP(-xs*xs/2.) IF ( IACOMP.EQ.9 ) THEN C GAus Deriv(NT )=Pval(NT+2)*EX*xs/Pval(NT+1) Deriv(NT+1)=xs*Deriv(NT) Deriv(NT+2)=EX ELSE C NGaus EX = EX/2.50662827 tmp = Pval(NT+2)*EX/(Pval(NT+1)*Pval(NT+1)) Deriv(NT ) = tmp*xs Deriv(NT+1) = tmp*(xs*xs-1.0) Deriv(NT+2) = EX/Pval(NT+1) END IF GOTO 890 C- EXP and AEXP 360 xs=0. IF(Pval(NT+1).NE.0.) xs=(X-Pval(NT))/Pval(NT+1) IF(IACOMP.EQ.12) xs=ABS(xs) EX=0. IF(ABS(xs).LT.80.) EX=EXP(-xs) Deriv(NT)=0. IF(Pval(NT+1).NE.0.) Deriv(NT)=Pval(NT+2)*EX/Pval(NT+1) Deriv(NT+1)=xs*Deriv(NT) Deriv(NT+2)=EX IF(IACOMP.EQ.12 .AND. X.LT.Pval(NT)) Deriv(NT)=-Deriv(NT) GOTO 890 C- BURS 400 xs=0. IF ( X.GT.Pval(NT) ) THEN IF ( X.LT.Pval(NT+1) ) THEN DEM=Pval(NT+1)-Pval(NT) Deriv(NT)=Pval(NT+3)*(X-Pval(NT+1))/(DEM*DEM) Deriv(NT+1)=-Pval(NT+3)*(X-Pval(NT))/(DEM*DEM) Deriv(NT+3)=(X-Pval(NT))/DEM ELSE IF(Pval(NT+2).NE.0.) xs=(X-Pval(NT+1))/Pval(NT+2) EX=0. IF(ABS(xs).LT.80.) EX=EXP(-xs) Deriv(NT+1)=0. IF(Pval(NT+2).NE.0.) Deriv(NT+1)=Pval(NT+3)*EX/Pval(NT+2) Deriv(NT+2)=xs*Deriv(NT+1) Deriv(NT+3)=EX END IF END IF GOTO 890 C- SBUR 450 T=X-Pval(NT) IF(T.GT.0) THEN Pval(NT+2)=ABS(Pval(NT+2)) FAC=1. IF(Pval(NT+1).NE.0.) FAC=2.718281828/ABS(Pval(NT+1)*Pval(NT+2)) TC=LOG(FAC*T) P1=Pval(NT+1)*TC-T/Pval(NT+2) EX=0. IF(ABS(P1).LT.80.) EX=EXP(P1) BT=Pval(NT+3)*EX Deriv(NT )=BT*(1./Pval(NT+2)-Pval(NT+1)/T) Deriv(NT+1)=BT*(TC-1.) Deriv(NT+2)=BT*(T-Pval(NT+1)*Pval(NT+2))/ : (Pval(NT+2)*Pval(NT+2)) Deriv(NT+3)= EX END IF GOTO 890 C- PEAR 500 A2=Pval(NT+2)*Pval(NT+4)/Pval(NT+3) X1=(X-Pval(NT+1))/Pval(NT+2) X2=(X-Pval(NT+1))/A2 IF ( -1.0.LT.X1 .AND. X2.LT.1.0 ) THEN T1=1.+X1 T2=1.-X2 IF(ABS(X1).GT.1.E-5) THEN T1LOG=LOG(1.+X1) ELSE T1LOG= X1-X1*X1/2. END IF IF(ABS(X2).GT.1.E-5) THEN T2LOG=LOG(1.-X2) ELSE T2LOG=-X2-X2*X2/2. END IF TT=Pval(NT+3)*T1LOG+Pval(NT+4)*T2LOG TT=MIN(MAX(-80.,TT),+80.) Deriv(NT)=EXP(TT) TMP=Pval(NT)*Deriv(NT) Deriv(NT+1)=TMP*Pval(NT+3)*(1./T2-1./T1)/Pval(NT+2) Deriv(NT+2)=X1*Deriv(NT+1) Deriv(NT+3)=TMP*(T1LOG-X1/T2) Deriv(NT+4)=TMP*(T2LOG+X2/T2) END IF GOTO 890 C- WIND 550 IF(X.GE.Pval(NT) .AND. X.LE.Pval(NT+1)) THEN Deriv(NT+2)=1. END IF GOTO 890 C--- C- KIng 600 IF(Pval(NT).GT.0.) THEN X1=X/Pval(NT) TMP=1.+X1*X1 Deriv(NT+2)=TMP**(-Pval(NT+1)) Deriv(NT )=2.*Pval(NT+1)*Pval(NT+2)*Deriv(NT+2)*X1*X1/ : (Pval(NT)*TMP) Deriv(NT+1)=-Pval(NT+2)*LOG(TMP)*Deriv(NT+2) END IF GOTO 890 C- LN Natural LOG 620 XC=X-Pval(NT) IF(XC.GT.0.) THEN Deriv(NT+1)=LOG(XC) Deriv(NT) =-Pval(NT+1)/XC END IF GOTO 890 C- LORE Lorentz 640 IF(Pval(NT+1).EQ.0.) GOTO 890 XC=2.*(X-Pval(NT))/Pval(NT+1) DEM=1.+XC*XC Deriv(NT )= Pval(NT+2)*4.*XC/(DEM*DEM*Pval(NT+1)) Deriv(NT+1)= Pval(NT+2)*2.*XC*XC/(DEM*DEM*Pval(NT+1)) Deriv(NT+2)=1./DEM GOTO 890 C- CGaus 650 CONTINUE xs = (X-Pval(NT ))/Pval(NT+2) ys = (Y-Pval(NT+1))/Pval(NT+2) z2 = xs*xs + ys*ys ex = 0. IF ( z2.LT.144.0 ) ex = EXP(-z2/2.) IF ( IACOMP.EQ.20 ) THEN C CGgaus Deriv(NT ) = ex*Pval(NT+3)*xs/Pval(NT+2) Deriv(NT+1) = ex*Pval(NT+3)*ys/Pval(NT+2) Deriv(NT+2) = ex*Pval(NT+3)*z2/Pval(NT+2) Deriv(NT+3) = ex ELSE C NCgaus ex = ex/(6.283185307*Pval(NT+2)*Pval(NT+2)) Deriv(NT ) = ex*Pval(NT+3)*xs/Pval(NT+2) Deriv(NT+1) = ex*Pval(NT+3)*ys/Pval(NT+2) Deriv(NT+2) = ex*Pval(NT+3)*(z2-2.0)/Pval(NT+2) Deriv(NT+3) = ex END IF GOTO 890 C- EGaus/NEgaus 660 CONTINUE ca = COS(Pval(nt+4)/rtd) sa = SIN(Pval(nt+4)/rtd) xs = ca*(xt(1)-Pval(nt )) + sa*(xt(2)-Pval(nt+2)) ys =-sa*(xt(1)-Pval(nt )) + ca*(xt(2)-Pval(nt+2)) z2 = (xs/Pval(nt+1))**2 + (ys/Pval(nt+3))**2 ex = 0. IF ( z2.LT.144.0 ) ex = EXP(-z2/2.) C IF ( IACOMP.EQ.22 ) THEN C EGaus fny0 = ex*Pval(nt+5) Deriv(nt )=fny0*( xs*ca/Pval(nt+1)**2-ys*sa/Pval(nt+3)**2) Deriv(nt+1)=fny0*((xs/Pval(nt+1))**2)/Pval(nt+1) Deriv(nt+2)=fny0*( xs*sa/Pval(nt+1)**2+ys*ca/Pval(nt+3)**2) Deriv(nt+3)=fny0*((ys/Pval(nt+3))**2)/Pval(nt+3) Deriv(nt+4)=(fny0/rtd)*( & ( sa*(xt(1)-Pval(nt))-ca*(xt(2)-Pval(nt+2)) )*xs/Pval(nt+1)**2 & +( ca*(xt(1)-Pval(nt))+sa*(xt(2)-Pval(nt+2)) )*ys/Pval(nt+3)**2) Deriv(nt+5)=ex ELSE C NEgaus fny0 = ex*Pval(nt+5)/(6.283185307*Pval(nt+1)*Pval(nt+3)) Deriv(nt )=fny0*( xs*ca/Pval(nt+1)**2-ys*sa/Pval(nt+3)**2) Deriv(nt+1)=fny0*((xs/Pval(nt+1))**2-1)/Pval(nt+1) Deriv(nt+2)=fny0*( xs*sa/Pval(nt+1)**2+ys*ca/Pval(nt+3)**2) Deriv(nt+3)=fny0*((ys/Pval(nt+3))**2-1)/Pval(nt+3) Deriv(nt+4)=(fny0/rtd)*( & ( sa*(xt(1)-Pval(nt))-ca*(xt(2)-Pval(nt+2)) )*xs/Pval(nt+1)**2 & +( ca*(xt(1)-Pval(nt))+sa*(xt(2)-Pval(nt+2)) )*ys/Pval(nt+3)**2) Deriv(nt+5)=ex/(6.283185307*Pval(nt+1)*Pval(nt+3)) END IF GOTO 890 C- LY Linear in Y 670 CONTINUE Deriv(Nt)=Y GOTO 890 C- USER model 800 CALL UDeriv(XT,Pval,Plim,Deriv,NT,NTER(IACOMP)) GOTO 890 C- SPLN Spline fit 820 CALL SPDERI(XT,Pval,Plim,Deriv,NT,NTER(IACOMP)) GOTO 890 C- AKIM Akima model. 860 CALL AKDERI(XT,Pval,Plim,Deriv,NT,NTER(IACOMP)) GOTO 890 C- COD 880 CALL CODDER(XT,Pval,Plim,Deriv,NT,NTER(IACOMP)) GOTO 890 C--- 890 NT=NT+NTER(IACOMP) IF(NT.LE.Nterm) GOTO 100 DO I=1,Nterm C Avoid integer overflows on numbers with BIG sigmas. IF(Plim(1,I).LT.0.) THEN IX=NINT(-Plim(1,I)) IF(IX.GT.1) THEN IF(Plim(2,I).NE.0.) THEN C Parameter times Plim(2,I) Deriv(IX)=Deriv(IX)+Plim(2,I)*Deriv(I) ELSE C Parameter added to Plim(3,I) Deriv(IX)=Deriv(IX)+Deriv(I) END IF END IF END IF END DO RETURN END fv5.5/tcltk/plt/fitit.f0000644000220700000360000000456213224715127013736 0ustar birbylhea SUBROUTINE FITIT(Y, Lery, Mxrow, Igroup, : Iyoff0, Npts, Xmin, Xmax, Isgood, Iegood, : Niter, Istat, Icomp, Par, Plim, Nterm, Chi) REAL Y(*), Xmin(*), Xmax(*), Par(*), Plim(3,*), Chi INTEGER Lery, Mxrow, Igroup INTEGER Iyoff0, Npts, Isgood, Iegood INTEGER Niter, Icomp(*), Nterm, Istat C--- C Calculate the number of points in the range, set Isgood and Iegood C to be first and last points in the range. Report number of points C to user and then call CURFIT. C--- C Y C Lery C Mxrow C Igroup C Iyoff0 C Npts C Xmin I The smallest X to include in fit. C Xmax I The largest X to include in fit. C Isgood O The smallest index included in fit. C Iegood O The largest index included in fit. C Niter C Istat C Icomp C Par C Plim C Nterm C Chi C--- C 1990-Mar-06 - Extracted from FIT [AFT] C--- INTEGER MXDIM PARAMETER (MXDIM=2) REAL NO PARAMETER (NO=-1.2E-34) REAL WEIGHT C REAL xt(MXDIM) REAL wtmp INTEGER iyoff INTEGER I, iyi, K, ndim, nfit, nidim C--- C The following code finds the first and last points in the range that C are to be included in the fit. This greatly speeds up the fitting C of short segments of data. nfit=0 Isgood=0 Iegood=0 CALL PLTXCC(Y, 1, igroup, xt, nidim, iyoff) DO 190 I=1,Npts CALL PLTXCC(Y, i, igroup, xt, ndim, iyoff) IF ( xt(1).EQ.NO ) GOTO 190 IF ( xt(1).LT.Xmin(1) .OR. xt(1).GT.Xmax(1) ) GOTO 190 IF ( nidim.GT.1 ) THEN IF ( xt(2).LT.Xmin(2) .OR. xt(2).GT.Xmax(2) ) GOTO 190 END IF iyi = iyoff0 + iyoff wtmp = WEIGHT(Y(iyi), Mxrow, Lery) IF ( wtmp.LE.0. ) GOTO 190 nfit=nfit+1 IF ( Isgood.EQ.0 ) Isgood=I Iegood=I 190 CONTINUE IF(nfit.LE.0) THEN WRITE(*,231) 231 FORMAT('FITIT--No points in allowed range.') RETURN END IF WRITE(*,251) nfit,Iegood-Isgood+1 251 FORMAT(' Fitting',I8,' points in a band of',I8,'.') Par(Nterm+2)=nfit WRITE(*,*) (Par(K),K=1,Nterm) C--- C Blast off CALL CURFIT(Y, Igroup, Iyoff0, Lery, Mxrow, Isgood, Iegood, : Xmin, Xmax, 1, Niter, Istat, Icomp, 1, Nterm, & 0.0, Par, Plim, Chi) C--- Par(Nterm+1)=Chi WRITE(*,*) (Par(K),K=1,Nterm) RETURN END fv5.5/tcltk/plt/gamma.f0000644000220700000360000002304013224715127013671 0ustar birbylheaC From Netlib http://www.netlib.org/specfun/index.html REAL FUNCTION GAMMA(X) C---------------------------------------------------------------------- C C This routine calculates the GAMMA function for a real argument X. C Computation is based on an algorithm outlined in reference 1. C The program uses rational functions that approximate the GAMMA C function to at least 20 significant decimal digits. Coefficients C for the approximation over the interval (1,2) are unpublished. C Those for the approximation for X .GE. 12 are from reference 2. C The accuracy achieved depends on the arithmetic system, the C compiler, the intrinsic functions, and proper selection of the C machine-dependent constants. C C C******************************************************************* C******************************************************************* C C Explanation of machine-dependent constants C C beta - radix for the floating-point representation C maxexp - the smallest positive power of beta that overflows C XBIG - the largest argument for which GAMMA(X) is representable C in the machine, i.e., the solution to the equation C GAMMA(XBIG) = beta**maxexp C XINF - the largest machine representable floating-point number; C approximately beta**maxexp C EPS - the smallest positive floating-point number such that C 1.0+EPS .GT. 1.0 C XMININ - the smallest positive floating-point number such that C 1/XMININ is machine representable C C Approximate values for some important machines are: C C beta maxexp XBIG C C CRAY-1 (S.P.) 2 8191 966.961 C Cyber 180/855 C under NOS (S.P.) 2 1070 177.803 C IEEE (IBM/XT, C SUN, etc.) (S.P.) 2 128 35.040 C IEEE (IBM/XT, C SUN, etc.) (D.P.) 2 1024 171.624 C IBM 3033 (D.P.) 16 63 57.574 C VAX D-Format (D.P.) 2 127 34.844 C VAX G-Format (D.P.) 2 1023 171.489 C C XINF EPS XMININ C C CRAY-1 (S.P.) 5.45E+2465 7.11E-15 1.84E-2466 C Cyber 180/855 C under NOS (S.P.) 1.26E+322 3.55E-15 3.14E-294 C IEEE (IBM/XT, C SUN, etc.) (S.P.) 3.40E+38 1.19E-7 1.18E-38 C IEEE (IBM/XT, C SUN, etc.) (D.P.) 1.79D+308 2.22D-16 2.23D-308 C IBM 3033 (D.P.) 7.23D+75 2.22D-16 1.39D-76 C VAX D-Format (D.P.) 1.70D+38 1.39D-17 5.88D-39 C VAX G-Format (D.P.) 8.98D+307 1.11D-16 1.12D-308 C C******************************************************************* C******************************************************************* C C Error returns C C The program returns the value XINF for singularities or C when overflow would occur. The computation is believed C to be free of underflow and overflow. C C C Intrinsic functions required are: C C INT, DBLE, EXP, LOG, REAL, SIN C C C References: "An Overview of Software Development for Special C Functions", W. J. Cody, Lecture Notes in Mathematics, C 506, Numerical Analysis Dundee, 1975, G. A. Watson C (ed.), Springer Verlag, Berlin, 1976. C C Computer Approximations, Hart, Et. Al., Wiley and C sons, New York, 1968. C C Latest modification: October 12, 1989 C C Authors: W. J. Cody and L. Stoltz C Applied Mathematics Division C Argonne National Laboratory C Argonne, IL 60439 C C---------------------------------------------------------------------- INTEGER I,N LOGICAL PARITY REAL 1 C,CONV,EPS,FACT,HALF,ONE,P,PI,Q,RES,SQRTPI,SUM,TWELVE, 2 TWO,X,XBIG,XDEN,XINF,XMININ,XNUM,Y,Y1,YSQ,Z,ZERO DIMENSION C(7),P(8),Q(8) C---------------------------------------------------------------------- C Mathematical constants C---------------------------------------------------------------------- DATA ONE,HALF,TWELVE,TWO,ZERO/1.0E0,0.5E0,12.0E0,2.0E0,0.0E0/, 1 SQRTPI/0.9189385332046727417803297E0/, 2 PI/3.1415926535897932384626434E0/ C---------------------------------------------------------------------- C Machine dependent parameters C---------------------------------------------------------------------- DATA XBIG,XMININ,EPS/35.040E0,1.18E-38,1.19E-7/, 1 XINF/3.4E38/ C---------------------------------------------------------------------- C Numerator and denominator coefficients for rational minimax C approximation over (1,2). C---------------------------------------------------------------------- DATA P/-1.71618513886549492533811E+0,2.47656508055759199108314E+1, 1 -3.79804256470945635097577E+2,6.29331155312818442661052E+2, 2 8.66966202790413211295064E+2,-3.14512729688483675254357E+4, 3 -3.61444134186911729807069E+4,6.64561438202405440627855E+4/ DATA Q/-3.08402300119738975254353E+1,3.15350626979604161529144E+2, 1 -1.01515636749021914166146E+3,-3.10777167157231109440444E+3, 2 2.25381184209801510330112E+4,4.75584627752788110767815E+3, 3 -1.34659959864969306392456E+5,-1.15132259675553483497211E+5/ C---------------------------------------------------------------------- C Coefficients for minimax approximation over (12, INF). C---------------------------------------------------------------------- DATA C/-1.910444077728E-03,8.4171387781295E-04, 1 -5.952379913043012E-04,7.93650793500350248E-04, 2 -2.777777777777681622553E-03,8.333333333333333331554247E-02, 3 5.7083835261E-03/ C---------------------------------------------------------------------- C Statement functions for conversion between integer and float C---------------------------------------------------------------------- CONV(I) = REAL(I) PARITY = .FALSE. FACT = ONE N = 0 Y = X IF (Y .LE. ZERO) THEN C---------------------------------------------------------------------- C Argument is negative C---------------------------------------------------------------------- Y = -X Y1 = AINT(Y) RES = Y - Y1 IF (RES .NE. ZERO) THEN IF (Y1 .NE. AINT(Y1*HALF)*TWO) PARITY = .TRUE. FACT = -PI / SIN(PI*RES) Y = Y + ONE ELSE RES = XINF GO TO 900 END IF END IF C---------------------------------------------------------------------- C Argument is positive C---------------------------------------------------------------------- IF (Y .LT. EPS) THEN C---------------------------------------------------------------------- C Argument .LT. EPS C---------------------------------------------------------------------- IF (Y .GE. XMININ) THEN RES = ONE / Y ELSE RES = XINF GO TO 900 END IF ELSE IF (Y .LT. TWELVE) THEN Y1 = Y IF (Y .LT. ONE) THEN C---------------------------------------------------------------------- C 0.0 .LT. argument .LT. 1.0 C---------------------------------------------------------------------- Z = Y Y = Y + ONE ELSE C---------------------------------------------------------------------- C 1.0 .LT. argument .LT. 12.0, reduce argument if necessary C---------------------------------------------------------------------- N = INT(Y) - 1 Y = Y - CONV(N) Z = Y - ONE END IF C---------------------------------------------------------------------- C Evaluate approximation for 1.0 .LT. argument .LT. 2.0 C---------------------------------------------------------------------- XNUM = ZERO XDEN = ONE DO 260 I = 1, 8 XNUM = (XNUM + P(I)) * Z XDEN = XDEN * Z + Q(I) 260 CONTINUE RES = XNUM / XDEN + ONE IF (Y1 .LT. Y) THEN C---------------------------------------------------------------------- C Adjust result for case 0.0 .LT. argument .LT. 1.0 C---------------------------------------------------------------------- RES = RES / Y1 ELSE IF (Y1 .GT. Y) THEN C---------------------------------------------------------------------- C Adjust result for case 2.0 .LT. argument .LT. 12.0 C---------------------------------------------------------------------- DO 290 I = 1, N RES = RES * Y Y = Y + ONE 290 CONTINUE END IF ELSE C---------------------------------------------------------------------- C Evaluate for argument .GE. 12.0, C---------------------------------------------------------------------- IF (Y .LE. XBIG) THEN YSQ = Y * Y SUM = C(7) DO 350 I = 1, 6 SUM = SUM / YSQ + C(I) 350 CONTINUE SUM = SUM/Y - Y + SQRTPI SUM = SUM + (Y-HALF)*LOG(Y) RES = EXP(SUM) ELSE RES = XINF GO TO 900 END IF END IF C---------------------------------------------------------------------- C Final adjustments and return C---------------------------------------------------------------------- IF (PARITY) RES = -RES IF (FACT .NE. ONE) RES = FACT / RES 900 GAMMA = RES RETURN C ---------- Last line of GAMMA ---------- END fv5.5/tcltk/plt/gthelp.f0000644000220700000360000000165413224715127014101 0ustar birbylhea SUBROUTINE GTHELP(Clib, Ctopic) CHARACTER Clib*(*), Ctopic*(*) C--- C Display the help text from the Clib help library on topic Ctopic. C--- C Clib I Location of help libary. C Ctopic I The topic of interest. C--- C 2002-May-24 - New routine [AFT] C---- INTEGER LENACT C INTEGER ier, itmp, llib C CHARACTER chelp*256 SAVE chelp INTEGER ifirst, lhelp SAVE ifirst, lhelp DATA ifirst/1/, lhelp/0/ C IF ( ifirst.NE.0 ) THEN CALL TRLOG('XANHTML',7,chelp,lhelp) IF ( lhelp.LE.0 ) THEN CALL PTBUF('Problem with setup, Variable XANHTML is not '// & 'defined.',0) RETURN END IF END IF llib = LENACT(Clib) chelp(lhelp+1:) = ' '//Clib(:llib)//'/index.html &' itmp = LENACT(chelp) WRITE(*,*) 'chelp=',chelp(:itmp) CALL SPAWN(chelp, itmp, ier) RETURN END fv5.5/tcltk/plt/hdecod.f0000644000220700000360000000224613224715127014042 0ustar birbylhea SUBROUTINE hdecod(Cbuf, Lbuf) CHARACTER Cbuf*(*) INTEGER Lbuf C--- C Web browsers encode data sending back to the server. This routine C effectively decodes by converting C C 1) "+" symbols back to spaces, C 2) and hex codes (%xx) back to the original characters. C--- C Cbuf I/O Buffer C Lbuf I/O Active length C--- C 1999-Apr-20 - [AFT] C--- INTEGER i, ihex, itmp, lout C--- lout = 0 i = 1 110 CONTINUE IF ( Cbuf(i:i).EQ.'+' ) THEN C Turn + signs into spaces lout = lout + 1 Cbuf(lout:lout) = ' ' ELSE IF ( Cbuf(i:i).EQ.'%' ) THEN C Decode the HEX strings i = i + 1 ihex = ICHAR(Cbuf(i:i)) - ICHAR('0') IF ( ihex.GT.9 ) ihex = ihex - 7 i = i + 1 itmp = ICHAR(Cbuf(i:i)) - ICHAR('0') IF ( itmp.GT.9 ) itmp = itmp - 7 lout = lout + 1 Cbuf(lout:lout) = CHAR(ihex*16+itmp) ELSE C Just copy the original character lout = lout + 1 Cbuf(lout:lout) = Cbuf(i:i) END IF i = i + 1 IF ( i.LE.Lbuf ) GOTO 110 C--- Lbuf = lout RETURN END fv5.5/tcltk/plt/ifgrp.f0000644000220700000360000000055413224715127013723 0ustar birbylhea INTEGER FUNCTION IFGRP(IWIN, MXGRP, IWNUM) INTEGER IWIN(*), MXGRP, IWNUM C--- C Find the first group to be plotted in the current window C--- INTEGER IGROUP C--- DO 190 IGROUP=1,MXGRP IF(IWIN(IGROUP).EQ.IWNUM) THEN IFGRP=IGROUP RETURN END IF 190 CONTINUE IFGRP=0 RETURN END fv5.5/tcltk/plt/isact.f0000644000220700000360000000125013224715127013711 0ustar birbylhea INTEGER FUNCTION ISACT(IWIN, NGROUP, ICONT, ICWIN) INTEGER IWIN(*), NGROUP, ICONT, ICWIN C--- C Runs throught the IWIN array and returns 1 if ICWIN is currently C active, and 0 otherwise C--- C IWIN I Contains window that each group is to be plotted in C NGROUP I The number of groups C ICWIN I The current window C--- C 1990-Jun-12 C--- INTEGER I C--- C Activate windows that contain data DO 150 I=1,NGROUP IF(IWIN(I).EQ.ICWIN) THEN ISACT=1 RETURN END IF 150 CONTINUE IF(ICONT.NE.0 .AND. ICWIN.EQ.1) THEN ISACT=1 ELSE ISACT=0 END IF RETURN END fv5.5/tcltk/plt/moment.f0000644000220700000360000001277213224715127014120 0ustar birbylhea SUBROUTINE MOMENT(Iprnt, Y, Iery, Mxrow, Igroup, Iy0, : Npts, Pmin, Pmax, Tot, Ier) INTEGER Iprnt, Iery, Mxrow, Igroup, Iy0, Npts, Ier REAL Pmin(*), Pmax(*), Y(*), Tot(14) C--- C Computes moments of array Y. Makes two passes through the data C to generate accurate results. C--- C Tot( 1) O Sum of 1 =Npts C Tot( 2) O Average Y =YBAR C Tot( 3) O Sum of (Y-YBAR)**2 =(Npts-1)*VAR(Y) C Tot( 4) O Sum of (Y-YBAR)**3 =(Npts-1)*SKEW(Y) C Tot( 5) O Average X =XBAR C Tot( 6) O Sum of (X-XBAR)**2 =(Npts-1)*VAR(X) C Tot( 7) O Sum of (X-XBAR)*(Y-YBAR) C Tot( 8.. 9) O YMIN, YMAX C Tot(10..13) O Sum of W, W*Y, W*Y*Y, W*Y*Y*Y C Tot(14) O Sum of Y*XDEL (i.e., the integral) C--- INTEGER MXDIM PARAMETER (MXDIM=2) REAL NO PARAMETER (NO=-1.2E-34) REAL WEIGHT C--- CHARACTER cbuf*80 DOUBLE PRECISION dyint, sumx, sumx2, sumxy DOUBLE PRECISION sumwy, sumwy2, sumwy3, sumw DOUBLE PRECISION sumy, sumy2, sumy3 DOUBLE PRECISION dxbar, dybar, dwybar REAL ym(6), xc(MXDIM) REAL FRAC, xdel, TMP, XT, xm, ydel, YMAX, YMIN, xp REAL YT, y2, y3, W INTEGER I, ipxer, itmp, iyi, iyoff, K, N, ndim C--- C C Query the X error plotting status CALL PLTXCQ(Igroup, 1, ipxer) C We use the X error to integrate, so make sure it will be returned. CALL PLTXCP(Igroup, 1, 1) DO I=1,6 ym(I)=0. END DO N=0 sumy =0. sumx =0. YMIN= 1.E37 YMAX=-1.E37 sumw =0. sumwy =0. dyint =0. CALL PLTXCC(Y, 1, Igroup, xc, ndim, iyoff) IF ( ndim.LE.1 ) THEN ydel = 1.0 ELSE C First we check the y-delta which is only used if we have a 2D group. CALL PLTXCQ(Igroup, 2, itmp) CALL PLTXCP(Igroup, 2, 1) CALL PLTXCE(Y, 1, Igroup, 2, xm, xp) ydel = xp - xm CALL PLTXCP(Igroup, 2, itmp) END IF DO 150 I=1, Npts CALL PLTXCC(Y, i, igroup, xc, ndim, iyoff) IF ( xc(1).EQ.NO ) GOTO 150 iyi = Iy0 + iyoff IF ( xc(1).LT.Pmin(1) .OR. xc(1).GT.Pmax(1) ) GOTO 150 C If ndim.LE.1 then xc(2), pmin(2), pmax(2) are all undefined, so C make sure they are not evaluted. IF ( ndim.GT.1 ) THEN IF ( xc(2).LT.Pmin(2) .OR. xc(2).GT.Pmax(2) ) GOTO 150 END IF W=WEIGHT(Y(iyi),Mxrow,Iery) IF(W.GT.0.) THEN N =N+1 sumy =sumy+Y(iyi) sumx =sumx+xc(1) YMIN =MIN(YMIN,Y(iyi)) YMAX =MAX(YMAX,Y(iyi)) sumw =sumw +W sumwy=sumwy+W*Y(iyi) CALL PLTXCE(Y, i, igroup, 1, xm, xp) xdel = xp - xm dyint=dyint+Y(iyi)*XDEL*ydel END IF 150 CONTINUE IF ( N.LE.0 ) THEN CALL PTBUF('ERROR--MOMENT no data.',-1) Ier=2 RETURN END IF dybar =sumy/N dxbar =sumx/N dwybar=sumwy/sumw C--- sumy2=0. sumy3=0. sumx2=0. sumxy=0. sumwy2=0. sumwy3=0. DO 190 I=1,Npts CALL PLTXCC(Y, i, igroup, xc, ndim, iyoff) IF ( xc(1).EQ.NO ) GOTO 190 iyi = iy0 + iyoff IF ( xc(1).LT.Pmin(1) .OR. xc(1).GT.Pmax(1) ) GOTO 190 IF ( ndim.GT.1 ) THEN IF ( xc(2).LT.Pmin(2) .OR. xc(2).GT.Pmax(2) ) GOTO 190 END IF W=WEIGHT(Y(iyi),Mxrow,Iery) IF ( W.GT.0. ) THEN XT=xc(1)-dxbar YT=Y(iyi)-dybar Y2=YT*YT Y3=Y2*YT sumy2 =sumy2 +Y2 sumy3 =sumy3 +Y3 sumx2 =sumx2 +XT*XT sumxy =sumxy +XT*YT YT=Y(iyi)-dwybar Y2=YT*YT Y3=Y2*YT sumwy2=sumwy2+W*Y2 sumwy3=sumwy3+W*Y3 END IF 190 CONTINUE Tot( 1) = N Tot( 2) = dybar Tot( 3) = sumy2 Tot( 4) = sumy3 Tot( 5) = dxbar Tot( 6) = sumx2 Tot( 7) = sumxy Tot( 8) = YMIN Tot( 9) = YMAX Tot(10) = sumw Tot(11) = dwybar Tot(12) = sumwy2 Tot(13) = sumwy3 Tot(14) = dyint IF(N.LE.1) THEN CALL PTBUF('MOMENT--Not enough data.',-1) Ier=1 RETURN END IF dybar=sumy/N FRAC=N/(N-1.) ym(1)=Tot(2) ym(2)=Tot(3)/(N-1.) ym(3)=Tot(4)/(N-1.) dwybar=sumwy/sumw ym(4)=Tot(11) ym(5)=FRAC*Tot(12)/sumw ym(6)=FRAC*Tot(13)/sumw IF(Iprnt.NE.0) THEN WRITE(cbuf,351) 351 FORMAT(' \ YBAR',8X,'YVAR',8X,'Y3M',9X,'SUMW',8X, & 'YMIN',8X,'YMAX') CALL PTBUF(cbuf, -1) WRITE(cbuf,361) 'UNWTD',(ym(K),K=1,3),FLOAT(N),YMIN,YMAX 361 FORMAT(A6,1P,4G12.4,2G12.4) CALL PTBUF(cbuf, -1) IF(Iery.NE.0) THEN C If we have errors, print out the weighted values, plus CHI^2 which C is effectively the weighted variance. WRITE(cbuf,361) ' WTD',(ym(K),K=4,6),sumw CALL PTBUF(cbuf, -1) IF(N.GT.1) THEN TMP=Tot(12)/(N-1.) IF(TMP.LT.9999.9) THEN WRITE(cbuf,381) Tot(12),TMP 381 FORMAT(' WCHI=',1PG11.3,', WRED=',0PF9.3) CALL PTBUF(cbuf, -1) ELSE WRITE(cbuf,391) Tot(12),TMP 391 FORMAT(' WCHI=',1PG11.3,', WRED=',G11.3) CALL PTBUF(cbuf, -1) END IF END IF END IF END IF CALL PLTXCP(Igroup, 1, ipxer) RETURN END fv5.5/tcltk/plt/pgdev.f0000644000220700000360000000221213224715127013712 0ustar birbylheac c pgdev -- set output device c subroutine pgdev(file) implicit none character*(*) file integer LR,LDEV,LF integer ier character*256 req,device integer lenact call pgqinf ('DEVICE',device,ldev) if ( device(1:1).eq.'?' ) then device = ' ' ldev = 0 endif if (file(1:1) .eq. '?') then if (ldev .le. 0) then call pgldev 10 call xcread('Graphics device/type (? to see list): ', req, & ier) lr = LENACT(req) if (ier .ne. 0) & call xwrite(' error reading device specification',5) if (lr .lt. 1) goto 10 if (req(1:1) .eq. '?') then call pgldev goto 10 end if call setenv (req) end if else if (file(1:1) .eq. '!') then call pgldev else lf=index(file,' ')-1 if (lf .eq. -1) lf=lenact(file) call setenv(file) end if return end fv5.5/tcltk/plt/pgplot.f0000644000220700000360000002731713224715127014127 0ustar birbylheaC- PGPLOT. Contains device dependent routines. C- This version drives PGPLOT routines. C********* SUBROUTINE PLTCLR C--- C Clear workstation. C--- CALL PGADVANCE RETURN END C********* SUBROUTINE PLTCS(SCHAR) REAL SCHAR C--- C Set character size. Default size is 1.0. C--- REAL VXMIN,VXMAX,VYMIN,VYMAX REAL WXMIN,WXMAX,WYMIN,WYMAX,SIZCHR INTEGER MARK COMMON /PLTCMN/ VXMIN,VXMAX,VYMIN,VYMAX, : WXMIN,WXMAX,WYMIN,WYMAX,SIZCHR,MARK C--- CALL PGSCH(SCHAR) SIZCHR=SCHAR RETURN END C********** SUBROUTINE PLTFON(CBUF) CHARACTER CBUF*(*) C--- C Set default font. If CBUF(1:1) is not a legal font character, C then display possible fonts on terminal. C--- CALL UPC(CBUF(1:1)) IF(CBUF(1:1).EQ.'N') THEN CALL PGSCF(1) ELSE IF(CBUF(1:1).EQ.'R') THEN CALL PGSCF(2) ELSE IF(CBUF(1:1).EQ.'I') THEN CALL PGSCF(3) ELSE IF(CBUF(1:1).EQ.'S') THEN CALL PGSCF(4) ELSE WRITE(*,101) 101 FORMAT(' Legal fonts are: Normal, Roman, Italic, Script') RETURN END IF RETURN END C********** SUBROUTINE PLTHAR(CDEV) CHARACTER CDEV*(*) C--- C Returns the name of a hardcopy device C--- INTEGER LDEV C--- CALL TRLOG('PLT_HARDCOPY',12,CDEV,LDEV) IF(LDEV.EQ.0) CDEV='/PS' RETURN END C********* SUBROUTINE PLTMAR C--- C Based on PGEX8. Show the user the standard PGPLOT marker types. C--- CHARACTER LABEL*2 REAL xzero(1), yzero(1) REAL X, X1, X2, XOFF, Y, Y1, Y2, YOFF, DX, DY INTEGER NX, NY, N, IX, JY, icisav DATA xzero,yzero/0.0,0.0/ C--- CALL PGQCI(icisav) CALL PGVPORT(0.0, 1.0, 0.0, 1.0) CALL PGQVP(1, X1, X2, Y1, Y2) X = X2-X1 Y = Y2-Y1 C NX = 8 NY = 4 DX = MIN(X/NX, 0.95*Y/NY) DY = DX IX = NX JY = 1 XOFF = X1 + (X-NX*DX)*0.5 YOFF = Y1 + (0.95*Y-NY*DY)*0.5 CALL PGBBUF CALL PGSCI(1) C C Each symbol will be drawn in a standard window; the window is moved C by manipulating the viewport. C CALL PGWINDOW(-1.,1.,-1.,1.) C C Loop through all known symbols (N=0-31). C DO N=0,31 WRITE (LABEL,'(I2)') N C C Define window and viewport. The loop allows the plot to extend over C more than one page if necessary; each page is labelled at the top. C IX = IX+1 IF (IX.GT.NX) THEN IX = 1 JY = JY-1 END IF IF (JY.LT.1) THEN JY = NY CALL PLTCLR CALL PGSCH(1.2) CALL PGVSIZE(XOFF, XOFF+NX*DX, YOFF, YOFF+NY*DY) CALL PGMTEXT('T', 1.0, 0.5, 0.5, 'PGPLOT Marker Symbols') END IF CALL PGVSIZE(XOFF+(IX-1)*DX, XOFF+IX*DX, 1 YOFF+(JY-1)*DY, YOFF+JY*DY) C C Call PGBOX to draw a box and PGMTEXT to label it. C CALL PGBOX('BC',10.0,0,'BC',10.0,0) CALL PGSCH(1.0) CALL PGMTEXT('T',-1.5,0.05,0.0,LABEL) C C Call PGPOINT to draw the symbol. C CALL PGSCH(1.5) C NAG compiler likes args 2 and 3 to be consistent, i.e., an array. CALL PGPOINT(1,xzero,yzero,N) END DO C CALL PGEBUF CALL PGSCI(icisav) RETURN END C********* SUBROUTINE PLTOPE(Cdev, Ibcol, Scrcol, Cfont, Pgpapw, Pgpapa, Ier) CHARACTER Cdev*(*), Cfont*(*) INTEGER Ibcol, Ier REAL Scrcol(3,0:15), Pgpapw, Pgpapa C--- C Open workstation. C--- C Cdev I C Ibcol I C Scrcol I C Cfont I C Pgpapw I C Pgpapa I C Ier O C--- REAL NO PARAMETER (NO = -1.2E-34) INTEGER PGBEG C INTEGER i C--- IF(PGBEG(0,Cdev,1,1).NE.1) GOTO 900 CALL PGASK(.FALSE.) IF(CFONT.NE.' ') CALL PLTFON(CFONT) IF ( PGPAPW.GT.0.0 ) THEN CALL PGPAP(Pgpapw/2.54,Pgpapa) END IF CALL PLTOP1(ibcol) DO i=0,15 IF ( Scrcol(1,i).NE.NO ) THEN CALL PGSCR(i,Scrcol(1,i),Scrcol(2,i),Scrcol(3,i)) END IF END DO Ier = 0 RETURN C--- 900 IER=1 RETURN END C********* SUBROUTINE PLTOP1(ibcol) INTEGER ibcol C--- C This routine should only be called if plot device is open. C Allows user to specify black or white to be the default background color. C--- C ibcol I =0 ignore, <0 black background, >0 white background C--- IF ( ibcol.LT.0 ) THEN C Force black background CALL PGSCR(0,0.0,0.0,0.0) CALL PGSCR(1,1.0,1.0,1.0) CALL PGUPDT ELSE IF ( ibcol.GT.0 ) THEN C Force white background CALL PGSCR(0,1.0,1.0,1.0) CALL PGSCR(1,0.0,0.0,0.0) CALL PGUPDT END IF RETURN END C********* SUBROUTINE PLTPM(NUM, XRAY, YRAY) INTEGER NUM REAL XRAY(1),YRAY(1) C--- C Plot Polymarker. C--- REAL VXMIN,VXMAX,VYMIN,VYMAX REAL WXMIN,WXMAX,WYMIN,WYMAX,SIZCHR INTEGER MARK COMMON /PLTCMN/ VXMIN,VXMAX,VYMIN,VYMAX, : WXMIN,WXMAX,WYMIN,WYMAX,SIZCHR,MARK C--- CALL PGPOINT(NUM,XRAY,YRAY,MARK) RETURN END C********* SUBROUTINE PLTPRO(CPFILE, IER) CHARACTER CPFILE*(*) INTEGER IER, LPFILE C--- C Prompt for PGPLOT device name. C--- 100 CALL GTBUF('PGPLOT file/type:',IER) IF(IER.LT.0) GOTO 900 CALL GTREST(CPFILE, LPFILE) IF(CPFILE(1:1).EQ.'?') THEN CALL PGLDEV GOTO 100 END IF IER=0 RETURN C--- 900 IER=-1 RETURN END C********* SUBROUTINE PLTSCI(ICOL) INTEGER ICOL C--- C Set color index. 0=background, 1=foreground C--- IF(ICOL.LT.0) THEN WRITE(*,101) 101 FORMAT(' PGPLOT colors are:'/ : ' 0=Backg, 1=Foreg, 2=Red, 3=Green,'/ : ' 4=Blue, 5=Light blue, 6=Magenta, 7=Yellow,'/ : ' 8=Orange, 9=Yel.+Green, 10=Green+Cyan, 11=Blue+Cyan,'/ : ' 12=Blue+Mag, 13=Red+Mag, 14=Dark Grey, 15=Light Grey') RETURN ELSE CALL PGSCI(ICOL) END IF RETURN END C********* SUBROUTINE PLTSLS(LS) INTEGER LS C--- C Set line style. C--- INTEGER ITMP C--- IF(LS.LT.0) THEN WRITE(*,101) 101 FORMAT(' PGPLOT line styles are:'/ : ' 1=Solid, 2=Dash, 3=Dash-dot, 4=Dot, 5=Dash-dot-dot-dot') ELSE ITMP=MOD(LS-1,5)+1 CALL PGSLS(ITMP) END IF RETURN END C********* SUBROUTINE PLTSLW(WIDTH) REAL WIDTH C--- C Set line width. C--- CALL PGSLW(NINT(WIDTH)) RETURN END C********* SUBROUTINE PLTSMK(IMARK) INTEGER IMARK C--- C Set marker type. C--- REAL VXMIN,VXMAX,VYMIN,VYMAX REAL WXMIN,WXMAX,WYMIN,WYMAX,SIZCHR INTEGER MARK COMMON /PLTCMN/ VXMIN,VXMAX,VYMIN,VYMAX, : WXMIN,WXMAX,WYMIN,WYMAX,SIZCHR,MARK C--- MARK=IMARK RETURN END C********* SUBROUTINE PLTTEX(X1, Y1, ANGLE, IJUS, LOC, CTEXT) REAL X1, Y1, ANGLE INTEGER IJUS, LOC CHARACTER CTEXT*(*) C--- C X1, Y1 I Location of text in window coordinates C ANGLE I Angle of text in degrees from X-axis C IJUS I =1 X1,Y1 is left of string C =2 X1,Y1 is in center of string C =3 X1,Y1 is right of string C LOC I =1 X1,Y1 is at Top of text. C =2 X1,Y1 is at Cap of text. C =3 X1,Y1 is at Half of text. C =4 X1,Y1 is at Base of text. C =5 X1,Y1 is at Bottom of text. C CTEXT I The text string C--- REAL FJUST(3), VOFF(5), YC REAL VXMIN,VXMAX,VYMIN,VYMAX REAL WXMIN,WXMAX,WYMIN,WYMAX,SIZCHR INTEGER MARK COMMON /PLTCMN/ VXMIN,VXMAX,VYMIN,VYMAX, : WXMIN,WXMAX,WYMIN,WYMAX,SIZCHR,MARK DATA FJUST/0.0,0.5,1.0/ DATA VOFF/-0.020,-0.012,-0.008,0,+.006/ C--- YC=Y1+VOFF(LOC)*SIZCHR*(WYMAX-WYMIN)/(VYMAX-VYMIN) CALL PGPTEXT(X1,YC,ANGLE,FJUST(IJUS),CTEXT) RETURN END C********* SUBROUTINE PLTVTW(VX, VY, WX, WY) REAL VX, VY, WX, WY C--- C Convert viewport coordinates to window coordinates C--- REAL VXMIN,VXMAX,VYMIN,VYMAX REAL WXMIN,WXMAX,WYMIN,WYMAX,SIZCHR INTEGER MARK COMMON /PLTCMN/ VXMIN,VXMAX,VYMIN,VYMAX, : WXMIN,WXMAX,WYMIN,WYMAX,SIZCHR,MARK C--- WX=WXMIN+(VX-VXMIN)*(WXMAX-WXMIN)/(VXMAX-VXMIN) WY=WYMIN+(VY-VYMIN)*(WYMAX-WYMIN)/(VYMAX-VYMIN) RETURN END C********* SUBROUTINE PLTWTV(WX, WY, VX, VY) REAL WX, WY, VX, VY C--- C Convert window coordinates to viewport coordinates C--- REAL VXMIN,VXMAX,VYMIN,VYMAX REAL WXMIN,WXMAX,WYMIN,WYMAX,SIZCHR INTEGER MARK COMMON /PLTCMN/ VXMIN,VXMAX,VYMIN,VYMAX, : WXMIN,WXMAX,WYMIN,WYMAX,SIZCHR,MARK C--- VX=VXMIN+(WX-WXMIN)*(VXMAX-VXMIN)/(WXMAX-WXMIN) VY=VYMIN+(WY-WYMIN)*(VYMAX-VYMIN)/(WYMAX-WYMIN) RETURN END C********* SUBROUTINE PLTSVW(BOXVP, WINLOC, XYSCAL, LOGX, LOGY, IADJ, IWNUM) REAL BOXVP(4,*), WINLOC(4,*), XYSCAL(4,*) INTEGER IWNUM, LOGX(*), LOGY(*), IADJ(*) C--- C Set both viewport and window scale for the current window number. If C a window adjustment occurs, then on return BOXVP reflects the new value. C If IWNUM=0 then the full screen is used and window adjustment is ignored. C--- C BOXVP I/O Size of box in viewport coordinates C WINLOC I Location of selected window in device independent coordinates C XYSCAL I World coordinates for box C LOGX I <>0 for Log scale on X-axis C LOGY I <>0 for Log scale on Y-axis C IADJ I <>0 to call PGWNAD C IWNUM I Window number C--- C- The minimum number that can be LOG'ed. REAL RMNLOG PARAMETER (RMNLOG=1.E-36) C REAL TMP C REAL VXMIN,VXMAX,VYMIN,VYMAX REAL WXMIN,WXMAX,WYMIN,WYMAX,SIZCHR INTEGER MARK COMMON /PLTCMN/ VXMIN,VXMAX,VYMIN,VYMAX, : WXMIN,WXMAX,WYMIN,WYMAX,SIZCHR,MARK C--- IF(IWNUM.LE.0) THEN VXMIN=0. VXMAX=1. VYMIN=0. VYMAX=1. ELSE TMP=WINLOC(3,IWNUM)-WINLOC(1,IWNUM) VXMIN=WINLOC(1,IWNUM)+TMP*BOXVP(1,IWNUM) VXMAX=WINLOC(1,IWNUM)+TMP*BOXVP(3,IWNUM) TMP=WINLOC(4,IWNUM)-WINLOC(2,IWNUM) VYMIN=WINLOC(2,IWNUM)+TMP*BOXVP(2,IWNUM) VYMAX=WINLOC(2,IWNUM)+TMP*BOXVP(4,IWNUM) END IF CALL PGVPORT( VXMIN, VXMAX, VYMIN, VYMAX) C--- IF(IWNUM.LE.0) THEN WXMIN=0. WXMAX=1. WYMIN=0. WYMAX=1. ELSE WXMIN=XYSCAL(1,IWNUM) WYMIN=XYSCAL(2,IWNUM) WXMAX=XYSCAL(3,IWNUM) WYMAX=XYSCAL(4,IWNUM) IF(LOGX(IWNUM).NE.0) THEN WXMIN=LOG10(MAX(WXMIN,RMNLOG)) WXMAX=LOG10(MAX(WXMAX,RMNLOG)) END IF IF(LOGY(IWNUM).NE.0) THEN WYMIN=LOG10(MAX(WYMIN,RMNLOG)) WYMAX=LOG10(MAX(WYMAX,RMNLOG)) END IF END IF IF((WXMIN.NE.WXMAX) .AND. (WYMIN.NE.WYMAX)) THEN IF ( iwnum.EQ.0 .OR. Iadj(iwnum).EQ.0 ) THEN CALL PGWINDOW(WXMIN,WXMAX,WYMIN,WYMAX) ELSE C Do window adjust, and reset BOXVP to be correct value. CALL PGWNAD(WXMIN,WXMAX,WYMIN,WYMAX) CALL PGQVP(0, VXMIN, VXMAX, VYMIN, VYMAX) TMP=WINLOC(3,IWNUM)-WINLOC(1,IWNUM) BOXVP(1,IWNUM) = (VXMIN-WINLOC(1,IWNUM))/TMP BOXVP(3,IWNUM) = (VXMAX-WINLOC(1,IWNUM))/TMP TMP=WINLOC(4,IWNUM)-WINLOC(2,IWNUM) BOXVP(2,IWNUM) = (VYMIN-WINLOC(2,IWNUM))/TMP BOXVP(4,IWNUM) = (VYMAX-WINLOC(2,IWNUM))/TMP END IF ELSE WRITE(*,*) 'ERROR, Bad window size',WXMIN,WXMAX,WYMIN,WYMAX WRITE(*,*) '- IWNUM=',IWNUM END IF RETURN END fv5.5/tcltk/plt/plconb.f0000644000220700000360000001661413224715127014075 0ustar birbylheaC*PLCONB -- contour map of a 2D data array, with blanking C+ SUBROUTINE PLCONB (Yray, IDIM, JDIM, I1, I2, J1, J2, 1 C, Mxlev, TR, BLANK, Nrow, Itype, Iftg, 2 Icomp, Pval, Nterm, 3 Icocon, Ilscon, Rlwcon ) INTEGER IDIM, JDIM, I1, I2, J1, J2, Mxlev INTEGER Nrow, Itype, Iftg, Icomp(*), Nterm INTEGER Icocon(*), Ilscon(*) REAL Yray(IDIM,JDIM), C(*), TR(6), BLANK, Pval(*) REAL Rlwcon(*) C C Draw a contour map of an array. This routine is the same as PGCONS, C except that array elements that have the "magic value" defined by C argument BLANK are ignored, making gaps in the contour map. The C routine may be useful for data measured on most but not all of the C points of a grid. C C Arguments: C IDIM (input) : first dimension of A. C JDIM (input) : second dimension of A. C I1,I2 (input) : range of first index to be contoured (inclusive). C J1,J2 (input) : range of second index to be contoured (inclusive). C C (input) : array of contour levels (in the same units as the C data in array A); dimension at least NC. C NC (input) : number of contour levels (less than or equal to C dimension of C). The absolute value of this C argument is used (for compatibility with PGCONT, C where the sign of NC is significant). C TR (input) : array defining a transformation between the I,J C grid of the array and the world coordinates. The C world coordinates of the array point A(I,J) are C given by: C X = TR(1) + TR(2)*I + TR(3)*J C Y = TR(4) + TR(5)*I + TR(6)*J C Usually TR(3) and TR(5) are zero - unless the C coordinate transformation involves a rotation C or shear. C BLANK (input) : elements of array A that are exactly equal to C this value are ignored (blanked). C-- C 1998-10-19 - Extracted from PGCONB [AFT]. C 21-Sep-1989 - Derived from PGCONS [TJP]. C----------------------------------------------------------------------- REAL FNFIT INTEGER MXDIM PARAMETER (MXDIM=2) C INTEGER I, IC, ICORN, IDELT(6), iyoff, J, K, nc, NPT INTEGER IOFF(8), JOFF(8), IENC, ITMP, JTMP, ILO, ITOT INTEGER inew, ndim LOGICAL PGNOTO REAL CTR, DELTA, DVAL(5), XX, YY, X(4), XT(MXDIM), Y(4) REAL atmp INTRINSIC ABS DATA IDELT/0,-1,-1,0,0,-1/ DATA IOFF/-2,-2,-1,-1, 0, 0, 1, 1/ DATA JOFF/ 0,-1,-2, 1,-2, 1,-1, 0/ C C Check arguments. C IF (PGNOTO('PLCONB')) RETURN IF (I1.LT.1 .OR. I2.GT.IDIM .OR. I1.GE.I2 .OR. 1 J1.LT.1 .OR. J2.GT.JDIM .OR. J1.GE.J2) RETURN C DO I = 1,Mxlev IF ( C(I).EQ.Blank ) THEN nc = i-1 GOTO 105 END IF END DO nc = Mxlev 105 CONTINUE IF (NC.EQ.0) RETURN CALL PGBBUF C DO 130 J=J1+1,J2 DO 130 I=I1+1,I2 IF ( Itype.EQ.0 ) THEN DVAL(1) = Yray(I-1,J) DVAL(2) = Yray(I-1,J-1) DVAL(3) = Yray(I,J-1) DVAL(4) = Yray(I,J) DVAL(5) = DVAL(1) ELSE IF ( Itype.GT.0 ) THEN CALL PLTXCC(Yray, (j-1)*Nrow+i-1, iftg, xt, ndim, iyoff) DVAL(1) = FNFIT(xt, Icomp, Pval, Nterm) CALL PLTXCC(Yray, (j-2)*Nrow+i-1, iftg, xt, ndim, iyoff) DVAL(2) = FNFIT(xt, Icomp, Pval, Nterm) CALL PLTXCC(Yray, (j-2)*Nrow+i, iftg, xt, ndim, iyoff) DVAL(3) = FNFIT(xt, Icomp, Pval, Nterm) CALL PLTXCC(Yray, (j-1)*Nrow+i, iftg, xt, ndim, iyoff) DVAL(4) = FNFIT(xt, Icomp, Pval, Nterm) DVAL(5) = DVAL(1) ELSE CALL PLTXCC(Yray, (j-1)*Nrow+i-1, iftg, xt, ndim, iyoff) DVAL(1) = Yray(I-1,J) - FNFIT(xt, Icomp, Pval, Nterm) CALL PLTXCC(Yray, (j-2)*Nrow+i-1, iftg, xt, ndim, iyoff) DVAL(2) = Yray(I-1,J-1) - FNFIT(xt, Icomp, Pval, Nterm) CALL PLTXCC(Yray, (j-2)*Nrow+i, iftg, xt, ndim, iyoff) DVAL(3) = Yray(I,J-1) - FNFIT(xt, Icomp, Pval, Nterm) CALL PLTXCC(Yray, (j-1)*Nrow+i, iftg, xt, ndim, iyoff) DVAL(4) = Yray(I,J) - FNFIT(xt, Icomp, Pval, Nterm) DVAL(5) = DVAL(1) END IF C IF (DVAL(1).EQ.BLANK .OR. DVAL(2).EQ.BLANK .OR. 1 DVAL(3).EQ.BLANK .OR. DVAL(4).EQ.BLANK) GOTO 130 DO 110 IC=1,ABS(NC) inew = 1 CTR = C(IC) NPT = 0 DO 120 ICORN=1,4 IF( (DVAL(ICORN).LT.CTR .AND. DVAL(ICORN+1).LT.CTR) 1 .OR.(DVAL(ICORN).GE.CTR .AND. DVAL(ICORN+1).GE.CTR) ) GOTO 120 IF ( inew.NE.0 ) THEN CALL PLTSCI(icocon(IC)) CALL PLTSLS(ilscon(ic)) CALL PLTSLW(rlwcon(IC)) inew = 0 END IF NPT=NPT+1 DELTA = (CTR-DVAL(ICORN))/(DVAL(ICORN+1)-DVAL(ICORN)) GOTO (60,70,60,70), ICORN C 60 XX = I+IDELT(ICORN+1) YY = REAL(J+IDELT(ICORN)) + 1 DELTA*REAL(IDELT(ICORN+1)-IDELT(ICORN)) GOTO 80 C 70 XX = REAL(I+IDELT(ICORN+1)) + 1 DELTA*REAL(IDELT(ICORN+2)-IDELT(ICORN+1)) YY = J+IDELT(ICORN) C 80 X(NPT) = TR(1) + TR(2)*XX + TR(3)*YY Y(NPT) = TR(4) + TR(5)*XX + TR(6)*YY C 120 CONTINUE IF (NPT.EQ.2) THEN C -- Contour crosses two sides of cell. Draw line-segment. CALL PGMOVE(X(1),Y(1)) CALL PGDRAW(X(2),Y(2)) ELSE IF (NPT.EQ.4) THEN C -- The 'ambiguous' case. The routine must draw two line C segments here and there are two ways to do so. The C following 4 lines would implement the original PGPLOT C method: C CALL PGCP(0,X(1),Y(1),CTR) C CALL PGCP(1,X(2),Y(2),CTR) C CALL PGCP(0,X(3),Y(3),CTR) C CALL PGCP(1,X(4),Y(4),CTR) C -- Choose between \\ and // based on the 8 points just C outside the current box. If half or more of these points C lie below the contour level, then draw the lines such that C the high corners lie between the lines, otherwise, draw C the lines such that the low corners are enclosed. Care is C taken to avoid going off the edge. ITOT=0 ILO=0 DO 140 K=1,8 ITMP=I+IOFF(K) JTMP=J+JOFF(K) IF(ITMP.LT.I1 .OR. ITMP.GT.I2) GOTO 140 IF(JTMP.LT.J1 .OR. JTMP.GT.J2) GOTO 140 CALL PLTXCC(Yray,(i-1)*Nrow+j, iftg, xt, ndim, iyoff) atmp = FNFIT(xt, Icomp, Pval, Nterm) IF(atmp.EQ.BLANK) GOTO 140 ITOT=ITOT+1 IF(atmp.LT.CTR) ILO=ILO+1 140 CONTINUE IENC=+1 IF(ILO.LT.ITOT/2) IENC=-1 IF(IENC.LT.0 .AND. DVAL(1).LT.CTR .OR. : IENC.GT.0 .AND. DVAL(1).GE.CTR) THEN CALL PGMOVE(X(1),Y(1)) CALL PGDRAW(X(2),Y(2)) CALL PGMOVE(X(3),Y(3)) CALL PGDRAW(X(4),Y(4)) ELSE CALL PGMOVE(X(1),Y(1)) CALL PGDRAW(X(4),Y(4)) CALL PGMOVE(X(3),Y(3)) CALL PGDRAW(X(2),Y(2)) END IF END IF 110 CONTINUE 130 CONTINUE C CALL PGEBUF END fv5.5/tcltk/plt/ploger.f0000644000220700000360000000333713224715127014106 0ustar birbylhea SUBROUTINE PLOGER(CTOK, LTOK, IDOALL, ICWIN, MXWIN, : CXOPT, LOGX, CYOPT, LOGY, IER) CHARACTER CTOK*(*), CXOPT(*)*(*), CYOPT(*)*(*) INTEGER LTOK, IDOALL, ICWIN, MXWIN, IER INTEGER LOGX(*), LOGY(*) C--- C Sets the log flag for use in PLT C--- REAL FPNUM C CHARACTER CPEEK*2, CV*1 INTEGER IDOX, IDOY, ILOGIT, ITMP, IWNUM, LPEEK C--- IER=0 IDOX=1 IDOY=1 100 CALL GTCHAR(CTOK,LTOK) CALL UPC(CTOK) IF(CTOK(1:1).EQ.'X') THEN IDOX=IDOX+1 IDOY=IDOY-1 GOTO 100 ELSE IF(CTOK(1:1).EQ.'Y') THEN IDOX=IDOX-1 IDOY=IDOY+1 GOTO 100 END IF C--- CALL GTPEEK(CPEEK, LPEEK) IF(CTOK(1:2).EQ.'OF') THEN ILOGIT=0 CV=' ' ELSE ILOGIT=1 CV='L' END IF C--- IF(LPEEK.EQ.0 .AND. IDOALL.NE.0) THEN DO IWNUM=1,MXWIN IF(IDOX.NE.0) THEN LOGX(IWNUM)=ILOGIT CXOPT(IWNUM)(6:6)=CV END IF IF(IDOY.NE.0) THEN LOGY(IWNUM)=ILOGIT CYOPT(IWNUM)(6:6)=CV END IF END DO ELSE IWNUM=ICWIN 150 IF(LPEEK.GT.0) THEN CALL GTCHAR(CTOK, LTOK) IF(LTOK.LE.0) GOTO 900 ITMP=FPNUM(CTOK,LTOK,IER) IF(IER.NE.0) GOTO 900 IF(ITMP.GT.0 .AND. ITMP.LE.MXWIN) IWNUM=ITMP END IF IF(IDOX.NE.0) THEN LOGX(IWNUM)=ILOGIT CXOPT(IWNUM)(6:6)=CV END IF IF(IDOY.NE.0) THEN LOGY(IWNUM)=ILOGIT CYOPT(IWNUM)(6:6)=CV END IF IF(LPEEK.NE.0) GOTO 150 END IF C--- 900 CONTINUE RETURN END fv5.5/tcltk/plt/plt.f0000644000220700000360000044505313224715127013422 0ustar birbylhea SUBROUTINE PLTVER(Cvers, Lvers) CHARACTER Cvers*(*) INTEGER Lvers C--- C Return the current PLT version number. C--- C Cvers O The version number C Lvers O Number of valid characters in cvers C--- C 1998-05-28 - extracted from PLT - [AFT] C--- Cvers = '2015-06-12' Lvers = 10 END C********* SUBROUTINE PLT(Yray, Iery, Mxrow, Npts, Nvec, Cmd, Ncmd, Ier) IMPLICIT NONE REAL Yray(*) INTEGER Iery(*), Mxrow, Npts, Nvec, Ncmd, Ier CHARACTER Cmd(*)*(*) C--- C General plot subroutine. C--- C Yray(*) I The data array. The array should be dimensioned C Y(Mxrow,MXCOL) where Mxrow and MXCOL are the actual C sizes of the arrays in the calling program. C MXCOL = Nvec+NSERR+2*NTERR where NSERR is the number C of vectors that have symmetric errors and NTERR C is the number of vectors that have two-sided errors. C Iery(*) I = -1 assume errors are SQRT(Y) C = 0 no errors. C = +1 explicit symmetric errors. C = +2 for two-sided errors C Mxrow I The actual first dimension of the Y array. C Npts I The number of points to plot (Npts< = Mxrow). C Nvec I The number of vectors to be plotted. C Cmd(*) I Array of commands. C Ncmd I Number of commands. C Ier O Error flag, = -1 if user entered EOF, = 0 otherwise. C--- C [AFT] C--- C- The NO data flag. REAL NO PARAMETER (NO = -1.2E-34) C- Only allow up to two dimensional data. INTEGER MXDIM PARAMETER (MXDIM=2) C- The minimum number that can be LOG'ed. REAL RMNLOG PARAMETER (RMNLOG = 1.E-36) C- Max number of model parameters. INTEGER MXPAR PARAMETER (MXPAR = 120) C- Number of independent plot groups (colors). C- NOTE, pltxc.f must also define MXGRP to be equal to this value. INTEGER MXGRP PARAMETER (MXGRP = 500) C- Max number of numbered labels. INTEGER MXLAB PARAMETER (MXLAB = 600) C- Max number of simultaneous models that can be plotted INTEGER MXMOD PARAMETER (MXMOD = 4) C- Max number of 2D (contour) plots. Must be less than MXGRP. INTEGER MX2D PARAMETER (MX2D = 10) C- Max number of contour levels INTEGER MXLEV PARAMETER (MXLEV = 32) C- Max number of windows INTEGER MXWIN PARAMETER (MXWIN = 40) C Derived value INTEGER MXVAL PARAMETER (MXVAL=MXPAR*MXMOD) C CHARACTER CPARM*2 REAL FPNUM, FNFIT INTEGER IAND, IFGRP, IOFSET, IOR, ISNUM, LENACT C C*** For 2D plots CHARACTER cctnam(MX2D)*128 REAL rlvcon(MXLEV,MX2D), rlwcon(MXLEV,MX2D) REAL tr(6), zscale(2,MX2D), rota(MX2D) INTEGER icont(MX2D), image(MX2D) INTEGER icocon(MXLEV,MX2D),ilscon(MXLEV,0:MX2D),isuba(4,0:MX2D) INTEGER lctnam(MX2D), icbar(MX2D), itfun(MX2D) C*** For each group CHARACTER cglab(MXGRP)*80 REAL flimit(MXGRP), szmark(MXGRP) REAL widlin(MXGRP) C The actual data MIN and MAX values REAL xymnmx(4,MXGRP) C Data MIN and MAX values including errors. REAL ermnmx(4, MXGRP) INTEGER icol(MXGRP), igrpos(3,MXGRP), imark(MXGRP) INTEGER ipmark(MXGRP) INTEGER ipyer(MXGRP), ipwin(MXGRP), ispecg(MXGRP) INTEGER line(MXGRP), lsty(MXGRP) INTEGER ipmod(MXGRP) C*** For each numbered label CHARACTER CLABEL(MXLAB)*80 REAL FLABEL(7,MXLAB) INTEGER ILABEL(7,MXLAB) C*** For each model REAL PVAL(MXPAR,MXMOD), PLIM(3,MXPAR,MXMOD) INTEGER ICOMP(2*MXPAR,MXMOD), nterm(MXMOD) SAVE PVAL, PLIM, ICOMP, nterm INTEGER ifitg(MXMOD) C*** For each window CHARACTER CTLAB(MXWIN)*80, CXLAB(MXWIN)*80, CYLAB(MXWIN)*80 CHARACTER COTLAB(MXWIN)*80, COXLAB(MXWIN)*80, COYLAB(MXWIN)*80 CHARACTER CFNAM(MXWIN)*80 CHARACTER CXOPT(MXWIN)*10, CYOPT(MXWIN)*10 REAL BOXVP(4,MXWIN), WINLOC(4,MXWIN), XYSCAL(4,MXWIN) REAL GRIDX(MXWIN), GRIDY(MXWIN) INTEGER imaster(2,MXWIN) INTEGER iactw(MXWIN), IWADJ(MXWIN) INTEGER LOGX(MXWIN), LOGY(MXWIN), NSUBX(MXWIN), NSUBY(MXWIN) C--- CHARACTER ctmp*255, ctok*128, CSCR1*128, CSCR2*128 CHARACTER CRLAB*80 CHARACTER CFILE*72, CHLIB*128 CHARACTER CHARD*256, cpfile*256, CPSAV*256 CHARACTER CPROM*16 CHARACTER CDISK*256, CDIR*12, CEXT*12 INTEGER LCDISK CHARACTER CXOPT1*10, CYOPT1*10, CFONT*8 DOUBLE PRECISION dsum REAL TOT(16) C- C For now only allow 2D arrays REAL pmin(2), pmax(2), XT(2), X1(2) C For SCR REAL scrcol(3,0:15) C- REAL RED, GRN, BLU REAL CA, COR, CSIZE, DEM, FCOL, Fnew REAL OFF, PGPAPA, PGPAPW, PYLAB REAL RGAP, RMARK, RTD, SA, SLOP REAL TMP, TMP1, TMP2, WIDTH REAL TXMAX, TXMIN, TYMAX, TYMIN REAL XLAS, XHI, xtmp, XLO REAL XCEN, XDEL, XH, XL, xmerr, xperr, XRANGE, XSPAC REAL YCEN, YDEL, YH, YL, YMERR, YPERR, YRANGE, YSPAC, YT REAL YOFF, YSLOP, YLONG REAL VIEWX, VIEWY, VXLAS, VYLAS REAL WINX, WINY, WXMIN, WXMAX, WYMIN, WYMAX C- INTEGER I, I1, I2, i2dind, i2drow, IBAD, ibcol, IC INTEGER ic2dg, iclab, iclear, icmd, ICMOD, ICNT, icsub INTEGER icwin, icyvec, idoall, idoend, IGAP INTEGER idolin, IDOER, IDOWIN, IDOX, IDOY INTEGER IE, IFIRST, iftg, ig, igroup, IGCOL, IGLS INTEGER ILO, IHI, im, imnmx, imnum, IMX, IND, INITAK INTEGER ioff, ION, IOPEN, IOS, ipall, IPLAB, IPZERO INTEGER IS, iscr, ISIGN, iskip, ISTART, ITIME, itmp, ITRANS INTEGER iwnum, ixvec, iy0, iyi, iyoff, iystep INTEGER J1, J2, K, LERX, lery, LFILE, LOOP INTEGER LPFILE, LPROM, LSCR1, LSCR2, ltmp, ltok, LUN INTEGER NASUB, NDIG, ndim, nfpl, new, newmod, ngroup INTEGER NMAX, NROW, NSTOP, NVERT, nxstep, nystep, LASWIN LOGICAL QALL,QHARD C DATA PVAL/MXVAL*1./ DATA RTD/57.29577951/ C The directory where the help libraries are located C DATA CDISK/'$XANTOP'/, CDIR/'doc'/ DATA CDIR/'.'/ C LHEA_HELP points directly to the directory containing the plt C help file, so "CDIR" is "." C LEB 5/7/97 C going to try to allow environment variables to determine C CHLIB. will try XANBIN first and if that's not set we'll C use FTOOLS; the idea is for this to work for both unix C and vms C jdd 1-22-97 CALL TRLOG('LHEA_HELP', 9, CDISK, LCDISK) C Test to see that we got something back -- jdd IF ( LCDISK .EQ. 0 ) THEN WRITE (*,*) 'ERROR in plt/plt.f:' WRITE (*,*) ' Environment variable $LHEA_HELP not defined.' END IF C--- 11 FORMAT(A) C Turn of GTBUF's standalone processing, we want $ and @ to work CALL GTBUFNOTSTAND C--- C- No errors (yet!) Ier = 0 C- Create help library name CHLIB = 'plt.hlp' CALL PTEND(CDISK, CDIR, CHLIB) C--- C- Set the XPARSE default extension CALL XGETIN(CEXT) CALL XSETIN('pco') C--- C- Default is one group per vector ngroup = MIN(Nvec,MXGRP-MXMOD) CALL PLTXCI(Mxrow) C- Default Gap = 2.5%, IGAP=0 don't include errors. RGAP = 0.025 IGAP = 0 C- Paper size = 0.0 means use PGPLOT default PGPAPW = 0.0 PGPAPA = 1.0 C- No active 2D subarrays. NASUB = 0 C- The current 2D group has not been defined yet. This is the default C- group for both CONtour and IMAge commands. ic2dg = 0 DO ic = 1, MX2D C- No rotation rota(ic)=0.0 C- No contour and/or image plots icont(ic) = 0 image(ic) = 0 lctnam(ic) = 0 C- linear image transform function itfun(ic) = 0 C No color bar icbar(ic) = 0 C- Default contour settings DO I = 1, MXLEV rlvcon(I,ic) = NO icocon(I,ic) = I ilscon(I,ic) = 1 rlwcon(I,ic) = 1. zscale(1,ic) = 0. zscale(2,ic) = 1. END DO END DO C Special solid line style for default model contours. DO I=1, MXLEV ilscon(I,0) = 1 END DO C C Scan error array for largest possible contour plot. Number of rows is C easy. The problem is to find the largest group of adjacent columns C that all have the same error. Isuba(2,x) and Isuba(4,x) is the C number of the vector (not the column), isuba(1,0) = 1 isuba(3,0) = Npts itmp = Iery(1) ICNT = 1 IMX = 0 ISTART = 1 isuba(2,0) = 1 isuba(4,0) = Nvec DO I = 2,Nvec IF ( Iery(I).EQ.itmp ) THEN ICNT = ICNT + 1 IF ( ICNT.GT.IMX ) THEN isuba(2,0) = ISTART isuba(4,0) = I IMX = ICNT END IF ELSE ICNT = 0 itmp = Iery(I) ISTART = I END IF END DO C- Commands like R X affect all the windows. idoall = 1 C- Set Skip flag to zero. Can skip either Single, Double, or Off. iskip = 0 C- Have not tried to translate PGPLOT_TYPE logical name ITRANS = 0 C- LASWIN<>0 if Plot Vert is active LASWIN = 0 CALL PGQINF('STATE', ctok, ltok) IF(ctok(1:4).EQ.'OPEN') THEN C- Plot device open, leave it open when PLT exits. IOPEN = 1 idoend = 0 CALL PGASK(.FALSE.) CALL PGQINF('DEV/TYPE', cpfile, LPFILE) ELSE C- Plot device closed, do pgend when PLT exits. IOPEN = 0 idoend = 1 cpfile = ' ' LPFILE = 0 END IF C- Default font CFONT = ' ' C- Don't plot vectors that have color index zero. IPZERO = 0 C- Default to background color of white. ibcol = 0 C- Set imnmx = iskip to indicate that data MIN and MAX values have been C- set for that value of iskip. imnmx = -1 C- BIT0<>0 plot labels, BIT1<>0 plot parm labels IPLAB = 3 C- Grid color and lstyle IGCOL = 1 IGLS = 1 C- Position of the Y label PYLAB = 2.0 C- Do not plot NO data values. QALL = .FALSE. C- Default character size CSIZE = 1.0 C- Default line width WIDTH = 1.0 C- Time stamp on ITIME = 1 C- Current window is number 1 icwin = 1 C- All windows fill the screen DO I = 1,MXWIN C Assume most windows are inactive. Note, iactw must be updated every C time the user does something that might change the number of windows C being plotted, such as COlor ON|OFF, YAXA, IMAG, CONT, PLOT V, PLOT O. iactw(I) = 0 C Default viewport BOXVP(1,I) = 0.1 BOXVP(2,I) = 0.1 BOXVP(3,I) = 0.9 BOXVP(4,I) = 0.9 C- Init number of major and minor tic marks. Zero means use default. GRIDX(I) = 0. GRIDY(I) = 0. NSUBX(I) = 0 NSUBY(I) = 0 C- No window adjust IWADJ(I) = 0 C- Title CTLAB(I) = ' ' COTLAB(I) = ' ' C- File CFNAM(I) = ' ' C- Label X-axis tic marks, CXOPT(6:6) = 'L'|' ', CXOPT(7:7) = 'G'|' ' CXOPT(I) = 'BCSTN' CXLAB(I) = ' ' COXLAB(I) = ' ' C- Label Y-axis tic marks, CYOPY(8:8) = 'V'|' ' CYOPT(I) = 'BCSTN' CYLAB(I) = ' ' COYLAB(I) = ' ' C- linear X and Y LOGX(I) = 0 LOGY(I) = 0 C- All windows fill the screen WINLOC(1,I) = 0. WINLOC(2,I) = 0 WINLOC(3,I) = 1. WINLOC(4,I) = 1. XYSCAL(1,I) = NO XYSCAL(2,I) = NO XYSCAL(3,I) = NO XYSCAL(4,I) = NO C- No master/slave windows (yet!). =0 independent, =-1 master, >0 owner imaster(1,i) = 0 imaster(2,i) = 0 END DO C Default first window is active. iactw(1) = 1 C--- C--- The label options are (where i = group number): C ILABEL(1,i) =0 inactive, =n (n>0) window n coords, =-1 viewport C ILABEL(2,i) 1:3 Justification (Left, center, right) C ILABEL(3,i) 1,3,5 Center (Base, Center, Top) C ILABEL(4,i) 0:15 Color C ILABEL(5,i) 1:5 line style. C ILABEL(6,i) -1:30 Marker type (-1 = no marker) C ILABEL(7,i) =0 normal, =1 FLABEL(5,i) FLABEL(6,i) specify line endpoint C--- C FLABEL(1,i) Character X-position (default = 0.0) C FLABEL(2,i) Character Y-position (default = 0.0) C FLABEL(3,i) Rotatation angle of label (default = 0.0) C FLABEL(4,i) Character size (default = 1.0) C FLABEL(5,i) line angle C FLABEL(6,i) line length in viewport units (default = 0.0 no line) C FLABEL(7,i) Marker size C--- DO i=1,MXLAB ILABEL(1,i) = 0 ILABEL(2,i) = 2 ILABEL(3,i) = 3 ILABEL(4,i) = 1 ILABEL(5,i) = 1 ILABEL(6,i) = -1 ILABEL(7,i) = 0 FLABEL(1,i) = 0.0 FLABEL(2,i) = 0.0 FLABEL(3,i) = 0.0 FLABEL(4,i) = 1.0 FLABEL(6,i) = 0.0 FLABEL(7,i) = 1.0 END DO C- The following does a virtual "Xaxis 1". ixvec = 1 C- DO ig=1,MXGRP C- Zero out the plot window array ipwin(ig) = 0 C- No group labels cglab(ig) = ' ' C- Default colors (PGPLOT only defines color indices up to 15). IF ( ig.LE.15 ) THEN icol(ig) = ig ELSE icol(ig) = 1 END IF C- Don't plot markers, but if you do, default marker type is 2 ipmark(ig) = 0 imark(ig) = 2 C- line =0 line off, =1 line on, =-1 Stepped line plot, >1 smooth line. line(ig) = 0 C- Solid line lsty(ig) = 1 C- No upper limits flimit(ig) = 0.0 C- Default marker size szmark(ig) = 1.0 C- Use global line width widlin(ig) = 0.0 C- No model has been defined ipmod(ig) = 0 C- Standard groups ispecg(ig) = 0 C- Default to all groups being undefined. igrpos(1,ig) = -1 END DO newmod = 0 C- DO ig=1,ngroup C- Plot all active groups in the first window. ipwin(ig) = 1 C The default X coordinate is the first vector in the array hence 1D. CALL PLTXCN(ig, 1, 0) itmp = iofset(ixvec, Iery, ixvec, Mxrow) CALL PLTXCG(ig, 1, ixvec, itmp, Iery) C igrpos contains info on how to find plot groups in the Y array. C igrpos(1,ig) is location of the zeroth point of the group C igrpos(2,ig) is the number of points in the group C igrpos(3,ig) is the vector number from which the group was created igrpos(1,ig) = IOFSET(ig, Iery, Nvec, Mxrow) igrpos(2,ig) = Npts igrpos(3,ig) = ig C- Plot errors, = -1 Root, = 0 no errors, = 1 bars, = 2 diamonds ipyer(ig) = MIN(Iery(ig),1) END DO C- The previous loop plots all groups, turn off the xaxis group. ipwin(ixvec) = -ABS(ipwin(ixvec)) C- Make sure no models are defined. DO i = 1,MXMOD nterm(i) = 0 ifitg(i) = 0 C The last MXMOD groups are hardwired to plot models. icol(MXGRP-MXMOD+1) = 1 END DO C- Default current model ICMOD = 1 C- Plot model at data values. nfpl = 0 C- Default to 200 steps for integrate model nxstep = 200 nystep = 200 C SCR DO iscr=0,15 DO i=1,3 scrcol(i,iscr)=NO END DO END DO C- Default labels. CRLAB = ' ' C- Default prompt CPROM = 'PLT>' C- Get default hardcopy name CALL PLTHAR(CHARD) qhard = .FALSE. icmd = 0 C--- 90 CONTINUE C Load the GTBUF command list IF ( icmd.LT.Ncmd ) THEN IF ( LENACT(Cmd(icmd+1)).LE.0 ) THEN icmd = icmd+1 GOTO 90 END IF CALL STWARN(1) CALL LDBUF1(Cmd(icmd+1),Ier) icmd = icmd+1-Ier ELSE C All commands loaded, go produce plot icmd = -1 GOTO 600 END IF C 100 CONTINUE CALL GTBUF(CPROM,Ier) IF(Ier.NE.0) THEN C EOF IF(Ier.LT.0) GOTO 900 C More commands to be loaded IF(0.LE.icmd .AND. icmd.LE.Ncmd) GOTO 90 END IF CALL GTCHAR(ctok,ltok) IF(ltok.LE.0) GOTO 100 CALL UPC(ctok) C 110 CONTINUE C--- C- Ajdust window ----------------------------------------------------- IF ( ctok(1:1).EQ.'A' ) THEN CALL GTCHAR(ctok,ltok) IF ( ltok.LE.0 ) THEN WRITE(*,*) 'Syntax: Ajust ON|OFF wlist' GOTO 100 END IF CALL UPC(ctok) C- Scan for ON/OFf IF(ctok(1:2).EQ.'ON') THEN ISIGN = +1 ELSE IF(ctok(1:2).EQ.'OF') THEN ISIGN = 0 END IF C CALL IRANGE(ctok,ltok,1,MXWIN,ILO,IHI,Ier) ILO = MAX(1,MIN(ILO,MXWIN)) IHI = MAX(1,MIN(IHI,MXWIN)) DO I = ILO,IHI IWADJ(icwin) = ISIGN END DO C--- ELSE IF(ctok(1:1).EQ.'C') THEN C- CLear device ------------------------------------------------------ IF(ctok(1:2).EQ.'CL') THEN CALL PLTCLR C--- C- CONtour ----------------------------------------------------------- ELSE IF(ctok(1:3).EQ.'CON') THEN CALL GTCHAR(ctok,ltok) IF ( ISNUM(ctok,ltok).NE.0 ) THEN C CONtour # to change the currently active contour/image group. itmp = FPNUM(ctok, ltok, Ier) IF ( itmp.LE.0 .OR. itmp.GT.MX2D ) THEN WRITE(*,*) 'Contour number must be in the range 1 to', : MX2D GOTO 100 END IF CALL PLTXCC(Yray, 1, itmp, xt, ndim, iyoff) IF ( ndim.EQ.1 ) THEN WRITE(*,121) itmp 121 FORMAT(' Plot group ',I3,' is only one dimensional.') GOTO 100 END IF ic2dg = itmp CALL GTCHAR(ctok,ltok) END IF IF ( ic2dg.EQ.0 ) THEN C User has failed to define a 2D subarray. Overwrite the first group C with the largest possible 2D array. ic2dg = 1 isuba(1,ic2dg) = isuba(1,0) isuba(2,ic2dg) = isuba(2,0) isuba(3,ic2dg) = isuba(3,0) isuba(4,ic2dg) = isuba(4,0) igrpos(1,ic2dg) = IOFSET(isuba(2,0), Iery, Nvec, Mxrow) + & isuba(1,0) - 1 igrpos(2,ic2dg) = (isuba(3,0)-isuba(1,0)+1)* & (isuba(4,0)-isuba(2,0)+1) igrpos(3,ic2dg) = isuba(2,0) ispecg(ic2dg) = 3 CALL PLTXCN(ic2dg, 2, isuba(3,0)-isuba(1,0)+1) CALL PLTXCL(ic2dg, 1, NO, NO) CALL PLTXCL(ic2dg, 2, NO, NO) imnmx = -1 END IF ioff = 0 C C This is the main loop for parsing the CONtour command. NOTE, it C is important that the next argument is parsed, before jumping back C here, otherwise an infinite loop results. 130 CONTINUE IF ( ltok.EQ.0 ) THEN C No more sub-commands. IF ( ioff.EQ.0 ) THEN C Activate the selected window. icont(ic2dg) = 1 IF ( ipwin(ic2dg).LE.0 ) ipwin(ic2dg) = icwin END IF CALL ACTWIN(ipwin,ngroup,MXWIN,iactw) GOTO 100 END IF C C Now parse sub-commands. CALL UPC(ctok) IF(ctok(1:1).EQ.'?') THEN WRITE(*,*) 'Possible sub-commands are:' WRITE(*,*) 'COlor, LEvels, lstyle, LWidth, OFf' ELSE IF(ctok(1:2).EQ.'CO') THEN C CONtour COlor DO I = 1,MXLEV CALL GTCHAR(ctok,ltok) IF(ltok.GT.0) THEN IF(ISNUM(ctok, ltok).EQ.0) GOTO 130 icocon(I,ic2dg) = FPNUM(ctok,ltok,Ier) END IF END DO ELSE IF(ctok(1:2).EQ.'LE') THEN C CONtour LEvel DO I = 1,MXLEV CALL GTCHAR(ctok,ltok) IF(ltok.GT.0) THEN IF(ISNUM(ctok, ltok).EQ.0) GOTO 130 rlvcon(I,ic2dg) = FPNUM(ctok,ltok,Ier) END IF END DO ELSE IF(ctok(1:2).EQ.'LS') THEN C CONtour lstyle DO I = 1,MXLEV CALL GTCHAR(ctok,ltok) IF(ltok.GT.0) THEN IF(ISNUM(ctok, ltok).EQ.0) GOTO 130 ilscon(I,ic2dg) = FPNUM(ctok,ltok,Ier) END IF END DO ELSE IF(ctok(1:2).EQ.'LW') THEN C CONtour LWidth DO I = 1,MXLEV CALL GTCHAR(ctok,ltok) IF(ltok.GT.0) THEN IF(ISNUM(ctok, ltok).EQ.0) GOTO 130 rlwcon(I,ic2dg) = FPNUM(ctok,ltok,Ier) END IF END DO ELSE IF(ctok(1:2).EQ.'OF') THEN C CONtour OFF (turn off all images in the current window) ioff = 1 icont(ic2dg) = 0 IF ( icol(ic2dg).LE.0 .AND. image(ic2dg).LE.0 ) & ipwin(ic2dg) = -ABS(ipwin(ic2dg)) ELSE WRITE(*,591) ctok(:ltok) END IF CALL GTCHAR(ctok,ltok) GOTO 130 C--- C- COlor ------------------------------------------------------------- ELSE IF(ctok(1:2).EQ.'CO') THEN CALL GTCHAR(ctok,ltok) CALL UPC(ctok) FCOL = NO IF(ctok(1:1).EQ.'?') THEN CALL PLTSCI(-1) ELSE IF(ctok(1:1).EQ.'M') THEN CALL GTINT(icol(MXGRP-MXMOD+ICMOD),Ier) ELSE IF(ISNUM(ctok,ltok).NE.0) THEN FCOL = FPNUM(ctok,ltok,Ier) CALL GTCHAR(ctok,ltok) CALL UPC(ctok) END IF C- Scan for ON/OFf IF(ctok(1:2).EQ.'ON') THEN ISIGN = +1 ELSE IF(ctok(1:2).EQ.'OF') THEN ISIGN = -1 END IF C- Find which vectors to color 160 CALL GTCHAR(ctok,ltok) IF(ltok.LE.0) THEN CALL ACTWIN(ipwin,ngroup,MXWIN,iactw) ELSE CALL UPC(ctok) IF(ctok(1:1).EQ.'G') THEN IGCOL = FCOL ELSE IF(ctok(1:1).EQ.'M') THEN icol(MXGRP-MXMOD+ICMOD) = FCOL ELSE CALL IRANGE(ctok,ltok,1,MXGRP-MXMOD,ILO,IHI,Ier) ILO = MAX(1,MIN(ILO,MXGRP-MXMOD)) IHI = MAX(1,MIN(IHI,MXGRP-MXMOD)) DO I = ILO,IHI IF(FCOL.EQ.NO) THEN IF(ISIGN.LT.0) THEN icol(I) = -ABS(icol(I)) ipwin(I) = -ABS(ipwin(I)) ELSE icol(I) = ABS(icol(I)) ipwin(I) = ABS(ipwin(I)) END IF ELSE IF(ISIGN.LT.0) THEN icol(I) = -FCOL ipwin(I) = -ABS(ipwin(I)) ELSE icol(I) = FCOL ipwin(I) = ABS(ipwin(I)) END IF END IF END DO END IF GOTO 160 END IF ELSE IF(ctok(1:3).EQ.'CPD') THEN C- CPD device -------------------------------------------------------- CALL GTCHAR(cpfile, ltok) IF ( ltok.EQ.0 ) THEN cpfile = ' ' ELSE IF ( cpfile(1:1).EQ.'?' ) THEN CALL PGLDEV GOTO 100 END IF CALL PGEND IF ( IOPEN.LT.0 ) CALL PLTTER('A') IOPEN = 0 C--- C- Clear and Quit ---------------------------------------------------- ELSE IF(ctok(1:2).EQ.'CQ' .OR. ctok(1:2).EQ.'CE') THEN CALL PLTCLR GOTO 950 C--- C- Character Size ---------------------------------------------------- ELSE IF(ctok(1:2).EQ.'CS') THEN CALL GTREAL(TMP, Ier) IF(TMP.GT.0.) CSIZE = TMP C--- C- CUrsor ------------------------------------------------------------ ELSE IF(ctok(1:2).EQ.'CU') THEN loop = 1 LUN = 0 170 CONTINUE CALL GTCHAR(ctok, ltok) IF ( ltok.GT.0 ) THEN CALL UPC(ctok(:ltok)) IF ( ctok(1:3).EQ.'WXY' ) THEN CFILE = ' ' CALL GTCHAR(CFILE,LFILE) C WHead or WEnviron CALL XTEND(CFILE,'CUR') CALL GETLUN(LUN) CALL OPENWR(LUN,CFILE,'new',' ','LIST',0,0,IOS) IF(IOS.NE.0) THEN WRITE(*,*) 'PLT--Unable to open '// : ctmp(:LENACT(ctmp)) GOTO 100 END IF ELSE IF ( ctok(1:1).EQ.'N' ) THEN CALL GTINT(loop, Ier) ELSE GOTO 590 END IF GOTO 170 END IF VXLAS = -1. VYLAS = -1. 180 CONTINUE CALL PLTCUR(WINLOC, BOXVP, XYSCAL, MXWIN, LOGX, LOGY, : iactw, iwadj, iwnum, VIEWX, VIEWY, WINX, WINY, ctmp) IF ( loop.GE.0 ) THEN CALL UPC(ctmp(1:1)) IF ( INDEX('QX',ctmp(1:1)).GT. 0 .OR. : VIEWX.EQ.VXLAS .AND. VIEWY.EQ.VYLAS ) THEN IF ( LUN.GT.0 ) THEN CLOSE(UNIT = LUN) CALL FRELUN(LUN) END IF GOTO 100 END IF END IF C Write out information WRITE(*,*) 'iwnum = ',iwnum WRITE(*,*) 'VPOS = ',VIEWX,VIEWY WRITE(*,*) 'WPOS = ',WINX,WINY IF ( LUN.GT.0 .AND. ctmp(1:1).NE.'?' ) THEN WRITE(LUN,*) WINX, WINY END IF IF ( ABS(loop).EQ.1 ) THEN IF ( LUN.GT.0 ) THEN CLOSE(UNIT = LUN) CALL FRELUN(LUN) END IF GOTO 100 END IF C Decrement loop counter IF ( ctmp(1:1).NE.'?' ) THEN IF ( loop.GT.0 ) THEN loop = loop - 1 ELSE loop = loop + 1 END IF VXLAS = VIEWX VYLAS = VIEWY END IF GOTO 180 C End 'C' commands END IF C--- C- DGroup ------------------------------------------------------------ ELSE IF ( ctok(1:2).EQ.'DG' ) THEN CALL GTPEEK(ctmp,ltmp) IF ( isnum(ctmp, ltmp).NE.0 ) THEN CALL GTINT(icsub, ier) IF ( icsub.LE.0 .OR. MXGRP-MXMOD.LT.icsub ) THEN WRITE(*,*) 'The SUBarray group number must be ', & 'in the range 1 to ',MXGRP-MXMOD,'.' GOTO 100 END IF ELSE ctok = ' ' CALL GTCHAR(ctok, ltok) ltok = MAX(1,ltok) C Scan to see if name already exists cscr1 = ctok(:ltok) CALL UPC(cscr1(:ltok)) icsub = 0 DO ig= 1,ngroup IF ( igrpos(1,ig).GE.0 ) THEN cscr2 = cglab(ig)(:ltok) CALL UPC(cscr2(:ltok)) IF ( cscr1(:ltok).EQ.cscr2(:ltok) ) THEN icsub = ig END IF END IF END DO IF ( icsub.LE.0 ) THEN WRITE(*,*) 'The DGroup command requires a group.' GOTO 100 END IF END IF C CALL GTPEEK(ctmp,ltmp) CALL UPC(ctmp) IF ( ctmp(1:1).EQ.'M' .OR. ctmp(1:1).EQ.'R' ) THEN IF ( ctmp(1:1).EQ.'M' ) THEN C DGroup # Model ipmod(icsub) = icmod ispecg(icsub) = 1 ELSE C DGroup # Res ipmod(icsub) = -icmod ispecg(icsub) = 2 END IF CALL GTCHAR(ctok, ltok) CALL PLTXCD(ifitg(icmod), icsub) igrpos(1, icsub) = igrpos(1, ifitg(icmod)) igrpos(2, icsub) = igrpos(2, ifitg(icmod)) igrpos(3, icsub) = igrpos(3, ifitg(icmod)) ipyer(icsub) = ipyer(ifitg(icmod)) IF ( icsub.LE.MX2D .AND. ifitg(icmod).LE.MX2D ) THEN isuba(1,icsub) = isuba(1, ifitg(icmod)) isuba(2,icsub) = isuba(2, ifitg(icmod)) isuba(3,icsub) = isuba(3, ifitg(icmod)) isuba(4,icsub) = isuba(4, ifitg(icmod)) END IF GOTO 185 ELSE C Now read locations of two corners I1 = 1 J1 = 1 CALL GTINT(I1,Ier) CALL GTPEEK(ctmp,ltmp) IF ( ltmp.LE.0 ) THEN C If only one number is on the line then assume that is a column number. j1 = i1 j1 = MIN(MAX(1,j1),Nvec) j2 = j1 i1 = 1 i2 = Npts ELSE CALL GTINT(J1,Ier) I1 = MIN(MAX(1,I1),Npts) J1 = MIN(MAX(1,J1),Nvec) I2 = Npts J2 = Nvec CALL GTINT(I2,Ier) CALL GTINT(J2,Ier) I2 = MIN(MAX(1,I2),Npts) J2 = MIN(MAX(1,J2),Nvec) itmp = Iery(j1) DO I = J1, J2 IF ( Iery(I).NE.itmp ) THEN WRITE(*,*) : 'The errors are not the same on all vectors.' WRITE(*,*) 'Not allowed to contour.' GOTO 100 END IF END DO END IF ispecg(icsub) = 3 END IF C Got group and two corners, now define the subarray IF ( J1.EQ.J2 ) THEN C User defined a 1D array CALL PLTXCN(icsub, 1, 0) IF ( ixvec.NE.0 ) THEN itmp = iofset(ixvec, Iery, ixvec, Mxrow)+I1-1 CALL PLTXCG(icsub, 1, ixvec, itmp, Iery) END IF igrpos(1,icsub) = IOFSET(j1, Iery, Nvec, Mxrow) + I1 - 1 igrpos(2,icsub) = I2-I1+1 igrpos(3,icsub) = j1 ELSE C Must be 2D CALL PLTXCN(icsub, 2, i2-i1+1) isuba(1,icsub) = I1 isuba(2,icsub) = J1 isuba(3,icsub) = I2 isuba(4,icsub) = J2 igrpos(1,icsub) = IOFSET(J1, Iery, Nvec, Mxrow) + I1 - 1 igrpos(2,icsub) = (I2-I1+1)*(J2-J1+1) igrpos(3,icsub) = isuba(2,icsub) CALL PLTXCL(icsub, 1, NO, NO) CALL PLTXCL(icsub, 2, NO, NO) C Use the most recently defined 2D subarray as the default to contour/image ic2dg = icsub END IF 185 CONTINUE ngroup = MAX(ngroup, icsub) C Since we have (possibly) redefined the groups, force the reevaluation C of data min/max values. imnmx = -1 C- Device ------------------------------------------------------------ ELSE IF(ctok(1:1).EQ.'D' ) THEN CALL GTCHAR(cpfile, ltok) IF ( ltok.EQ.0 ) THEN cpfile = ' ' ELSE IF ( cpfile(1:1).EQ.'?' ) THEN CALL PGLDEV GOTO 100 END IF CALL PGEND IF ( IOPEN.LT.0 ) CALL PLTTER('A') IOPEN = 0 C--- C- EXit or Quit ------------------------------------------------------ ELSE IF(ctok(1:2).EQ.'EX' .OR. ctok(1:1).EQ.'Q') THEN GOTO 950 C--- C- Error ------------------------------------------------------------- ELSE IF(ctok(1:1).EQ.'E') THEN IDOX = 0 IDOY = 0 190 CALL GTCHAR(ctok,ltok) CALL UPC(ctok) IF(ctok(1:1).EQ.'X') THEN IDOX = 1 GOTO 190 ELSE IF(ctok(1:1).EQ.'Y') THEN IDOY = 1 GOTO 190 END IF IF ( IDOX.EQ.0 .AND. IDOY.EQ.0 ) THEN IDOX = 1 IDOY = 1 END IF IF(ctok(1:1).EQ.'D') THEN new = 2 ELSE IF(ctok(1:1).EQ.'G') THEN C Gehrels new = -2 ELSE IF(ctok(1:2).EQ.'ON') THEN new = 1 ELSE IF(ctok(1:2).EQ.'OF') THEN new = 0 ELSE IF(ctok(1:1).EQ.'S') THEN C Poisson. new = -1 ELSE GOTO 590 END IF C- Now get [glist] CALL GTCHAR(ctok,ltok) 210 CONTINUE CALL UPC(ctok) CALL IRANGE(ctok,ltok,1,ngroup,ILO,IHI,Ier) IF(ILO.LT.1 .OR. IHI.LT.1) GOTO 590 ILO = MAX(1,MIN(ILO,MXGRP)) IHI = MAX(1,MIN(IHI,MXGRP)) DO igroup = ILO, IHI IF ( igrpos(1,igroup).GE.0 ) THEN IF ( IDOX.NE.0 ) CALL PLTXCP(igroup, 1, new) IF ( IDOY.NE.0 ) THEN lery = Iery(igrpos(3,igroup)) IF ( lery.EQ.0 ) THEN C- If originally no errors, only plot statistical or no errors. IF ( new.LE.0 ) ipyer(igroup) = new ELSE ipyer(igroup) = new END IF END IF END IF END DO CALL GTCHAR(ctok,ltok) IF(ltok.GT.0) GOTO 210 C--- C- FNY --------------------------------------------------------------- ELSE IF(ctok(1:2).EQ.'FN') THEN IF(nterm(ICMOD).LE.0) THEN WRITE(*,*) 'No model defined.' ELSE CALL GTREAL(xt(1),Ier) xt(2) = 0.0 CALL GTREAL(xt(2),Ier) WRITE(*,*) FNFIT(XT,ICOMP(1,ICMOD), : PVAL(1,ICMOD),nterm(ICMOD)) END IF C--- C- FOnt -------------------------------------------------------------- ELSE IF(ctok(1:2).EQ.'FO') THEN CALL GTCHAR(ctok,ltok) IF(ltok.GT.0) THEN IF(ctok(1:1).EQ.'?') THEN CALL PLTFON(ctok) ELSE CFONT = ctok IF(IOPEN.NE.0) CALL PLTFON(CFONT) END IF ELSE CFONT = ' ' END IF C--- C- FReeze ------------------------------------------------------------ ELSE IF(ctok(1:2).EQ.'FR') THEN IF(nterm(ICMOD).LE.0) THEN WRITE(*,411) ELSE CALL GTREST(ctok,ltok) ctmp = 'FR '//ctok CALL MODEL(ctmp,pmin,pmax,MXPAR,Cmd,Ncmd,Icmd, & ICOMP(1,ICMOD),PVAL(1,ICMOD),PLIM(1,1,ICMOD),nterm(ICMOD)) END IF C--- C- Fit --------------------------------------------------------------- ELSE IF(ctok(1:1).EQ.'F') THEN IF ( nterm(ICMOD).LE.0 ) THEN WRITE(*,*) 'PLT--You must define a model first.' GOTO 100 END IF C CALL DSCALE(Yray, Iery, Mxrow, MXWIN, MX2D, ngroup, MXPAR, & igap, rgap, idoall, iskip, newmod, iactw, logx, logy, imaster, & igrpos, ipwin, icont, image, ipmod, icomp, pval, nterm, & imnmx, xymnmx, ermnmx, xyscal) C CALL GTCHAR(ctok,ltok) CALL UPC(ctok) IF ( ctok(1:2).EQ.'ON' ) THEN C Fit ON (plot the model in the same window as the group being fitted). CALL GTINT(itmp,Ier) IF ( itmp.GT.0 .AND. itmp.LE.ngroup ) THEN ipwin(MXGRP-MXMOD+icmod) = ipwin(itmp) ifitg(icmod) = itmp ELSE ipwin(MXGRP-MXMOD+icmod) = ABS(ipwin(MXGRP-MXMOD+icmod)) END IF GOTO 100 ELSE IF ( ctok(1:2).EQ.'OF' ) THEN C Fit OFf ipwin(MXGRP-MXMOD+icmod) = -ABS(ipwin(MXGRP-MXMOD+icmod)) GOTO 100 ELSE IF ( ctok(1:1).EQ.'P' ) THEN C Fit Plot # CALL GTINT(nfpl,Ier) GOTO 100 ELSE IF ( ctok(1:1).EQ.'E' ) THEN C Obsolete Fit Error command ctok = 'UNCER' GOTO 110 END IF C ctok(ltok+1:) = ' ' CALL GTREST(ctok(ltok+2:),ltmp) IF ( IOPEN.LT.0 ) CALL PLTTER('A') CALL FIT(ctok, ifitg(icmod), Yray, Mxrow, ngroup, icwin, : ipwin, ipyer, ipwin, igrpos, XYSCAL, : ICOMP(1,ICMOD),PVAL(1,ICMOD),PLIM(1,1,ICMOD),nterm(ICMOD)) ipwin(MXGRP-MXMOD+icmod) = ipwin(ifitg(icmod)) ipall = 0 ICLEAR = 0 newmod = icmod GOTO 650 C--- C- G ----------------------------------------------------------------- ELSE IF(ctok(1:1).EQ.'G') THEN IF(ctok(1:2).EQ.'GA') THEN C- GAp --------------------------------------------------------------- 230 CONTINUE CALL GTCHAR(ctok,ltok) IF ( ltok.GE.1 ) THEN CALL UPC(ctok(:ltok)) IF ( ctok(1:1).EQ.'E' ) THEN C Gap Error IGAP = +1 CALL GTCHAR(ctok,ltok) ELSE IF ( ctok(1:1).EQ.'N' ) THEN C Gap Noerror IGAP = 0 CALL GTCHAR(ctok,ltok) ELSE IF ( ISNUM(ctok,ltok).NE.0 ) THEN C Gap # RGAP = FPNUM(ctok, ltok, Ier) END IF GOTO 230 END IF ELSE IF(ctok(1:1).EQ.'G') THEN C- Grid -------------------------------------------------------------- 240 CALL GTCHAR(ctok,ltok) IF(ltok.LE.0) GOTO 100 CALL UPC(ctok) IF(ctok(1:2).EQ.'ON') THEN C Grid ON IF(idoall.NE.0) THEN DO i=1,MXWIN CXOPT(i)(7:7) = 'G' CYOPT(i)(7:7) = 'G' END DO ELSE CXOPT(icwin)(7:7) = 'G' CYOPT(icwin)(7:7) = 'G' END IF ELSE IF(ctok(1:2).EQ.'OF') THEN C Grid OFf IF(idoall.NE.0) THEN DO i=1,MXWIN CXOPT(i)(7:7) = ' ' CYOPT(i)(7:7) = ' ' END DO ELSE CXOPT(icwin)(7:7) = ' ' CYOPT(icwin)(7:7) = ' ' END IF ELSE IF(ctok(1:1).EQ.'X') THEN C Grid X CALL GTPEEK(ctmp, ltmp) IF ( ISNUM(ctmp, ltmp).NE.0 ) THEN CALL GTREAL(TMP, Ier) IF(TMP.LT.0.) THEN CXOPT(icwin)(4:4) = ' ' ELSE CXOPT(icwin)(4:4) = 'T' GRIDX(icwin) = TMP END IF itmp = -1 CALL GTINT(itmp,Ier) IF(itmp.LT.0) THEN CXOPT(icwin)(3:3) = ' ' ELSE CXOPT(icwin)(3:3) = 'S' NSUBX(icwin) = itmp END IF IF(idoall.NE.0) THEN DO i=1,MXWIN CXOPT(i)(4:4) = CXOPT(icwin)(4:4) GRIDX(i) = GRIDX(icwin) CXOPT(i)(3:3) = CXOPT(icwin)(3:3) NSUBX(i) = NSUBX(icwin) END DO END IF ELSE CALL GTCHAR(ctok, ltok) CALL UPC(ctok(:ltok)) IF ( ctok(1:2).EQ.'ON') THEN C Grid X ON IF(idoall.NE.0) THEN DO i=1,MXWIN CXOPT(i)(7:7) = 'G' END DO ELSE CXOPT(icwin)(7:7) = 'G' END IF ELSE IF ( ctok(1:2).EQ.'OF') THEN C Grid X OFf IF(idoall.NE.0) THEN DO i=1,MXWIN CXOPT(i)(7:7) = ' ' END DO ELSE CXOPT(icwin)(7:7) = ' ' END IF END IF END IF ELSE IF(ctok(1:1).EQ.'Y') THEN C Grid Y CALL GTPEEK(ctmp, ltmp) IF ( ISNUM(ctmp, ltmp).NE.0 ) THEN IF(ltok.GT.1) THEN itmp = FPNUM(ctok(2:ltok),ltok-1,Ier) iwnum = MAX(1,MIN(itmp,MXWIN)) ELSE iwnum = icwin END IF CALL GTREAL(TMP,Ier) IF(TMP.LT.0.) THEN CYOPT(iwnum)(4:4) = ' ' ELSE CYOPT(iwnum)(4:4) = 'T' GRIDY(iwnum) = TMP END IF itmp = -1 CALL GTINT(itmp,Ier) IF(itmp.LT.0) THEN CYOPT(iwnum)(3:3) = ' ' ELSE CYOPT(iwnum)(3:3) = 'S' NSUBY(iwnum) = itmp END IF IF(idoall.NE.0) THEN DO i=1,MXWIN CYOPT(i)(4:4) = CYOPT(icwin)(4:4) GRIDY(i) = GRIDY(icwin) CYOPT(i)(3:3) = CYOPT(icwin)(3:3) NSUBY(i) = NSUBY(icwin) END DO END IF ELSE CALL GTCHAR(ctok, ltok) CALL UPC(ctok(:ltok)) IF ( ctok(1:2).EQ.'ON') THEN C Grid Y ON IF(idoall.NE.0) THEN DO i=1,MXWIN CYOPT(i)(7:7) = 'G' END DO ELSE CYOPT(icwin)(7:7) = 'G' END IF ELSE IF ( ctok(1:2).EQ.'OF') THEN C Grid Y OFf IF(idoall.NE.0) THEN DO i=1,MXWIN CYOPT(i)(7:7) = ' ' END DO ELSE CYOPT(icwin)(7:7) = ' ' END IF END IF END IF ELSE GOTO 590 END IF GOTO 240 END IF C--- C- HElp -------------------------------------------------------------- ELSE IF(ctok(1:2).EQ.'HE' .OR. ctok(1:1).EQ.'?') THEN CALL GTREST(ctmp,ltmp) IF(IOPEN.LT.0) CALL PLTTER('A') ctmp(ltmp+1:) = ' ' CALL F_IHF(CHLIB, CTMP) C--- C- Hardcopy ---------------------------------------------------------- ELSE IF(ctok(1:1).EQ.'H') THEN CPSAV = cpfile CALL GTCHAR(ctok,ltok) IF(ctok(1:1).EQ.'?') THEN WRITE(*,*) 'Current hardcopy device is: ', : CHARD(:LENACT(CHARD)) GOTO 100 END IF IF(ltok.GT.0) CHARD = ctok(:ltok) CALL PGEND IF(IOPEN.LT.0) CALL PLTTER('A') IOPEN = 0 cpfile = CHARD QHARD = .TRUE. ICLEAR = 0 GOTO 610 C--- ELSE IF ( ctok(1:1).EQ.'I' ) THEN C--- IF ( ctok(1:3).EQ.'IMA' ) THEN C- IMAge ------------------------------------------------------------- CALL GTCHAR(ctok,ltok) IF ( ISNUM(ctok,ltok).NE.0 ) THEN C IMAge # to change the currently active contour/image group. itmp = FPNUM(ctok, ltok, Ier) IF ( itmp.LE.0 .OR. itmp.GT.MX2D ) THEN WRITE(*,*) 'Image number must be in the range 1 to', : MX2D GOTO 100 END IF CALL PLTXCC(Yray, 1, itmp, xt, ndim, iyoff) IF ( ndim.EQ.1 ) THEN WRITE(*,121) itmp GOTO 100 END IF ic2dg = itmp CALL GTCHAR(ctok,ltok) END IF IF ( ic2dg.EQ.0 ) THEN C User has failed to define a 2D subarray. Overwrite the first group C with the largest possible 2D array. ic2dg = 1 isuba(1,ic2dg) = isuba(1,0) isuba(2,ic2dg) = isuba(2,0) isuba(3,ic2dg) = isuba(3,0) isuba(4,ic2dg) = isuba(4,0) igrpos(1,ic2dg) = IOFSET(isuba(2,0), Iery, Nvec, Mxrow) + & isuba(1,0) - 1 igrpos(2,ic2dg) = (isuba(3,0)-isuba(1,0)+1)* & (isuba(4,0)-isuba(2,0)+1) igrpos(3,ic2dg) = isuba(2,0) ispecg(ic2dg) = 3 CALL PLTXCN(ic2dg, 2, isuba(3,0)-isuba(1,0)+1) CALL PLTXCL(ic2dg, 1, NO, NO) CALL PLTXCL(ic2dg, 2, NO, NO) imnmx = -1 END IF ioff = 0 C C This is the main loop for parsing the image command. NOTE, it C is important that the next argument is parsed, before jumping back C here, otherwise an infinite loop results. 245 CONTINUE IF(ltok.EQ.0) THEN C No more sub-commands. IF ( ioff.EQ.0 ) THEN C Activate the selected window. image(ic2dg) = 1 IF ( ipwin(ic2dg).LE.0 ) ipwin(ic2dg) = icwin END IF CALL ACTWIN(ipwin, ngroup, MXWIN, iactw) GOTO 100 END IF CALL UPC(ctok(:ltok)) IF(ctok(1:1).EQ.'H') THEN C IMA Histo Not currently supported! itfun(ic2dg) = -1 ELSE IF(ctok(1:2).EQ.'LI') THEN C IMA LIn itfun(ic2dg) = 0 ELSE IF(ctok(1:2).EQ.'LO') THEN C IMA LOg itfun(ic2dg) = 1 ELSE IF(ctok(1:2).EQ.'SQ') THEN C IMA SQrt itfun(ic2dg) = 2 ELSE IF(ctok(1:2).EQ.'MA') THEN C IMA MAx # CALL GTREAL(zscale(2,ic2dg), Ier) ELSE IF(ctok(1:2).EQ.'MI') THEN C IMA MIn # CALL GTREAL(zscale(1,ic2dg), Ier) ELSE IF(ctok(1:2).EQ.'RO') THEN C IMA ROt # CALL GTREAL(rota(ic2dg), Ier) ELSE IF(ctok(1:2).EQ.'CB') THEN C IMAge CBar ON|OFF (turn color bar on or off) CALL GTCHAR(ctok, ltok) CALL UPC(ctok) IF(ctok(1:2).EQ.'OF') THEN icbar(ic2dg) = 0 ELSE icbar(ic2dg) = 1 END IF ELSE IF(ctok(1:1).EQ.'C') THEN C IMAge CCT (change color table) CALL GTCHAR(ctmp, ltmp) IF ( ctmp(ltmp:ltmp).EQ.'?' ) THEN CALL PLTCCT(ctmp, ltmp) ELSE cctnam(ic2dg) = ctmp lctnam(ic2dg) = ltmp END IF ELSE IF(ctok(1:2).EQ.'OF') THEN C IMAge OFf ioff = 1 image(ic2dg) = 0 IF ( icol(ic2dg).LE.0 .AND. icont(ic2dg).LE.0 ) & ipwin(ic2dg) = -ABS(ipwin(ic2dg)) ELSE IF(ctok(1:2).EQ.'ON') THEN C IMAge ON (since most of the work upon exit, this is mostly a placeholder). image(ic2dg) = 1 ELSE WRITE(*,591) ctok(:ltok) END IF CALL GTCHAR(ctok,ltok) GOTO 245 ELSE IF ( ctok(1:3).EQ.'IMO' ) THEN C- Integrate model --------------------------------------------------- IF(nterm(ICMOD).LE.0) THEN WRITE(*,*) 'No model defined.' GOTO 100 END IF XL = pmin(1) CALL GTREAL(XL,Ier) XH = pmax(1) CALL GTREAL(XH,Ier) CALL GTINT(nxstep,Ier) IF(nxstep.LE.1) nxstep = 200 XDEL = (XH-XL)/(nxstep-1.) C CALL PLTXCC(Yray, 1, ifitg(icmod), xt, ndim, iyoff) IF ( ndim.EQ.1 ) THEN yl = 0.0 yh = 0.0 nystep = 1 ydel = 1.0 ELSE yl = pmin(2) CALL GTREAL(yl,Ier) yh = pmax(2) CALL GTREAL(yh,Ier) CALL GTINT(nystep,Ier) IF(nystep.LE.1) nystep = 200 ydel = (yh-yl)/(nystep-1.) END IF C dsum = 0.0d0 DO iystep=1, nystep xt(2) = yl + (iystep-1)*ydel DO i = 1,nxstep XT(1) = XL+(i-1.)*XDEL dsum = dsum+XDEL*ydel* : FNFIT(XT,ICOMP(1,ICMOD),PVAL(1,ICMOD),nterm(ICMOD)) END DO END DO IF ( ndim.EQ.1 ) THEN WRITE(*,251) XL,XH,dsum 251 FORMAT(' Model from ',1PG12.5,' to ',G12.5,' is ',G11.5) ELSE WRITE(*,261) xl,xh,yl,yh,dsum 261 FORMAT(' Model from ',1PG12.5,' to ',G12.5,/, & ' and Y from ',1PG12.5,' to ',G12.5,' is ',G11.5) END IF ELSE C Info command ctok = ' ' CALL GTCHAR(ctok, ltok) CALL UPC(ctok) IF(ctok(1:1).EQ.'?') THEN WRITE(*,*) 'Possible sub-commands are:' WRITE(*,*) 'All, Call, Groups, Scales, Windows' GOTO 100 END IF IF(ltok.EQ.0) THEN ctok = 'S' ltok = 1 END IF IF(ctok(1:1).EQ.'C' .OR. ctok(1:1).EQ.'A') THEN C Info Call WRITE(*,*) WRITE(*,*) 'Calling sequence:' itmp = Nvec DO I = 1,Nvec IF(Iery(I).GT.0) itmp = itmp+Iery(I) END DO WRITE(*,281) Mxrow, Npts, itmp, Nvec 281 FORMAT(' Max num of rows = ',I9/ : ' Num of points = ',I7,', Num of columns = ',I5, : ', Num of vectors = ',I5) WRITE(*,*) WRITE(*,*) 'Ncmd=',Ncmd,', Cmd=' DO I = 1,Ncmd ltmp = LENACT(Cmd(I)) WRITE(*,*) Cmd(I)(:ltmp) END DO END IF IF(ctok(1:1).EQ.'G' .OR. ctok(1:1).EQ.'A') THEN C Info Groups WRITE(*,*) WRITE(*,*) 'Groups:' WRITE(*,*) 'Grp, icol, Iery, ipyer, '// : 'line, lsty, MARK, PMAR, SZMAR, FLIM, ipmod' DO ig=1, ngroup IF ( igrpos(1,ig).GE.0 ) THEN lery = Iery(igrpos(3,ig)) WRITE(*,291) ig,icol(ig),lery,ipyer(ig),line(ig), : lsty(ig),imark(ig),ipmark(ig), : szmark(ig),flimit(ig),ipmod(ig) 291 FORMAT(I3,I6,I6,I7,I7,3I6,F7.1,F6.1,I6) END IF END DO END IF IF(ctok(1:1).EQ.'I' .OR. ctok(1:1).EQ.'A') THEN C Info Internals WRITE(*,*) WRITE(*,*) 'Internals:' WRITE(*,*) 'Grp,ipwin, igrpos(1), igrpos(2), igrpos(3)' DO ig=1, ngroup IF ( igrpos(1,ig).GE.0 ) THEN WRITE(*,351) ig,ipwin(ig), : igrpos(1,ig),igrpos(2,ig),igrpos(3,ig) 351 FORMAT(I3,I6,3I10) END IF END DO END IF IF(ctok(1:1).EQ.'S' .OR. ctok(1:1).EQ.'A') THEN IF ( ctok(2:2).EQ.'U' ) THEN WRITE(*,*) WRITE(*,*) 'Subarrays:' WRITE(*,*) 'Grp Icont Image' DO ig=1,MX2D WRITE(*,311) ig,icont(ig),image(ig) 311 FORMAT(I3,I6,I6) END DO ELSE C Info Scales CALL PTBUF(' ', 1) CALL PTBUF('Scales:',-1) CALL PTBUF('Grp Wind Label XData Min'// & ' XData Max YData Min YData Max',-1) DO igroup = 1,ngroup IF ( igrpos(1,igroup).GE.0 ) THEN WRITE(ctmp,321) igroup,ipwin(igroup), : cglab(igroup), : xymnmx(1,igroup),xymnmx(3,igroup), & xymnmx(2,igroup),xymnmx(4,igroup) 321 FORMAT(I3,I6,2X,A10,1P,2(' :',G11.4,', ',G11.4)) CALL PTBUF(ctmp, -1) END IF END DO END IF END IF IF(ctok(1:1).EQ.'W' .OR. ctok(1:1).EQ.'A') THEN C Info Windows WRITE(*,*) WRITE(*,*) 'Windows:' WRITE(*,*) 'Win, logx, logy, gridx, gridy,'// & ' nsubx, nsuby, iwadj' DO i=1,MXWIN IF ( iactw(i).NE.0 ) THEN WRITE(*,331) i,LOGX(i),LOGY(i),gridx(i),gridy(i), & NSUBX(i), NSUBY(i), IWADJ(i) 331 FORMAT(I3,I6,I6,2F9.2,I7,I7,I7) END IF END DO END IF END IF C--- C- Label ------------------------------------------------------------- ELSE IF ( ctok(1:2).EQ.'LA' ) THEN CALL GTCHAR(ctok,ltok) CALL UPC(ctok) IF ( ctok(1:2).EQ.'OF' ) THEN C LAbel OFf IPLAB = IAND(IPLAB,-2) ELSE IF ( ctok(1:2).EQ.'ON' ) THEN C LAbel ON IPLAB = IOR(IPLAB,1) ELSE IF ( ctok(1:2).EQ.'NX' ) THEN C LAbel NX [OF|ON] CALL GTCHAR(ctok, ltok) CALL UPC(ctok) IF(ctok(1:2).EQ.'OF') THEN ION = 0 ELSE ION = 1 END IF CALL GTPEEK(ctmp, ltmp) IF ( ltmp.EQ.0 ) THEN IF ( ION.EQ.0 ) THEN CXOPT(icwin)(5:5) = ' ' ELSE CXOPT(icwin)(5:5) = 'N' END IF ELSE 340 itmp = 0 CALL GTINT(itmp, Ier) IF(1.LE.itmp .AND. itmp.LE.MXWIN) THEN IF(ION.EQ.0) THEN CXOPT(itmp)(5:5) = ' ' ELSE CXOPT(itmp)(5:5) = 'N' END IF GOTO 340 END IF GOTO 100 END IF ELSE IF ( ctok(1:2).EQ.'NY' ) THEN C LAbel NY [OF|ON] CALL GTCHAR(ctok, ltok) CALL UPC(ctok) IF ( ctok(1:2).EQ.'OF' ) THEN ION = 0 ELSE ION = 1 END IF CALL GTPEEK(ctmp, ltmp) IF(ltmp.EQ.0) THEN IF(ION.EQ.0) THEN CYOPT(icwin)(5:5) = ' ' ELSE CYOPT(icwin)(5:5) = 'N' END IF ELSE 350 itmp = 0 CALL GTINT(itmp, Ier) IF(1.LE.itmp .AND. itmp.LE.MXWIN) THEN IF(ION.EQ.0) THEN CYOPT(itmp)(5:5) = ' ' ELSE CYOPT(itmp)(5:5) = 'N' END IF GOTO 350 END IF GOTO 100 END IF ELSE IF(ctok(1:2).EQ.'PA') THEN C LAbel PArameter [ON|OF] CALL GTCHAR(ctok,ltok) CALL UPC(ctok) IF(ctok(1:2).EQ.'OF') THEN IPLAB = IAND(IPLAB,-3) ELSE IF(ctok(1:2).EQ.'ON') THEN IPLAB = IOR(IPLAB,2) ELSE GOTO 590 END IF ELSE IF(ctok(1:2).EQ.'PO') THEN C LAbel POsition CALL GTCHAR(ctok, ltok) CALL UPC(ctok) IF(ctok(1:1).EQ.'Y') THEN CALL GTREAL(PYLAB, Ier) GOTO 100 END IF GOTO 590 ELSE IF(ctok(1:2).EQ.'OT') THEN C LAbel OT CALL GTPEEK(ctmp,ltmp) IF(ctmp(1:1).EQ.'"') THEN CALL GTCHAR(COTLAB(icwin),ltmp) ELSE CALL GTREST(COTLAB(icwin),ltmp) END IF ELSE IF(ctok(1:2).EQ.'OX') THEN C LAbel OX CALL GTPEEK(ctmp,ltmp) IF ( laswin.NE.0 ) THEN itmp = laswin ELSE itmp = icwin END IF IF(ctmp(1:1).EQ.'"') THEN CALL GTCHAR(COXLAB(itmp),ltmp) ELSE CALL GTREST(COXLAB(itmp),ltmp) END IF ELSE IF(ctok(1:2).EQ.'OY') THEN C LAbel OY IF(ltok.GT.2) THEN itmp = FPNUM(ctok(3:ltok),ltok-2,Ier) iwnum = MAX(1,MIN(itmp,MXWIN)) ELSE iwnum = icwin END IF CALL GTPEEK(ctmp,ltmp) IF(ctmp(1:1).EQ.'"') THEN CALL GTCHAR(COYLAB(iwnum),ltmp) ELSE CALL GTREST(COYLAB(iwnum),ltmp) END IF ELSE IF(ctok(1:1).EQ.'R') THEN C LAbel Rotate IF(CYOPT(1)(8:8).EQ.'V') THEN DO iwnum = 1,MXWIN CYOPT(iwnum)(8:8) = ' ' END DO ELSE DO iwnum = 1,MXWIN CYOPT(iwnum)(8:8) = 'V' END DO END IF ELSE IF(ctok(1:1).EQ.'F') THEN C LAbel File CALL GTPEEK(ctmp,ltmp) IF(ctmp(1:1).EQ.'"') THEN CALL GTCHAR(CFNAM(icwin),ltmp) ELSE CALL GTREST(CFNAM(icwin),ltmp) END IF ELSE IF(ctok(1:1).EQ.'T') THEN C LAbel Top IF(ltok.GT.2) THEN itmp = FPNUM(ctok(3:ltok),ltok-2,Ier) iwnum = MAX(1,MIN(itmp,MXWIN)) ELSE iwnum = icwin END IF CALL GTPEEK(ctmp,ltmp) IF(ctmp(1:1).EQ.'"') THEN CALL GTCHAR(CTLAB(iwnum),ltmp) ELSE CALL GTREST(CTLAB(iwnum),ltmp) END IF ELSE IF(ctok(1:1).EQ.'B' .OR. ctok(1:1).EQ.'X') THEN C LAbel X (Bottom) CALL GTPEEK(ctmp,ltmp) IF(ctmp(1:1).EQ.'"') THEN CALL GTCHAR(ctok,ltok) ELSE CALL GTREST(ctok,ltok) END IF IF ( laswin.NE.0 ) THEN CXLAB(laswin) = ctok ELSE CXLAB(icwin) = ctok END IF ELSE IF(ctok(1:1).EQ.'L' .OR. : (ltok.EQ.1 .AND. ctok(1:1).EQ.'Y')) THEN IF(ctmp(1:1).EQ.'"') THEN CALL GTCHAR(CYLAB(icwin),ltmp) ELSE CALL GTREST(CYLAB(icwin),ltmp) END IF ELSE IF(ctok(1:1).EQ.'G' .OR. ctok(1:1).EQ.'Y') THEN IF(ltok.GT.1) THEN igroup = FPNUM(ctok(2:ltok),ltok-1,Ier) igroup = MAX(1,MIN(igroup,MXGRP-MXMOD)) ELSE igroup = icwin END IF CALL GTPEEK(ctmp,ltmp) IF(ctmp(1:1).EQ.'"') THEN CALL GTCHAR(cglab(igroup),ltmp) ELSE CALL GTREST(cglab(igroup),ltmp) END IF ELSE IF(ISNUM(ctok,ltok).NE.0) THEN C LAbel # iclab = FPNUM(ctok,ltok,Ier) IF(iclab.LE.0 .OR. iclab.GT.MXLAB) GOTO 590 360 CALL GTPEEK(ctmp,ltmp) IF(ctmp(1:1).EQ.' ') GOTO 100 CALL UPC(ctmp) IF(ctmp(1:2).EQ.'TE') THEN C Skip the command CALL GTCHAR(ctmp,itmp) C but get everything else on line CALL GTREST(CLABEL(iclab),itmp) IF(itmp.LE.0) THEN ILABEL(1,iclab) = 0 ELSE IF(ILABEL(1,iclab).EQ.0) THEN ILABEL(1,iclab) = icwin END IF ELSE IF(ctmp(1:1).EQ.'"') THEN CALL GTCHAR(CLABEL(iclab),itmp) IF(itmp.LE.0) THEN ILABEL(1,iclab) = 0 ELSE IF(ILABEL(1,iclab).EQ.0) THEN ILABEL(1,iclab) = icwin END IF ELSE CALL GTCHAR(ctok,ltok) CALL UPC(ctok) IF(ctok(1:2).EQ.'CE') THEN CALL GTCHAR(ctok,ltok) CALL UPC(ctok) IF(ctok(1:1).EQ.'T') THEN ILABEL(3,iclab) = 1 ELSE IF(ctok(1:1).EQ.'C') THEN ILABEL(3,iclab) = 2 ELSE IF(ctok(1:1).EQ.'H') THEN ILABEL(3,iclab) = 3 ELSE IF(ctok(1:2).EQ.'BA') THEN ILABEL(3,iclab) = 4 ELSE IF(ctok(1:2).EQ.'BO') THEN ILABEL(3,iclab) = 5 ELSE GOTO 590 END IF ELSE IF(ctok(1:2).EQ.'CO') THEN CALL GTINT(ILABEL(4,iclab),Ier) ELSE IF(ctok(1:2).EQ.'CS') THEN FLABEL(4,iclab) = 1.0 CALL GTREAL(FLABEL(4,iclab),Ier) ELSE IF(ctok(1:1).EQ.'J') THEN CALL GTCHAR(ctok,ltok) CALL UPC(ctok) IF(ctok(1:1).EQ.'C') THEN ILABEL(2,iclab) = 2 ELSE IF(ctok(1:1).EQ.'L') THEN ILABEL(2,iclab) = 1 ELSE IF(ctok(1:1).EQ.'R') THEN ILABEL(2,iclab) = 3 ELSE GOTO 590 END IF ELSE IF(ctok(1:2).EQ.'LS') THEN CALL GTINT(ILABEL(5,iclab),Ier) ELSE IF(ctok(1:1).EQ.'L') THEN ilabel(7,iclab) = 0 CALL GTCHAR(ctok,ltok) IF(ISNUM(ctok,ltok).EQ.0) THEN ILABEL(2,iclab) = 2 ILABEL(3,iclab) = 3 FLABEL(6,iclab) = 0. ELSE FLABEL(5,iclab) = FPNUM(ctok,ltok,Ier) CA = COS(FLABEL(5,iclab)/RTD) SA = SIN(FLABEL(5,iclab)/RTD) IF(CA.GT..707) THEN ILABEL(2,iclab) = 1 ELSE IF(CA.GT.-.707) THEN ILABEL(2,iclab) = 2 ELSE ILABEL(2,iclab) = 3 END IF IF(SA.GT..707) THEN ILABEL(3,iclab) = 5 ELSE IF(SA.GT.-.707) THEN ILABEL(3,iclab) = 3 ELSE ILABEL(3,iclab) = 1 END IF C- Get optional length. FLABEL(6,iclab) = .08 CALL GTPEEK(ctmp,ltmp) IF(ISNUM(ctmp,ltmp).NE.0) THEN CALL GTREAL(FLABEL(6,iclab),Ier) END IF END IF ELSE IF(ctok(1:2).EQ.'MS') THEN CALL GTREAL(FLABEL(7,iclab), Ier) FLABEL(7,iclab) = MAX(0.,MIN(FLABEL(7,iclab),5.)) ELSE IF(ctok(1:1).EQ.'M') THEN ILABEL(6,iclab) = -1 CALL GTINT(ILABEL(6,iclab),Ier) IF(ILABEL(6,iclab).LT.0) THEN ILABEL(2,iclab) = 2 ELSE ILABEL(2,iclab) = 1 END IF ELSE IF(ctok(1:1).EQ.'P') THEN CALL GTPEEK(ctmp,ltmp) CALL UPC(ctmp) ILABEL(1,iclab) = icwin IF(ctmp(1:1).EQ.'C') THEN CLAbel # Pos C CALL GTCHAR(ctmp,ltmp) CALL PLTCUR(WINLOC, BOXVP, XYSCAL, MXWIN, : LOGX, LOGY, iactw, iwadj, iwnum, : VIEWX, VIEWY, WINX, WINY, ctmp) FLABEL(1,iclab) = WINX FLABEL(2,iclab) = WINY ELSE CALL GTPEEK(ctmp,ltmp) C Special case trap for a real number entered as #e... where # is a single integer C because GTPEEK only returns the first two characters of the token and ISNUM C checks for a number by checking that the first and last characters are integers. IF(ISNUM(ctmp, ltmp).EQ.0 & .AND. ctmp(2:2).NE.'e' .AND. ctmp(2:2).NE.'E' & ) THEN CALL PTBUF('Position expects two numbers, got "'// & ctmp(:ltmp)//'".',-1) CALL GTCHAR(ctmp,ltmp) GOTO 360 END IF CALL GTREAL(FLABEL(1,iclab),Ier) CALL GTREAL(FLABEL(2,iclab),Ier) END IF ELSE IF(ctok(1:1).EQ.'R') THEN CALL GTREAL(FLABEL(3,iclab),Ier) ELSE IF(ctok(1:1).EQ.'T') THEN ilabel(7,iclab) = 1 CALL GTREAL(FLABEL(5,iclab),Ier) CALL GTREAL(FLABEL(6,iclab),Ier) ELSE IF(ctok(1:1).EQ.'V') THEN CALL GTPEEK(ctmp,ltmp) CALL UPC(ctmp) ILABEL(1,iclab) = -1 IF(ctmp(1:1).EQ.'C') THEN C- Read cursor (flush current token) CALL GTCHAR(ctmp,ltmp) CALL PLTCUR(WINLOC, BOXVP, XYSCAL, MXWIN, : LOGX, LOGY, iactw, iwadj, iwnum, : VIEWX, VIEWY, WINX, WINY, ctmp) FLABEL(1,iclab) = VIEWX FLABEL(2,iclab) = VIEWY ELSE CALL GTREAL(FLABEL(1,iclab),Ier) CALL GTREAL(FLABEL(2,iclab),Ier) END IF ELSE CALL PTBUF('Bad sub-command: "'//ctok(:ltok)//'"',-1) END IF END IF GOTO 360 ELSE GOTO 590 END IF C--- C- L ----------------------------------------------------------------- ELSE IF(ctok(1:1).EQ.'L') THEN IF(ctok(1:3).EQ.'LOC') THEN C- LOCation ---------------------------------------------------------- DO I = 1,4 CALL GTREAL(WINLOC(I,icwin), Ier) END DO ELSE IF(ctok(1:2).EQ.'LI') THEN C- line -------------------------------------------------------------- CALL GTCHAR(ctok,ltok) CALL UPC(ctok) IF(ctok(1:1).EQ.'S') THEN C line Step itmp = -1 ELSE IF(ctok(1:2).EQ.'ON') THEN C line ON itmp = +1 ELSE IF(ctok(1:2).EQ.'OF') THEN C line OFF itmp = 0 ELSE IF(ISNUM(ctok,ltok).NE.0) THEN C line # itmp = FPNUM(ctok, ltok, Ier) IF(ABS(itmp).LE.1) GOTO 590 CALL GTPEEK(ctok,ltok) ELSE GOTO 590 END IF C get next token. CALL GTCHAR(ctok,ltok) CALL UPC(ctok) IF(ltok.GE.2 .AND. ctok(1:2).EQ.'ON') THEN C Skip optional ON, as in line Step ON..., or line # ON... CALL GTCHAR(ctok,ltok) END IF 370 CALL IRANGE(ctok,ltok,1,MXGRP-MXMOD,ILO,IHI,Ier) ILO = MAX(1,MIN(ILO,MXGRP-MXMOD)) IHI = MAX(1,MIN(IHI,MXGRP-MXMOD)) DO ig= ILO,IHI line(ig) = itmp END DO CALL GTCHAR(ctok,ltok) IF(ltok.GT.0) GOTO 370 ELSE IF(ctok(1:2).EQ.'LO') THEN C- LOg --------------------------------------------------------------- CALL PLOGER(ctok, ltok, idoall, icwin, MXWIN, : CXOPT, LOGX, CYOPT, LOGY, Ier) IF(Ier.NE.0) GOTO 590 ELSE IF(ctok(1:2).EQ.'LS') THEN C- LS (line Style) --------------------------------------------------- CALL GTCHAR(ctok,ltok) IF ( ctok(1:1).EQ.'?' ) THEN CALL PLTSLS(-1) GOTO 100 END IF new = 1 IF ( ltok.GT.0 ) new = FPNUM(ctok,ltok,Ier) CALL GTPEEK(ctok,ltok) CALL UPC(ctok) IF ( ctok(1:1).EQ.'O' ) THEN C Skip optional ON/OFf. CALL GTCHAR(ctok,ltok) END IF C LS # [ON] 380 CALL GTCHAR(ctok, ltok) IF(ltok.GT.0) THEN CALL UPC(ctok) IF(ctok(1:1).EQ.'G') THEN IGLS = new ELSE IF(ctok(1:1).EQ.'M') THEN lsty(MXGRP-MXMOD+ICMOD) = new ELSE CALL IRANGE(ctok,ltok,1,MXGRP-MXMOD,ILO,IHI,Ier) ILO = MAX(1,MIN(ILO,MXGRP-MXMOD)) IHI = MAX(1,MIN(IHI,MXGRP-MXMOD)) DO I = ILO, IHI lsty(I) = new END DO END IF GOTO 380 END IF C--- C- LW (line Width) --------------------------------------------------- ELSE IF(ctok(1:2).EQ.'LW') THEN TMP = 0. CALL GTREAL(TMP,Ier) IF(TMP.LT.0. .AND. 15.LT.TMP) THEN WRITE(*,*) 'LW not changed, must be in range of 1 to 15.' GOTO 100 END IF CALL GTPEEK(ctok,ltok) IF(ltok.EQ.0) THEN WIDTH = TMP ELSE CALL UPC(ctok) IF(ctok(1:1).EQ.'O') THEN C Skip optional ON/OFf. CALL GTCHAR(ctok,ltok) END IF C LW # [ON] # 390 CALL GTCHAR(ctok,ltok) IF(ltok.GT.0) THEN CALL UPC(ctok) IF(ctok(1:1).EQ.'M') THEN widlin(MXGRP-MXMOD+ICMOD) = TMP ELSE CALL IRANGE(ctok,ltok,1,MXGRP-MXMOD,ILO,IHI,Ier) ILO = MAX(1,MIN(ILO,MXGRP-MXMOD)) IHI = MAX(1,MIN(IHI,MXGRP-MXMOD)) DO I = ILO, IHI widlin(I) = TMP END DO END IF GOTO 390 END IF END IF END IF C--- C- M ----------------------------------------------------------------- ELSE IF(ctok(1:1).EQ.'M') THEN IF(ctok(1:2).EQ.'MA') THEN C- MArker ------------------------------------------------------------ CALL GTCHAR(ctok,ltok) CALL UPC(ctok) C- First get the marker type. IF(ISNUM(ctok,ltok).NE.0) THEN RMARK = FPNUM(ctok,ltok,Ier) CALL GTCHAR(ctok,ltok) CALL UPC(ctok) ELSE IF(ctok(1:1).EQ.'S') THEN C MArker Size CALL GTREAL(TMP,Ier) TMP = MAX(0.,MIN(TMP,5.)) CALL GTCHAR(ctok,ltok) CALL UPC(ctok) ILO = 1 IHI = ngroup IF(ltok.GE.2 .AND. ctok(1:2).EQ.'ON') THEN CALL GTINT(ILO, Ier) IHI = ILO CALL GTINT(IHI, Ier) END IF DO ig = ILO,IHI szmark(ig) = TMP END DO GOTO 100 ELSE IF(ctok(1:1).EQ.'?') THEN IF(IOPEN.NE.0) THEN CALL PLTMAR ELSE WRITE(*,*) 'No graphics device available.' END IF GOTO 100 ELSE RMARK = NO END IF C- Now get ON/OFf flag. IF(ctok(1:2).EQ.'ON') THEN itmp = 1 ELSE IF(ctok(1:2).EQ.'OF') THEN itmp = 0 ELSE GOTO 590 END IF C- Finally the vectors to mark CALL GTCHAR(ctok,ltok) C--- 400 CONTINUE CALL IRANGE(ctok,ltok,1,MXGRP-MXMOD,ILO,IHI,Ier) ILO = MAX(1,MIN(ILO,MXGRP-MXMOD)) IHI = MAX(1,MIN(IHI,MXGRP-MXMOD)) DO ig= ILO,IHI ipmark(ig) = itmp IF(RMARK.NE.NO) imark(ig) = RMARK END DO CALL GTCHAR(ctok,ltok) IF(ltok.GT.0) GOTO 400 C--- C- MMaster ----------------------------------------------------------- ELSE IF ( ctok(1:2).EQ.'MM' ) THEN C MMaster iwin X|Y|XY wlist iwnum = 0 CALL GTINT(iwnum, ier) IF ( iwnum.LE.0 .OR. MXWIN.LT.iwnum ) THEN WRITE(*,401) MXWIN 401 FORMAT(' Window number must be in range 1 to ',I5,'.') GOTO 100 END IF ctok = ' ' CALL GTCHAR(ctok, ltok) CALL UPC(ctok) IF ( ctok(1:1).EQ.'O' ) THEN DO i=1,MXWIN IF ( imaster(1,i).EQ.iwnum ) imaster(1,i) = 0 IF ( imaster(2,i).EQ.iwnum ) imaster(2,i) = 0 END DO imaster(1,iwnum) = 0 imaster(2,iwnum) = 0 GOTO 100 END IF C- Find the list of slave windows 410 CALL GTCHAR(cscr1, lscr1) IF ( lscr1.LE.0 ) THEN IF ( INDEX(ctok,'X').GT.0 ) THEN imaster(1, iwnum) = -1 END IF IF ( INDEX(ctok,'Y').GT.0 ) THEN imaster(2, iwnum) = -1 END IF ELSE CALL IRANGE(cscr1,lscr1,1,MXWIN,ILO,IHI,Ier) ILO = MAX(1,MIN(ILO,MXWIN)) IHI = MAX(1,MIN(IHI,MXWIN)) DO I = ILO,IHI IF ( i.NE.iwnum ) THEN IF ( INDEX(ctok,'X').GT.0 ) THEN imaster(1, i) = iwnum xyscal(1,i) = xyscal(1,iwnum) xyscal(3,i) = xyscal(3,iwnum) END IF IF ( INDEX(ctok,'Y').GT.0 ) THEN imaster(2, i) = iwnum xyscal(2,i) = xyscal(2,iwnum) xyscal(4,i) = xyscal(4,iwnum) END IF END IF END DO GOTO 410 END IF C--- C- MOdel ------------------------------------------------------------- ELSE IF(ctok(1:2).EQ.'MO') THEN IF ( IOPEN.LT.0 ) CALL PLTTER('A') CALL GTPEEK(ctok,ltok) IF ( ISNUM(ctok,ltok).NE.0 ) THEN CALL GTINT(ICMOD, Ier) ICMOD = MIN(MAX(1,ICMOD),MXMOD) CALL GTPEEK(ctok, ltok) IF(ltok.LE.0) GOTO 100 END IF C C Figure out MIN/MAX in both X and Y for window containing fit group. CALL FITVIS(ipwin, ngroup, ifitg(icmod)) pmin(1) = MIN(xyscal(1,ipwin(ifitg(icmod))), & XYSCAL(3,ipwin(ifitg(icmod)))) pmax(1) = MAX(xyscal(1,ipwin(ifitg(icmod))), & XYSCAL(3,ipwin(ifitg(icmod)))) pmin(2) = MIN(xyscal(2,ipwin(ifitg(icmod))), & XYSCAL(4,ipwin(ifitg(icmod)))) pmax(2) = MAX(xyscal(2,ipwin(ifitg(icmod))), & XYSCAL(4,ipwin(ifitg(icmod)))) C C Pass subcommend to MODEL routine CALL GTREST(ctok,ltok) ctmp = 'MO '//ctok CALL MODEL(ctmp,pmin,pmax,MXPAR,Cmd,Ncmd,Icmd, : ICOMP(1,ICMOD),PVAL(1,ICMOD),PLIM(1,1,ICMOD),nterm(ICMOD)) IF ( nterm(ICMOD).GT.0 ) THEN ipwin(MXGRP-MXMOD+icmod) = ipwin(ifitg(icmod)) ipmod(MXGRP-MXMOD+icmod) = icmod igrpos(1, MXGRP-MXMOD+icmod) = igrpos(1, ifitg(icmod)) igrpos(2, MXGRP-MXMOD+icmod) = igrpos(2, ifitg(icmod)) igrpos(3, MXGRP-MXMOD+icmod) = igrpos(3, ifitg(icmod)) ipyer(MXGRP-MXMOD+icmod) = ipyer(ifitg(icmod)) newmod = icmod END IF END IF C--- C- Newpar ------------------------------------------------------------ ELSE IF(ctok(1:1).EQ.'N') THEN C- If NO is combined with a operation (* / + -) then it will C- be treated as a command. Warn user by checking here. IF(ltok.GT.1 .AND. ctok(2:2).NE.'E') GOTO 590 IF(nterm(ICMOD).LE.0) THEN WRITE(*,411) 411 FORMAT(' No model defined.') ELSE IF(IOPEN.LT.0) CALL PLTTER('A') CALL GTREST(ctok,ltok) ctmp = 'NE '//ctok CALL MODEL(ctmp,pmin,pmax,MXPAR,Cmd,Ncmd,Icmd, & ICOMP(1,ICMOD),PVAL(1,ICMOD),PLIM(1,1,ICMOD),nterm(ICMOD)) newmod = icmod END IF C--- C- Overlay ----------------------------------------------------------- ELSE IF(ctok(1:1).EQ.'O') THEN ICLEAR = 0 GOTO 610 C--- C- P ----------------------------------------------------------------- ELSE IF(ctok(1:1).EQ.'P') THEN IF(ctok(1:2).EQ.'PA') THEN C- PAper ------------------------------------------------------------- CALL GTREAL(PGPAPW, Ier) CALL GTREAL(PGPAPA, Ier) IF ( iopen.NE.0 ) THEN CALL PGPAP(PGPAPW/2.54,PGPAPA) END IF ELSE IF(ctok(1:2).EQ.'PR') THEN C- PRompt ------------------------------------------------------------ CALL GTCHAR(CPROM,LPROM) C- Plot -------------------------------------------------------------- ELSE CALL GTCHAR(ctok,ltok) CALL UPC(ctok) ICLEAR = 1 IF(ltok.LE.0 ) GOTO 610 IF(ctok(1:1).EQ.'A') THEN QALL = .TRUE. ELSE IF(ctok(1:1).EQ.'G') THEN QALL = .FALSE. ELSE IF(ctok(1:1).EQ.'O') THEN C- Plot Overlay. Plot all groups in window 1, full screen, numeric labs DO ig= 1,ngroup IF ( ipwin(ig).GT.0 ) ipwin(ig) = 1 END DO CALL ACTWIN(ipwin,ngroup,MXWIN,iactw) WINLOC(2,1) = 0. WINLOC(4,1) = 1. CXOPT(1)(5:5) = 'N' C Restore top label of top window, to be master top label IF(icwin.NE.1 .AND. LENACT(CTLAB(icwin)).NE.0) THEN CTLAB(1) = CTLAB(icwin) CTLAB(icwin) = ' ' END IF C Restore file label of top window, to be master top label IF(icwin.NE.1 .AND. LENACT(CFNAM(icwin)).NE.0) THEN CFNAM(1) = CFNAM(icwin) CFNAM(icwin) = ' ' END IF C Restore X label of bottom window, to be master X label IF(icwin.NE.1 .AND. laswin.NE.0 ) THEN IF ( LENACT(CXLAB(laswin)).NE.0 ) THEN CXLAB(1) = CXLAB(laswin) CXLAB(icwin) = ' ' END IF END IF icwin = 1 LASWIN = 0 ELSE IF(ctok(1:1).EQ.'V') THEN C- Plot Vert. NVERT counts the number of active windows. NVERT = 0 itmp = 0 C Assign one window to each group that is being plotted. For C compatibility number the windows by the group being plotted in that C window. Default lastwin to 1 in case there are no active windows. laswin = 1 DO igroup = 1,MIN(ngroup,MXWIN) IF ( ipwin(igroup).GT.0 ) THEN IF(itmp.EQ.0) itmp = igroup ipwin(igroup) = igroup NVERT = NVERT+1 LASWIN = igroup END IF END DO C Move top label to top label of the top window. IF(icwin.NE.itmp .AND. LENACT(CTLAB(icwin)).NE.0) THEN CTLAB(itmp) = CTLAB(icwin) CTLAB(icwin) = ' ' END IF C Move file label to top label of the top window. IF(icwin.NE.itmp .AND. LENACT(CFNAM(icwin)).NE.0) THEN CFNAM(itmp) = CFNAM(icwin) CFNAM(icwin) = ' ' END IF C Move X label to be X label of bottom window. IF(icwin.NE.itmp .AND. LENACT(CXLAB(icwin)).NE.0) THEN CXLAB(laswin) = CXLAB(icwin) CXLAB(icwin) = ' ' END IF C Generate active window list. CALL ACTWIN(ipwin,ngroup,MXWIN,iactw) C new current window icwin = itmp TMP = (BOXVP(4,1)-BOXVP(2,1))/NVERT itmp = NVERT DO iwnum = 1,MXWIN IF(iactw(iwnum).GT.0) THEN TMP1 = BOXVP(2,1)+TMP*itmp-TMP/2. WINLOC(4,iwnum) = TMP1+1./(2.*NVERT) WINLOC(2,iwnum) = TMP1-1./(2.*NVERT) IF(itmp.GT.1) itmp = itmp-1 CXOPT(iwnum)(5:5) = ' ' END IF END DO CXOPT(LASWIN)(5:5) = 'N' ELSE IF(ctok(1:1).EQ.'Z') THEN C Plot Zero CALL GTCHAR(ctok,ltok) CALL UPC(ctok) IF(ctok(1:2).EQ.'ON') THEN IPZERO = 1 ELSE IF(ctok(1:2).EQ.'OF') THEN IPZERO = 0 ELSE GOTO 590 END IF ELSE GOTO 590 END IF END IF C--- C- Rescale ----------------------------------------------------------- ELSE IF(ctok(1:1).EQ.'R') THEN ICLEAR = 1 CALL GTPEEK(ctok,ltok) CALL UPC(ctok) IF(ctok(1:1).EQ.'?') THEN IF(IOPEN.LT.0) CALL PLTTER('A') IF ( IGAP.EQ.0 ) THEN WRITE(*,421) RGAP,'NoErrors' ELSE WRITE(*,421) RGAP,'Errors' END IF 421 FORMAT(' Current Gap = ',F7.3,5X,A,/,'Window',3X, : 'XLAB XMIN XMAX',9X, : 'YLAB YMIN YMAX') DO 440 iwnum = 1,MXWIN IF(iactw(iwnum).LE.0) GOTO 440 ctok = CXLAB(iwnum) IF ( LENACT(ctok).LE.0 ) THEN IF ( ixvec.NE.0 ) ctok = cglab(ixvec) END IF ctmp = CYLAB(iwnum) IF ( LENACT(ctmp).LE.0 ) THEN igroup = IFGRP(ipwin, MXGRP-MXMOD, iwnum) IF(igroup.EQ.0) igroup = 2 ctmp = cglab(igroup) END IF WRITE(*,431) iwnum,ctok,XYSCAL(1,iwnum),XYSCAL(3,iwnum), : ctmp,XYSCAL(2,iwnum),XYSCAL(4,iwnum) 431 FORMAT(1X,I3,' : ',A10,1PG11.4,',',G11.4,' : ', : A10,G11.4,',',G11.4) 440 CONTINUE GOTO 100 ELSE IF(ctok(1:1).EQ.'X') THEN C- R X CALL GTCHAR(ctok,ltok) iwnum = icwin IF(ltok.GT.1) THEN C- R X# itmp = FPNUM(ctok(2:ltok),ltok-1,Ier) IF(1.LE.itmp .AND. itmp.LE.MXWIN) iwnum = itmp END IF CALL GTPEEK(ctmp,ltmp) CALL UPC(ctmp) IF(ltmp.LE.0) THEN C- R X resets X-limits. XYSCAL(1,iwnum) = NO XYSCAL(3,iwnum) = NO ELSE IF(ctmp(1:1).EQ.'C') THEN C- R X Curs CALL PLTCUR(WINLOC, BOXVP, XYSCAL, MXWIN, : LOGX, LOGY, iactw, iwadj, iwnum, : VIEWX, VIEWY, WINX, WINY, ctmp) XYSCAL(1,iwnum) = WINX CALL PLTCUR(WINLOC, BOXVP, XYSCAL, MXWIN, : LOGX, LOGY, iactw, iwadj, itmp, : VIEWX, VIEWY, WINX, WINY, ctmp) XYSCAL(3,iwnum) = WINX ELSE C- R X # # CALL GTREAL(XYSCAL(1,iwnum),Ier) CALL GTREAL(XYSCAL(3,iwnum),Ier) END IF IF(idoall.NE.0) THEN DO I = 1,MXWIN XYSCAL(1,I) = XYSCAL(1,iwnum) XYSCAL(3,I) = XYSCAL(3,iwnum) END DO END IF IF(ltok.GT.1) GOTO 100 ELSE IF(ctok(1:1).EQ.'Y') THEN CALL GTCHAR(ctok,ltok) iwnum = icwin IF(ltok.GT.1) THEN C- R Y# itmp = FPNUM(ctok(2:ltok),ltok-1,Ier) IF(1.LE.itmp .AND. itmp.LE.MXWIN) iwnum = itmp END IF CALL GTPEEK(ctmp,ltmp) IF(ltmp.LE.0) THEN C- R Y XYSCAL(2,iwnum) = NO XYSCAL(4,iwnum) = NO ELSE C- R Y # # CALL GTREAL(XYSCAL(2,iwnum),Ier) CALL GTREAL(XYSCAL(4,iwnum),Ier) END IF IF(idoall.NE.0 .AND. iwnum.EQ.ixvec .AND. ltok.GT.1) THEN DO I = 1,MXWIN XYSCAL(1,I) = XYSCAL(2,iwnum) XYSCAL(3,I) = XYSCAL(4,iwnum) END DO END IF IF(ltok.GT.1) GOTO 100 ELSE IF(ltok.LE.0) THEN C- R resets both X and Y limits. XYSCAL(1,icwin) = NO XYSCAL(2,icwin) = NO XYSCAL(3,icwin) = NO XYSCAL(4,icwin) = NO ELSE C- R # # # # CALL GTREAL(XYSCAL(1,icwin),Ier) CALL GTREAL(XYSCAL(3,icwin),Ier) CALL GTREAL(XYSCAL(2,icwin),Ier) CALL GTREAL(XYSCAL(4,icwin),Ier) END IF GOTO 600 C--- C- SCr --------------------------------------------------------------- C Set Color Representation. ELSE IF(ctok(1:2).EQ.'SC') THEN CALL GTPEEK(ctmp, ltmp) IF ( ISNUM(ctmp, ltmp).EQ.0 ) THEN CALL GTCHAR(ctok, ltok) CALL UPC(ctok(:ltok)) IF ( ctok(1:1).EQ.'B' ) THEN ibcol = -1 ELSE IF ( ctok(1:1).EQ.'D' ) THEN ibcol = 0 ELSE IF ( ctok(1:1).EQ.'W' ) THEN ibcol = +1 ELSE GOTO 590 END IF IF ( iopen.NE.0 ) THEN CALL PLTOP1(ibcol) END IF GOTO 100 END IF CALL GTINT(IND,Ier) CALL GTREAL(RED,Ier) CALL GTREAL(GRN,Ier) CALL GTREAL(BLU,Ier) C If device has not been opened then force it open. IF ( IOPEN.EQ.0 ) THEN IF ( cpfile.EQ.' ' ) THEN IF ( ITRANS.EQ.0 ) THEN ITRANS = 1 CALL TRLOG('PGPLOT_TYPE',11,cpfile,LPFILE) END IF END IF CALL PLTOPE(cpfile,ibcol,scrcol,cfont,pgpapw,pgpapa,Ier) IF(Ier.NE.0) THEN cpfile = ' ' LPFILE = 0 GOTO 100 END IF IOPEN = 1 CALL PGQINF('TERMINAL',ctok,ltok) IF(ctok(1:1).EQ.'Y') IOPEN = -1 END IF IF ( red.NE.NO ) THEN C In case we have a pseudo color device, we update immediately. CALL PGSCR(IND,RED,GRN,BLU) END IF IF ( 0.LE.ind .AND. ind.LE.15 ) THEN scrcol(1,ind)=red scrcol(2,ind)=grn scrcol(3,ind)=blu END IF CALL PGUPDT C--- C- SEt -------------------------------------------------------------- ELSE IF(ctok(1:2).EQ.'SE') THEN CALL GTCHAR(ctok, ltok) CALL UPC(ctok(:ltok)) IF ( ctok(1:2).EQ.'LE' ) THEN CALL GTINT(itmp, ier) CALL wrqsl(itmp) ENDIF C--- C- SHow -------------------------------------------------------------- ELSE IF(ctok(1:2).EQ.'SH') THEN CALL wrqdl(itmp) C--- C- SKip -------------------------------------------------------------- ELSE IF(ctok(1:2).EQ.'SK') THEN CALL GTCHAR(ctok,ltok) CALL UPC(ctok) IF(ctok(1:1).EQ.'S' .OR. ctok(1:2).EQ.'ON') THEN C- SKip Single IF ( ixvec.EQ.0 ) THEN WRITE(*,441) 441 FORMAT(' Error: Not allowed to SKip linear plots.') GOTO 100 END IF iskip = 1 ipwin(ixvec) = ABS(ipwin(ixvec)) ELSE IF(ctok(1:1).EQ.'D') THEN C- SKip Double IF ( ixvec.EQ.0 ) THEN WRITE(*,441) GOTO 100 END IF iskip = 2 ipwin(ixvec) = ABS(ipwin(ixvec)) ELSE IF(ctok(1:1).EQ.'O') THEN C- SKip Off ipwin(ixvec) = -ipwin(ixvec) iskip = 0 ELSE GOTO 590 END IF C--- C If skip actually changed, then make re-initialize data. IF ( iskip.NE.imnmx ) THEN DO I = 1,MXWIN XYSCAL(2,I) = NO XYSCAL(4,I) = NO END DO C- If SKIP is on, then scan through X vector looking for breaks. IF ( iskip.NE.0 ) THEN CALL PLTSKP(Yray, Iery, Mxrow, Npts, Nvec, MXGRP-MXMOD, & iskip, ixvec, ngroup, igrpos, ipyer, ipwin) DO I = 1,MXWIN XYSCAL(1,I) = NO END DO ELSE C Skip has been turn off ngroup = MIN(Nvec,MXGRP-MXMOD) DO ig= 1,ngroup IF ( ipwin(ig).LT.0 .AND. ig.NE.ixvec ) THEN ipwin(ig)=ABS(ipwin(ig)) END IF ipyer(ig) = MIN(Iery(ig),1) CALL PLTXCN(ig, 1, 0) itmp = iofset(ixvec, Iery, ixvec, Mxrow) CALL PLTXCG(ig, 1, ixvec, itmp, iery) igrpos(1,ig) = IOFSET(ig, Iery, Nvec, Mxrow) igrpos(2,ig) = Npts igrpos(3,ig) = ig END DO END IF CALL ACTWIN(ipwin,ngroup,MXWIN,iactw) END IF C--- C- STatistic ---------------------------------------------------------- ELSE IF(ctok(1:2).EQ.'ST') THEN C default to the group being fitted. itmp = ifitg(icmod) CALL FITVIS(ipwin, ngroup, itmp) CALL GTINT(itmp,Ier) CALL PLTXCC(Yray, 1, itmp, xt, ndim, iyoff) itmp = MIN( MAX(1,itmp), MXGRP-MXMOD) pmin(1) = MIN(XYSCAL(1,ipwin(itmp)),XYSCAL(3,ipwin(itmp))) pmax(1) = MAX(XYSCAL(1,ipwin(itmp)),XYSCAL(3,ipwin(itmp))) pmin(2) = MIN(XYSCAL(2,ipwin(itmp)),XYSCAL(4,ipwin(itmp))) pmax(2) = MAX(XYSCAL(2,ipwin(itmp)),XYSCAL(4,ipwin(itmp))) WRITE(*,451) itmp,pmin(1),pmax(1) 451 FORMAT(' Group',I3,', from ',1PG11.4,' to ',G11.4) IF ( ndim.GT.1 ) WRITE(*,501) pmin(2),pmax(2) 501 FORMAT(' and in Y by ',1PG11.4,' to ',G11.4) WRITE(*,*) C CALL PLTXCE(Yray, 1, itmp, 1, xmerr, xperr) IF ( xperr.NE.0.0 ) THEN lerx = 1 ELSE lerx = 0 END IF lery = ipyer(itmp) CALL MOMENT(1, Yray, lery, Mxrow, itmp, igrpos(1,itmp), & igrpos(2,itmp), pmin, pmax, TOT, Ier) WRITE(*,*) IF ( ixvec.EQ.0 .OR. lerx.GT.0 ) THEN IF ( ndim.EQ.1 ) THEN WRITE(*,*) ' Sum of Y*XDEL = ',TOT(14) ELSE WRITE(*,*) ' Sum of Y*XDEL*YDEL = ',TOT(14) END IF END IF IF ( TOT(1).GT.1.0 .AND. ndim.EQ.1 ) THEN DEM = (TOT(1)*TOT(6))*(TOT(1)*TOT(3)) IF(DEM.LE.0.) THEN WRITE(*,*) 'ERROR--DEM = ',DEM ELSE COR = TOT(1)*TOT(7)/SQRT(DEM) WRITE(*,*) 'Correlation coeff. = ',COR END IF END IF WRITE(*,*) C--- C- THaw -------------------------------------------------------------- ELSE IF(ctok(1:2).EQ.'TH') THEN IF(nterm(ICMOD).LE.0) THEN WRITE(*,411) ELSE CALL GTREST(ctok,ltok) ctmp = 'TH '//ctok CALL MODEL(ctmp,pmin,pmax,MXPAR,Cmd,Ncmd,Icmd, & ICOMP(1,ICMOD),PVAL(1,ICMOD),PLIM(1,1,ICMOD),nterm(ICMOD)) END IF C--- C- Time -------------------------------------------------------------- ELSE IF(ctok(1:1).EQ.'T') THEN CALL GTCHAR(ctok,ltok) CALL UPC(ctok) IF(ctok(1:2).EQ.'ON') ITIME = 1 IF(ctok(1:2).EQ.'OF') ITIME = 0 C--- C- U ----------------------------------------------------------------- ELSE IF(ctok(1:1).EQ.'U') THEN IF(ctok(1:2).EQ.'UP') THEN C- Upper ------------------------------------------------------------- CALL GTREAL(Fnew, Ier) C Skip the ON keyword CALL GTCHAR(ctmp, ltmp) C- Now get [glist] 500 CONTINUE CALL GTCHAR(ctok,ltok) IF(ltok.LE.0) GOTO 100 CALL UPC(ctok) CALL IRANGE(ctok,ltok,1,ngroup,ILO,IHI,Ier) IF(ILO.LT.1 .OR. IHI.LT.1) GOTO 590 ILO = MAX(1,MIN(ILO,ngroup)) IHI = MAX(1,MIN(IHI,ngroup)) DO ig = ILO, IHI flimit(ig) = Fnew END DO GOTO 500 ELSE C- Uncertainty ------------------------------------------------------- CALL GTREST(ctok,ltok) ctmp = 'U '//ctok IF ( IOPEN.LT.0 ) CALL PLTTER('A') C Check that user has fit something prior. IF ( nterm(icmod).LE.0 ) THEN WRITE(*,*) 'ERROR--Must first fit the data.' GOTO 100 END IF CALL FIT(ctmp, ifitg(icmod), Yray, Mxrow, ngroup, icwin, : ipwin, ipyer, ipwin, igrpos, XYSCAL, ICOMP(1,ICMOD), : PVAL(1,ICMOD), PLIM(1,1,ICMOD), nterm(ICMOD)) END IF C--- C- V ----------------------------------------------------------------- ELSE IF(ctok(1:1).EQ.'V') THEN IF(ctok(1:2).EQ.'VE') THEN C- VErsion ----------------------------------------------------------- IF(IOPEN.LT.0) CALL PLTTER('A') CALL PLTVER(ctok, ltok) WRITE(*,*) 'PLT version: '//ctok(:ltok) CALL PGQINF('VERSION',ctok,ltok) WRITE(*,*) 'PGPLOT ver.: '//ctok(:ltok) ELSE C- Viewport ---------------------------------------------------------- TMP = BOXVP(1,icwin) CALL GTREAL(TMP, Ier) IF ( TMP.LT.0. .OR. TMP.GE.1. ) THEN WRITE(*,*) 'Viewport coordinates must in range 0. to 1.' GOTO 100 END IF BOXVP(1,icwin) = TMP C TMP = BOXVP(2,icwin) CALL GTREAL(TMP, Ier) IF ( TMP.LT.0. .OR. TMP.GE.1. ) TMP = BOXVP(1,icwin) BOXVP(2,icwin) = TMP C TMP = 1.-BOXVP(1,icwin) CALL GTREAL(TMP, Ier) BOXVP(3,icwin) = TMP IF(BOXVP(3,icwin).LE.BOXVP(1,icwin)) BOXVP(3,icwin) = 1. C TMP = 1.-BOXVP(2,icwin) CALL GTREAL(TMP, Ier) BOXVP(4,icwin) = TMP IF(BOXVP(4,icwin).LE.BOXVP(2,icwin)) BOXVP(4,icwin) = 1. IF(idoall.NE.0) THEN DO iwnum = 1,MXWIN BOXVP(1,iwnum) = BOXVP(1,icwin) BOXVP(2,iwnum) = BOXVP(2,icwin) BOXVP(3,iwnum) = BOXVP(3,icwin) BOXVP(4,iwnum) = BOXVP(4,icwin) END DO END IF END IF C--- C- W ----------------------------------------------------------------- ELSE IF(ctok(1:1).EQ.'W') THEN IF(ctok(1:2).EQ.'WI') THEN C- WIndow ------------------------------------------------------------ CALL GTCHAR(ctok, ltok) CALL UPC(ctok) IF(ISNUM(ctok,ltok).NE.0) THEN itmp = FPNUM(ctok, ltok, Ier) IF(itmp.LE.0 .OR. itmp.GT.MXWIN) THEN WRITE(*,*) 'Window number must lie in range 1 to', : MXWIN GOTO 100 END IF idoall = 0 icwin = itmp LASWIN = 0 GOTO 100 ELSE IF(ctok(1:1).EQ.'A') THEN C Window ALl, set the current window to be the lowest numbered window. DO i=MXWIN,1,-1 IF ( iactw(i).NE.0 ) icwin=i END DO idoall = 1 ELSE GOTO 590 END IF ELSE IF(ctok(1:2).EQ.'WM') THEN C- WModel ------------------------------------------------------------ IF(nterm(ICMOD).LE.0) THEN WRITE(*,411) ELSE CALL GTREST(ctmp,ltmp) ctok = 'WM '//ctmp CALL MODEL(ctok,pmin,pmax,MXPAR,Cmd,Ncmd,Icmd, & ICOMP(1,ICMOD),PVAL(1,ICMOD),PLIM(1,1,ICMOD),nterm(ICMOD)) END IF ELSE IF(ctok(1:2).EQ.'WH' .OR. ctok(1:2).EQ.'WD' .OR. : ctok(1:2).EQ.'WE') THEN C- WData, or WEnviron, or WHead -------------------------------------- CFILE = ' ' CALL GTCHAR(CFILE,LFILE) NDIG = 0 CALL GTINT(NDIG,Ier) IF ( ctok(1:2).NE.'WD' ) THEN C WHead or WEnviron ctmp = CFILE CALL XTEND(ctmp,'.pco') CALL GETLUN(LUN) CALL OPENWR(LUN,ctmp,'new',' ','LIST',0,0,IOS) IF(IOS.NE.0) THEN WRITE(*,*) 'PLT--Unable to open '// : ctmp(:LENACT(ctmp)) GOTO 100 END IF C First create the QDP commands IF(iskip.EQ.1) THEN WRITE(LUN,11) 'SKIP SING' ELSE IF(iskip.EQ.2) THEN WRITE(LUN,11) 'SKIP DOUB' END IF C Now the global commands IF(CSIZE.NE.1.0) WRITE(LUN,551) 'CSIZ ',CSIZE 551 FORMAT(A,F5.2) itmp = LENACT(CFONT) IF(itmp.GT.0) WRITE(LUN,11) 'FONT '//CFONT(:itmp) IF(RGAP.NE.0.025) WRITE(LUN,551) 'GAP ',RGAP IF(IGAP.NE.0) WRITE(LUN,551) 'GAP Errors' IF( IAND(IPLAB,2).EQ.0 ) WRITE(LUN,551) 'LAB PArm OFF' IF ( PYLAB.NE.2.0 ) WRITE(LUN,551) 'LAB POS Y ',PYLAB IF(CYOPT(1)(8:8).EQ.'V') WRITE(LUN,11) 'LAB ROT' IF(WIDTH.NE.1.0) WRITE(LUN,511) 'LWIDTH ',WIDTH 511 FORMAT(A,F4.0) IF(ITIME.EQ.0) WRITE(LUN,11) 'TIME OFF' C Numbered labels in viewport coordinates. DO I = 1,MXLAB IF ( ILABEL(1,I).LT.0 ) THEN CALL PLTLAB(LUN, I, CLABEL, FLABEL, ILABEL) END IF END DO C For each model... Note, we need to write out the model before any C DGroup commands, since DG can point at models. DO im=1,MXMOD IF ( ipwin(MXGRP-MXMOD+im).NE.0 ) THEN WRITE(LUN,541) 'MODEL',im WRITE(ctmp,541) 'WLUN ',LUN CALL MODEL(ctmp,pmin,pmax,MXPAR,Cmd,Ncmd,Icmd, & ICOMP(1,im),PVAL(1,im),PLIM(1,1,im),nterm(im)) IF ( icol(MXGRP-MXMOD+im).NE.1 ) : WRITE(LUN,541) 'COL',icol(MXGRP-MXMOD+im),'ON MOD' IF ( lsty(MXGRP-MXMOD+im).NE.1 ) : WRITE(LUN,541) 'LS ',lsty(MXGRP-MXMOD+im),'ON MOD' IF ( widlin(MXGRP-MXMOD+im).NE.0.0 ) : WRITE(LUN,531) 'LW',widlin(MXGRP-MXMOD+im),'ON MOD' END IF END DO C For each group... CALL WRTCOL(Lun, icol, ngroup) DO ig=1, ngroup IF ( ispecg(ig).EQ.3 ) THEN WRITE(Lun, 513) ig,(isuba(k,ig),k=1,4) 513 FORMAT('DG ',I3,1X,4I7) END IF itmp = LENACT(cglab(ig)) IF ( itmp.GT.0 ) THEN ltmp = 0 CALL CRAMI(ig, ctmp, ltmp) WRITE(Lun, 521) ctmp(:ltmp), cglab(ig)(:itmp) 521 FORMAT('LAB G',A,1X,A) END IF IF(line(ig).NE.0) THEN IF(line(ig).EQ. 1) THEN WRITE(LUN,541) 'LIne ON',ig ELSE IF(line(ig).EQ.-1) THEN WRITE(LUN,541) 'LIne Step',ig ELSE WRITE(LUN,541) 'LIne',line(ig),'ON',ig END IF END IF IF(lsty(ig).NE.1) WRITE(LUN,541) 'LS',lsty(ig),'ON',ig IF ( widlin(ig).GT.0. ) : WRITE(LUN,531) 'LW',widlin(ig),'ON',ig 531 FORMAT(A,1X,F5.1,1X,A,I4) IF(ipmark(ig).GT.0) WRITE(LUN,541) 'MArk', : imark(ig), 'ON', ig IF(szmark(ig).NE.1.0) WRITE(LUN,531) 'MArk Size', : szmark(ig), 'ON', ig 541 FORMAT(A,I5,1X,A,I4) END DO C DO iscr=0,15 IF ( scrcol(1,iscr).NE.NO ) THEN WRITE(LUN,546) iscr,(scrcol(i,iscr),i=1,3) 546 FORMAT('SCR ',I5,3F10.4) END IF END DO C i2dind = 0 DO ic = 1,MX2D IF ( icont(ic).NE.0 ) THEN CALL WRTCON(LUN, ic, rlvcon(1,ic), icocon(1,ic), : ilscon(1,ic), rlwcon(1,ic), MXLEV, ctmp) i2dind = ic END IF IF ( image(ic).NE.0 ) THEN CALL WRTIMA(lun, ic, itfun(ic), icbar(ic), & zscale(1,ic), cctnam(ic), ctmp) i2dind = ic END IF END DO C Count number of active windows. IDOWIN = 0 DO iwnum = 1,MXWIN IF(iactw(iwnum).GT.0) THEN IDOWIN = IDOWIN + 1 END IF END DO IF ( idowin.EQ.1 .AND. ixvec.EQ.0 ) THEN ctmp = 'XAX LIN ' ltmp = 10 CALL PLTXCC(Yray, 1, 1, x1, ndim, iyoff) CALL PLTXCC(Yray, 2, 1, xt, ndim, iyoff) CALL CRAMF(X1(1),ctmp,ltmp) ltmp = ltmp+1 XDEL = xt(1)-x1(1) CALL CRAMF(XDEL,ctmp,ltmp) WRITE(LUN,11) ctmp(:ltmp) IF ( ndim.GT.1 ) THEN i1=isuba(3,i2dind)-isuba(1,i2dind)+1 CALL PLTXCC(Yray,1+i1,i2dind,xt,ndim,iyoff) ctmp = 'YAX LIN ' ltmp = 9 CALL CRAMF(x1(2), ctmp, ltmp) ltmp = ltmp+1 CALL CRAMF(xt(2)-x1(2), ctmp, ltmp) WRITE(LUN,11) ctmp(:ltmp) END IF DO im=1,MXMOD IF ( ipwin(MXGRP-MXMOD+im).NE.0 ) THEN WRITE(LUN,541) 'FIT ON',ifitg(im) END IF END DO END IF C CSCR1 = 'LOG X ON' LSCR1 = 9 CSCR2 = 'LOG Y ON' LSCR2 = 9 C For each window... DO 560 iwnum = 1,MXWIN IF(iactw(iwnum).LE.0) GOTO 560 DO ig=1,ngroup IF ( ipwin(ig).EQ.iwnum ) THEN IF ( ispecg(ig).EQ.1 ) THEN WRITE(Lun, 512) ig,'Model' 512 FORMAT('DG ',I3,3X,A) ELSE IF ( ispecg(ig).EQ.2 ) THEN WRITE(Lun, 512) ig,'Resid' END IF END IF END DO IF ( IDOWIN.GT.1 ) THEN WRITE(LUN,541) 'WIN ',iwnum C write YPLOT command ctmp = 'YPLOT ' ltmp = 6 i2dind=0 DO ig= 1, ngroup IF(ipwin(ig).EQ.iwnum) THEN ltmp = ltmp + 1 CALL CRAMI(ig,ctmp,ltmp) IF ( ig.LE.MX2D .AND. i2dind.EQ.0 ) i2dind=ig END IF END DO WRITE(LUN,11) ctmp(:ltmp) IF ( i2dind.NE.0 .AND. ixvec.EQ.0 ) THEN ctmp = 'XAX LIN ' ltmp = 10 CALL PLTXCC(Yray, 1, i2dind, x1, ndim, iyoff) CALL PLTXCC(Yray, 2, i2dind, xt, ndim, iyoff) XDEL = xt(1)-x1(1) CALL CRAMF(X1(1),ctmp,ltmp) ltmp = ltmp+1 CALL CRAMF(XDEL,ctmp,ltmp) WRITE(LUN,11) ctmp(:ltmp) IF ( ndim.GT.1 ) THEN i1=isuba(3,i2dind)-isuba(1,i2dind)+1 CALL PLTXCC(Yray,1+i1,i2dind,xt,ndim,iyoff) ctmp = 'YAX LIN ' ltmp = 9 CALL CRAMF(x1(2), ctmp, ltmp) ltmp = ltmp+1 CALL CRAMF(xt(2)-x1(2), ctmp, ltmp) WRITE(LUN,11) ctmp(:ltmp) END IF END IF DO im=1,MXMOD IF ( ipwin(MXGRP-MXMOD+im).EQ.iwnum ) THEN WRITE(LUN,541) 'FIT ON',ifitg(im) END IF END DO END IF IF ( nfpl.NE.0 ) THEN WRITE(LUN,541) 'FIT Plot',nfpl END IF C write LOCation command ctmp = 'LOC ' ltmp = 4 DO i=1,4 ltmp = ltmp + 1 CALL CRAMF(WINLOC(i,iwnum),ctmp,ltmp) END DO WRITE(LUN,11) ctmp(:ltmp) C write Viewport command IF ( BOXVP(1,icwin).NE.0.1 .OR. : BOXVP(2,icwin).NE.0.1 .OR. : BOXVP(3,icwin).NE.0.9 .OR. : BOXVP(4,icwin).NE.0.9 ) THEN ctmp = 'Vie ' ltmp = 4 DO i=1,4 ltmp = ltmp + 1 CALL CRAMF(boxvp(i,iwnum),ctmp,ltmp) END DO WRITE(LUN,11) ctmp(:ltmp) END IF C IF(LOGX(iwnum).NE.0) THEN LSCR1 = LSCR1+1 CALL CRAMI(iwnum, CSCR1, LSCR1) END IF IF(LOGY(iwnum).NE.0) THEN LSCR2 = LSCR2+1 CALL CRAMI(iwnum, CSCR2, LSCR2) END IF C Numbered labels DO I = 1,MXLAB IF ( ILABEL(1,I).EQ.iwnum ) THEN CALL PLTLAB(LUN, I, CLABEL, FLABEL, ILABEL) END IF END DO C IF (CXOPT(iwnum)(5:5).EQ.' ') : WRITE(LUN,11) 'LAB NX OFF' C itmp = LENACT(CFNAM(iwnum)) IF(itmp.GT.0) THEN WRITE(LUN,11) 'LAB F '//CFNAM(iwnum)(:itmp) ELSE WRITE(LUN,11) 'LAB F' END IF itmp = LENACT(CTLAB(iwnum)) IF(itmp.GT.0) WRITE(LUN, 11) 'LAB T '// : CTLAB(iwnum)(:itmp) itmp = LENACT(COTLAB(iwnum)) IF(itmp.GT.0) WRITE(LUN, 11) 'LAB OT '// : COTLAB(iwnum)(:itmp) itmp = LENACT(CXLAB(iwnum)) IF(itmp.GT.0) WRITE(LUN, 11) 'LAB X '// : CXLAB(iwnum)(:itmp) itmp = LENACT(COXLAB(iwnum)) IF(itmp.GT.0) WRITE(LUN, 11) 'LAB OX '// : COXLAB(iwnum)(:itmp) itmp = LENACT(CYLAB(iwnum)) IF(itmp.GT.0) WRITE(LUN, 11) 'LAB Y '// : CYLAB(iwnum)(:itmp) itmp = LENACT(COYLAB(iwnum)) IF(itmp.GT.0) WRITE(LUN, 11) 'LAB OY '// : COYLAB(iwnum)(:itmp) IF(idoall.EQ.0) THEN CALL RESCAL('X', iwnum, XYSCAL(1,iwnum), : XYSCAL(3,iwnum), ctmp, ltmp) WRITE(LUN,11) ctmp(:ltmp) END IF IF ( iwnum.NE.ixvec ) THEN CALL RESCAL('Y', iwnum, XYSCAL(2,iwnum), : XYSCAL(4,iwnum), ctmp, ltmp) ELSE CALL RESCAL('Y', 0, XYSCAL(2,iwnum), : XYSCAL(4,iwnum), ctmp, ltmp) END IF WRITE(LUN,11) ctmp(:ltmp) 560 CONTINUE IF ( IDOWIN.GT.1 ) WRITE(LUN,11) 'WIN ALL' IF(idoall.NE.0) THEN CALL RESCAL('X', 0, XYSCAL(1,1), XYSCAL(3,1), : ctmp, ltmp) WRITE(LUN,11) ctmp(:ltmp) END IF IF(LSCR1.GT.9) WRITE(LUN,11) CSCR1(:LSCR1) IF(LSCR2.GT.9) WRITE(LUN,11) CSCR2(:LSCR2) CLOSE(UNIT = LUN) CALL FRELUN(LUN) END IF C--- IF(ctok(1:2).NE.'WH') THEN C WData or WEnviron ctmp = CFILE CALL XTEND(ctmp,'qdp') CALL GETLUN(LUN) CALL OPENWR(LUN,ctmp,'new',' ','LIST',0,0,IOS) IF(IOS.NE.0) THEN WRITE(*,*) 'PLT--Unable to open '// : ctmp(:LENACT(ctmp)) GOTO 100 END IF C- First write out the READ xERR commands. ctok = ' ' ltok = 0 ctmp = ' ' ltmp = 0 DO igroup = 1,Nvec IF(Iery(igroup).GT.0) THEN IF(Iery(igroup).EQ.1) THEN IF(ltok.EQ.0) THEN ctok = 'READ SERR' ltok = 9 END IF ltok = ltok+1 CALL CRAMI(igroup,ctok,ltok) ELSE IF(Iery(igroup).EQ.2) THEN IF(ltmp.EQ.0) THEN ctmp = 'READ TERR' ltmp = 9 END IF ltmp = ltmp+1 CALL CRAMI(igroup,ctmp,ltmp) END IF END IF END DO IF(ltok.GT.0) WRITE(LUN,11) ctok(:ltok) IF(ltmp.GT.0) WRITE(LUN,11) ctmp(:ltmp) IF(LFILE.GT.0) THEN ctmp = CFILE CALL XTEND(ctmp,'.pco') WRITE(LUN,11) '@'//ctmp(:LENACT(ctmp)) END IF WRITE(LUN,11) '!' C- Now write out the data. DO 570 I = 1,Npts C CALL PLTXCC(Yray, 1, 1, xt, ndim, iyoff) C IF ( iskip.EQ.0 .OR. xt(1).NE.NO ) THEN CC- Do not jump to 570 if iskip.NE.0 (SKip ON) and X.EQ.NO C IF(xt(1).LT.pmin .OR. xt(1).GT.pmax) GOTO 570 C END IF CALL WRQDAT(Lun, Ndig, Yray(I), Iery, Mxrow, Nvec) 570 CONTINUE CLOSE(UNIT = LUN) CALL FRELUN(LUN) END IF END IF C--- C- Xaxis ------------------------------------------------------------- ELSE IF(ctok(1:1).EQ.'X') THEN CALL GTCHAR(ctok,ltok) IF ( ISNUM(ctok,ltok).NE.0 ) THEN itmp = FPNUM(ctok,ltok,Ier) IF ( itmp.LE.0 .OR. itmp.GT.Nvec ) THEN WRITE(*,*) 'Xaxis must be a vector in range 1 to', & Nvec,'.' GOTO 590 END IF IF ( ixvec.EQ.itmp ) GOTO 100 IF ( igrpos(1,itmp).LT.0 ) GOTO 590 C%%% This should be allowed... IF ( ipmod(itmp).NE.0 ) THEN WRITE(*,*) 'Model groups cannot be used here.' GOTO 100 END IF IF ( ixvec.GT.0 .AND. icol(ixvec).GT.0 ) : ipwin(ixvec) = ABS(ipwin(ixvec)) ixvec = itmp IF ( iskip.EQ.0 ) THEN ipwin(ixvec) = -ABS(ipwin(ixvec)) ngroup = MIN(Nvec,MXGRP-MXMOD) CALL GTCHAR(ctmp, ltmp) IF ( ltmp.LE.0 ) THEN C XAX # means do all groups DO igroup = 1,ngroup CALL PLTXCG(igroup,1,ixvec,igrpos(1,ixvec),Iery) CALL PLTXCP(igroup, 1, ipyer(ixvec)) xymnmx(1,igroup) = xymnmx(2,ixvec) xymnmx(3,igroup) = xymnmx(4,ixvec) ermnmx(1,igroup) = ermnmx(3,ixvec) ermnmx(2,igroup) = ermnmx(4,ixvec) END DO ELSE C XAX # ON list means only do the listed groups 573 CONTINUE CALL GTCHAR(ctmp, ltmp) IF ( ltmp.GT.0 ) THEN igroup = FPNUM(ctmp, ltmp, ier) IF ( ier.NE.0 .OR. igroup.GT.ngroup ) GOTO 573 CALL PLTXCG(igroup,1,ixvec,igrpos(1,ixvec),Iery) CALL PLTXCP(igroup, 1, ipyer(ixvec)) xymnmx(1,igroup) = xymnmx(2,ixvec) xymnmx(3,igroup) = xymnmx(4,ixvec) ermnmx(1,igroup) = ermnmx(3,ixvec) ermnmx(2,igroup) = ermnmx(4,ixvec) GOTO 573 END IF END IF C Reset X-scales that may have changed IF ( idoall.NE.0 ) THEN DO iwnum = 1,MXWIN XYSCAL(1,iwnum) = XYSCAL(2,ixvec) XYSCAL(3,iwnum) = XYSCAL(4,ixvec) END DO ELSE XYSCAL(1,icwin) = XYSCAL(2,ixvec) XYSCAL(3,icwin) = XYSCAL(4,ixvec) END IF ELSE CALL PLTSKP(Yray, Iery, Mxrow, Npts, Nvec, MXGRP-MXMOD, & iskip, ixvec, ngroup, igrpos, ipyer, ipwin) DO iwnum = 1,MXWIN XYSCAL(1,iwnum) = NO END DO imnmx = -1 END IF ELSE CALL UPC(ctok) IF(ctok(1:1).EQ.'L') THEN C Xaxis linear OFF = NO SLOP = NO CALL GTREAL(OFF,Ier) CALL GTREAL(SLOP,Ier) ngroup = MIN(Nvec,MXGRP-MXMOD) IF ( idoall.NE.0 ) THEN DO ig= 1,ngroup CALL PLTXCL(ig, 1, off, slop) END DO ELSE C Only change the X-axis for the plot groups that appear in the C current window. DO ig= 1,ngroup IF ( ipwin(ig).EQ.icwin ) THEN CALL PLTXCL(ig, 1, off, slop) END IF END DO END IF IF ( ixvec.GT.0 .AND. icol(ixvec).GT.0 ) : ipwin(ixvec) = ABS(ipwin(ixvec)) ixvec = 0 iskip = 0 IF(idoall.NE.0) THEN DO iwnum = 1,MXWIN XYSCAL(1,iwnum) = NO END DO ELSE XYSCAL(1,icwin) = NO END IF imnmx = -1 ELSE IF(ctok(1:1).EQ.'O') THEN C Xaxis Offset TMP = 0. CALL GTREAL(TMP,Ier) DO ig= 1,ngroup CALL PLTXCO(ig, 1, TMP) END DO ELSE GOTO 590 END IF END IF C--- ELSE IF(ctok(1:1).EQ.'Y') THEN C- YAxis ------------------------------------------------------------- IF ( ctok(1:2).EQ.'YA' ) THEN ctok(1:2) = ' ' CALL GTPEEK(ctok, ltok) CALL UPC(ctok) IF ( ctok(1:1).EQ.'L' ) THEN C YAxis LIN # # yoff = NO yslop = NO CALL GTCHAR(ctok,ltok) CALL GTREAL(YOFF,Ier) CALL GTREAL(YSLOP,Ier) IF ( idoall.NE.0 ) THEN DO ig= 1,ngroup CALL PLTXCL(ig, 2, yoff, yslop) END DO ELSE C Only change the Y-axis for the plot groups that appear in the C current window. DO ig= 1,ngroup IF ( ipwin(ig).EQ.icwin ) THEN CALL PLTXCL(ig, 2, yoff, yslop) END IF END DO END IF imnmx = -1 ELSE C YAxis [ON] [glist] (no longer a good idea) WRITE(*,*) 'Please use the Yplot instead of YAxis!' IF(ctok(1:2).EQ.'ON') CALL GTCHAR(ctok, ltok) 575 CALL GTCHAR(ctmp, ltmp) IF(ltmp.GT.0) THEN itmp = FPNUM(ctmp, ltmp, Ier) IF(itmp.GT.0 .AND. itmp.LE.MXGRP-MXMOD) THEN ipwin(itmp) = icwin CALL PLTXCC(Yray, 1, itmp, xt, ndim, iyoff) IF ( ndim.EQ.1 ) THEN icol(itmp) = ABS(icol(itmp)) ELSE ic2dg = itmp END IF GOTO 575 END IF END IF CALL ACTWIN(ipwin,ngroup,MXWIN,iactw) GOTO 100 END IF ELSE C- Yplot ------------------------------------------------------------- CALL GTPEEK(ctok, ltok) CALL UPC(ctok) new = icwin IF ( ctok(1:2).EQ.'OF' ) THEN C Yplot OFf (skip the OFf token) CALL GTCHAR(ctok, ltok) new = 0 ELSE IF ( ctok(1:2).EQ.'ON' ) THEN C Yplot ON (skip the ON token) CALL GTCHAR(ctok, ltok) END IF CALL GTCHAR(ctok, ltok) C repeat ... until 580 CONTINUE CALL UPC(ctok) CALL IRANGE(ctok,ltok,1,ngroup,ILO,IHI,Ier) IF ( ILO.LT.1 .OR. IHI.LT.1 ) GOTO 590 ILO = MAX(1,MIN(ILO,MXGRP)) IHI = MAX(1,MIN(IHI,MXGRP)) DO igroup = ILO, IHI IF ( igrpos(1,igroup).GE.0 ) THEN ipwin(igroup) = new IF ( new.GT.0 ) THEN icol(igroup) = ABS(icol(igroup)) ELSE icol(igroup) = -ABS(icol(igroup)) END IF CALL PLTXCC(Yray, 1, igroup, xt, ndim, iyoff) IF ( ndim.GT.1 ) THEN C Define the default contour and image plot group ic2dg = igroup END IF END IF END DO CALL GTCHAR(ctok,ltok) IF(ltok.GT.0) GOTO 580 CALL ACTWIN(ipwin,ngroup,MXWIN,iactw) C End 'Y' commands END IF ELSE GOTO 590 END IF GOTO 100 C--- C- tough luck -------------------------------------------------------- 590 WRITE(*,591) ctok(:ltok) 591 FORMAT(' Illegal command. At token = ',A/ : ' Type HELP to get command list.') GOTO 100 C--- C********************************************************************* 600 CONTINUE IF(icmd.GE.0) GOTO 100 ICLEAR = 1 C--- 610 CONTINUE IF ( cpfile.EQ.' ' ) THEN IF ( ITRANS.EQ.0 ) THEN ITRANS = 1 CALL TRLOG('PGPLOT_TYPE',11,cpfile,LPFILE) END IF IF ( LPFILE.EQ.0 ) THEN ctok = CXLAB(icwin) ltok = LENACT(ctok) IF ( ltok.LE.0 .AND. ixvec.GT.0 ) THEN ctok = cglab(ixvec) ltok = LENACT(ctok) END IF IF ( ltok.LE.0 .AND. laswin.NE.0 ) THEN ctok = CXLAB(laswin) ltok = LENACT(ctok) END IF ltok = MIN(ltok,24) iwnum = icwin DO I = MXWIN,1,-1 IF ( iactw(iwnum).GT.0 ) iwnum = I END DO ctmp = CYLAB(iwnum) ltmp = LENACT(ctmp) IF ( ltmp.LE.0 ) THEN igroup = IFGRP(ipwin, MXGRP-MXMOD, iwnum) IF ( igroup.GT.0 ) THEN ctmp = cglab(igroup) ltmp = LENACT(ctmp) END IF END IF ltmp = MIN(ltmp,24) IF ( ltmp.GT.0 .OR. ltok.GT.0 ) THEN WRITE(*,621) ctmp(:ltmp),ctok(:ltok) 621 FORMAT(' To plot ',A,' vs. ',A,', please enter') ELSE WRITE(*,631) 631 FORMAT(' To produce plot, please enter') END IF CALL PLTPRO(cpfile,Ier) IF(Ier.NE.0) GOTO 900 IF(cpfile.EQ.' ') GOTO 950 QHARD = .FALSE. END IF END IF C--- CALL DSCALE(Yray, Iery, Mxrow, MXWIN, MX2D, ngroup, MXPAR, & igap, rgap, idoall, iskip, newmod, iactw, logx, logy, imaster, & igrpos, ipwin, icont, image, ipmod, icomp, pval, nterm, & imnmx, xymnmx, ermnmx, xyscal) ipall = 1 C--- C No open plot device, go back to prompt. 650 CONTINUE IF ( cpfile(1:1).EQ.'>' .OR. cpfile.EQ.' ' ) GOTO 100 C--- IF ( IOPEN.EQ.0 ) THEN CALL PLTOPE(cpfile,ibcol,scrcol,cfont,pgpapw,pgpapa,Ier) IF(Ier.NE.0) THEN cpfile = ' ' LPFILE = 0 GOTO 610 END IF IOPEN = 1 CALL PGQINF('TERMINAL',ctok,ltok) IF(ctok(1:1).EQ.'Y') IOPEN = -1 END IF CALL PGBBUF IF ( IOPEN.LT.0 ) CALL PLTTER('G') IF(ICLEAR.NE.0) CALL PLTCLR C--- C- Plot line, error bars or symbols. DO 790 iwnum = 1,MXWIN IF ( iactw(iwnum).LE.0 ) GOTO 790 IF ( XYSCAL(2,iwnum).EQ.XYSCAL(4,iwnum) ) THEN WRITE(*,661) 'YMIN = YMAX',iwnum 661 FORMAT(' ERROR--',A,' in window',I4) GOTO 790 END IF IF ( XYSCAL(1,iwnum).EQ.XYSCAL(3,iwnum )) THEN WRITE(*,661) 'XMIN = XMAX',iwnum GOTO 790 END IF CALL PLTSVW(BOXVP, WINLOC, XYSCAL, LOGX, LOGY, IWADJ, iwnum) WXMIN = XYSCAL(1,iwnum) WYMIN = XYSCAL(2,iwnum) WXMAX = XYSCAL(3,iwnum) WYMAX = XYSCAL(4,iwnum) pmin(1) = MIN(WXMIN,WXMAX) pmax(1) = MAX(WXMIN,WXMAX) IF ( GRIDX(iwnum).GT.0. ) THEN XSPAC = (WXMAX-WXMIN)/GRIDX(iwnum) ELSE XSPAC = 0. END IF IF ( GRIDY(iwnum).GT.0. ) THEN YSPAC = (WYMAX-WYMIN)/GRIDY(iwnum) ELSE YSPAC = 0. END IF CALL PLTSCI(1) CALL PLTSLS(1) CALL PLTCS(CSIZE) CALL PLTSLW(WIDTH) IF ( ipall.NE.0 ) THEN IF ( (IGCOL.EQ.1 .AND. IGLS.EQ.1 ) .OR. : CXOPT(iwnum)(7:7).NE.'G') THEN CALL PGBOX(CXOPT(iwnum),XSPAC,NSUBX(iwnum), : CYOPT(iwnum),YSPAC,NSUBY(iwnum)) ELSE CXOPT1 = CXOPT(iwnum) CXOPT1(7:7) = ' ' CYOPT1 = CYOPT(iwnum) CYOPT1(7:7) = ' ' CALL PGBOX(CXOPT1,XSPAC,NSUBX(iwnum), : CYOPT1,YSPAC,NSUBY(iwnum)) CXOPT1 = 'G' CYOPT1 = 'G' CALL PLTSCI(IGCOL) CALL PLTSLS(IGLS) CALL PGBOX(CXOPT1,XSPAC,NSUBX(iwnum), : CYOPT1,YSPAC,NSUBY(iwnum)) END IF END IF C C We now loop over all groups, looking for the groups to plot in the C current window. DO 770 igroup = 1,MXGRP IF ( ipwin(igroup).NE.iwnum ) GOTO 770 C Note, i2drow is used by both 1D and 2D plots. icyvec = igrpos(3,igroup) IF ( Iery(icyvec).GT.0 ) THEN i2drow = Mxrow*(Iery(icyvec)+1) ELSE i2drow = Mxrow END IF C- If only plotting model skip ahead. IF ( ipall.EQ.0 .OR. ipmod(igroup).GT.0 ) GOTO 700 C- If this group is to plotted as contour/image then don't do 1D plot. IF ( igroup.LE.MX2D ) THEN IF ( icont(igroup).GT.0 .OR. & image(igroup).GT.0 ) GOTO 700 END IF C- If not doing the 1D plot then skip over. IF ( IPZERO.EQ.0 .AND. icol(igroup).LE.0 ) GOTO 700 IF ( widlin(igroup).EQ.0.0 ) THEN CALL PLTSLW(WIDTH) ELSE CALL PLTSLW(widlin(igroup)) END IF C--- idolin = line(igroup) CALL PLTXCE(Yray, 1, igroup, 1, xmerr, xperr) lery = ipyer(igroup) IDOER = 0 IF ( xperr.NE.0 .OR. lery.NE.0 ) IDOER = 1 IF ( IDOER.EQ.0 .AND. idolin.EQ.0 .AND. : ipmark(igroup).EQ.0 ) idolin = 1 CALL PLTSCI(icol(igroup)) CALL PLTSLS(lsty(igroup)) C--- C- line plot. IF ( idolin.NE.0 ) THEN IF ( ABS(idolin).GT.1 ) THEN C Plot a smooth line IF ( idolin.LT.0 ) THEN XLO = xymnmx(1,igroup) XHI = xymnmx(3,igroup) ELSE XLO = pmin(1) XHI = pmax(1) END IF IF(LOGX(iwnum).NE.0) XLO = LOG10(MAX(XLO,RMNLOG)) IF(LOGX(iwnum).NE.0) XHI = LOG10(MAX(XHI,RMNLOG)) XDEL = (XHI-XLO)/ABS(idolin) new = 1 XCEN = XLO INITAK = 1 DO I = 0,ABS(idolin) XT(1) = XCEN IF(LOGX(iwnum).NE.0 .AND. : XCEN.LT.1.E35) XT(1) = 10.**XCEN CALL AKINTE(XCEN, Yray, igroup, igrpos(1,igroup), & igrpos(2,igroup), 0, INITAK, YT) IF(LOGY(iwnum).NE.0) YT = LOG10(MAX(YT,RMNLOG)) IF(new.NE.0) THEN new = 0 CALL PGMOVE(XCEN,YT) ELSE CALL PGDRAW(XCEN,YT) END IF XCEN = XCEN+XDEL END DO ELSE C Plot line only at grid points IFIRST = 1 CALL PLTXCC(Yray, 1, igroup, x1, ndim, iyoff) CALL PLTXCC(Yray, 2, igroup, xt, ndim, iyoff) XLAS = 2.*x1(1)-xt(1) iy0 = igrpos(1,igroup) DO 680 I= 1,igrpos(2,igroup) CALL PLTXCC(Yray, i, igroup, xt, ndim, iyoff) XCEN = xt(1) YCEN = Yray(iy0+iyoff) IF ( ipmod(igroup).LT.0 .AND. ycen.NE.NO ) THEN C ipmod.LT.0 means plot residuals itmp = ABS(ipmod(igroup)) ycen = ycen - FNFIT(xcen,ICOMP(1,itmp), & PVAL(1,itmp),nterm(itmp)) END IF IBAD = 0 IF ( .NOT.QALL .AND. : (YCEN.EQ.NO .OR. XCEN.EQ.NO) ) IBAD = 1 IF ( XCEN.LT.pmin(1) .OR. XCEN.GT.pmax(1) ) IBAD=1 IF ( IBAD.NE.0 ) THEN IFIRST = 1 GOTO 680 END IF YT = YCEN IF(LOGY(iwnum).NE.0) YT = LOG10(MAX(YCEN,RMNLOG)) IF ( idolin.EQ.1 ) THEN C Do the line ON command XT(1) = XCEN IF ( LOGX(iwnum).NE.0 ) XT(1) = & LOG10(MAX(XT(1),RMNLOG)) IF ( IFIRST.NE.0 ) THEN CALL PGMOVE(XT(1),YT) IFIRST = 0 ELSE CALL PGDRAW(XT(1),YT) END IF ELSE C Do the line Stepped command CALL PLTXCE(Yray, i, igroup, 1, xmerr, xperr) IF ( xperr.LE.0.0 ) THEN C If PLTXCE does not return an error, then we must guess an appropiate C step size. We use half the distance between the data points, with C obvious care that we don't fall off the ends of the array. xmerr = 0.0 IF ( i.LT.igrpos(2,igroup) ) THEN CALL PLTXCC(Yray,i+1,igroup,x1,ndim,iyoff) IF ( x1(1).NE.NO ) THEN IF ( x1(1).GT.xt(1) ) THEN xperr = (x1(1) - xt(1))/2. ELSE xmerr = (x1(1) - xt(1))/2. END IF END IF END IF IF ( i.GT.1 ) THEN CALL PLTXCC(Yray,i-1,igroup,x1,ndim,iyoff) IF ( x1(1).NE.NO ) THEN IF ( xt(1).GT.x1(1) ) THEN xmerr = (x1(1) - xt(1))/2. ELSE IF ( xperr.LE.0.0 ) THEN xperr = (x1(1) - xt(1))/2. END IF END IF END IF END IF IF ( xperr.LE.0.0 ) xperr=-xmerr IF ( xmerr.GE.0.0 ) xmerr=-xperr END IF IF ( XCEN.GT.XLAS ) THEN XT(1) = XCEN+xmerr ELSE C Allow for case where X coordinate decreases. XT(1) = XCEN+xperr END IF C Allow up to +/-10 percent slop in the spacing, before breaking the line. IF ( xperr.NE.0.0 .AND. & ABS(XT(1)-XLAS).GT.0.2*xperr ) THEN IFIRST = 1 END IF IF ( LOGX(iwnum).NE.0 ) XT(1) = & LOG10(MAX(XT(1),RMNLOG)) IF ( IFIRST.NE.0 ) THEN CALL PGMOVE(XT(1),YT) IFIRST = 0 ELSE CALL PGDRAW(XT(1),YT) END IF IF ( XCEN.GT.XLAS ) THEN XT(1) = XCEN+xperr ELSE XT(1) = XCEN+xmerr END IF XLAS = XT(1) IF ( LOGX(iwnum).NE.0 ) XT(1) = & LOG10(MAX(XT(1),RMNLOG)) CALL PGDRAW(XT(1),YT) END IF 680 CONTINUE END IF END IF C--- C- Plot Markers or errors. IF ( ipmark(igroup).GT.0 .OR. IDOER.NE.0 ) THEN YPERR = 0. YMERR = 0. IF(flimit(igroup).GT.0.) THEN CALL PLTVTW(0.5, 0.50, TMP, TMP1) CALL PLTVTW(0.5, 0.46, TMP, TMP2) YLONG = TMP1-TMP2 END IF CALL PLTCS(szmark(igroup)) CALL PLTSMK(imark(igroup)) iy0 = igrpos(1,igroup) DO 690 I= 1,igrpos(2,igroup) CALL PLTXCC(Yray, i, igroup, xt, ndim, iyoff) iyi = iy0 + iyoff C%%% Fails for 2D case? XCEN = xt(1) YCEN = Yray(iyi) IF ( ipmod(igroup).LT.0 .AND. ycen.NE.NO ) THEN C ipmod.LT.0 means plot residuals itmp = ABS(ipmod(igroup)) ycen = ycen - FNFIT(xcen,ICOMP(1,itmp), & PVAL(1,itmp),nterm(itmp)) END IF IBAD = 0 IF ( .NOT.QALL .AND. & (YCEN.EQ.NO .OR. XCEN.EQ.NO) ) IBAD = 1 IF ( XCEN.LT.pmin(1) .OR. XCEN.GT.pmax(1) ) IBAD = 1 IF ( IBAD.NE.0 ) GOTO 690 IF ( ipmark(igroup).NE.0 ) THEN XT(1) = XCEN IF(LOGX(iwnum).NE.0) XT(1) = & LOG10(MAX(XT(1),RMNLOG)) YT = YCEN IF(LOGY(iwnum).NE.0) YT = LOG10(MAX(YT,RMNLOG)) CALL PLTPM(1,XT(1),YT) END IF IF ( IDOER.NE.0 ) THEN C- Plot errors. CALL PLTXCE(Yray, i, igroup, 1, xmerr, xperr) XL = XCEN+xmerr XH = XCEN+xperr IF(LOGX(iwnum).NE.0) THEN XL = LOG10(MAX(XL,RMNLOG)) XH = LOG10(MAX(XH,RMNLOG)) XCEN = LOG10(MAX(XCEN,RMNLOG)) END IF C IF ( lery.NE.0 ) THEN IF ( lery.EQ.-2 ) THEN YPERR = 1.+SQRT(0.75+ABS(YCEN)) YMERR = -YPERR ELSE IF ( lery.EQ.-1 ) THEN YPERR = SQRT(MAX(YCEN,1.)) YMERR = -YPERR ELSE IF ( Iery(icyvec).EQ.1 ) THEN YPERR = Yray(iyi+Mxrow) YMERR = -YPERR ELSE IF ( Iery(icyvec).EQ.2 ) THEN YPERR = Yray(iyi+Mxrow) YMERR = Yray(iyi+2*Mxrow) END IF END IF C IF ( flimit(igroup).GT.0. ) THEN TMP = flimit(igroup)*YPERR IF ( YCEN.LT.TMP ) THEN YH = TMP IF ( LOGY(iwnum).NE.0 ) THEN YH = LOG10(MAX(YH,RMNLOG)) CALL PLTWTV(XCEN, YH, vxlas, vylas) vylas=vylas-0.05 CALL PLTVTW(vxlas, vylas, tmp1, tmp2) YL = tmp2 ELSE YL = YH-MIN(TMP, YLONG) END IF CALL PGMOVE(XL,YH) CALL PGDRAW(XH,YH) CALL PGMOVE(XCEN,YH) CALL PGDRAW(XCEN,YL) GOTO 690 END IF END IF C YL = YCEN+YMERR YH = YCEN+YPERR IF ( LOGY(iwnum).NE.0 ) THEN YL = LOG10(MAX(YL,RMNLOG)) YH = LOG10(MAX(YH,RMNLOG)) YCEN = LOG10(MAX(YCEN,RMNLOG)) END IF C CALL PGMOVE(XL,YCEN) IF(ipyer(igroup).LE.1) THEN CALL PGDRAW(XH,YCEN) CALL PGMOVE(XCEN,YL) CALL PGDRAW(XCEN,YH) ELSE CALL PGDRAW(XCEN,YH) CALL PGDRAW(XH,YCEN) CALL PGDRAW(XCEN,YL) CALL PGDRAW(XL,YCEN) END IF C End plot errors END IF 690 CONTINUE CALL PLTCS(CSIZE) END IF C--- C Now do any 2D plots in the current window 700 CONTINUE IF ( igroup.GT.MX2D ) GOTO 750 IF ( icont(igroup).GT.0 .OR. & image(igroup).GT.0 ) THEN CALL PLTXCC(Yray, 0, igroup, xt, ndim, iyoff) CALL PLTXCC(Yray, 1, igroup, x1, ndim, iyoff) tmp = x1(1)-xt(1) ca=COS(rota(igroup)/rtd) sa=SIN(rota(igroup)/rtd) tr(1) = xt(1) - (isuba(1,igroup)-1)*tmp tr(2) = tmp*ca tr(3) =-tmp*sa C Find index of first point in second column. itmp = isuba(3,igroup)-isuba(1,igroup)+2 CALL PLTXCC(Yray, itmp, igroup, xt, ndim, iyoff) yslop = xt(2)-x1(2) tr(4) = x1(2)-yslop - (isuba(2,igroup)-1)*yslop tr(5) = yslop*sa tr(6) = yslop*ca CALL PGQWIN(TXMIN, TXMAX, TYMIN, TYMAX) I1 = NINT((TXMIN-tr(1))/tr(2)) I2 = NINT((TXMAX-tr(1))/tr(2)) IF ( I1.GT.I2 ) THEN itmp = I1 I1 = I2 I2 = itmp END IF J1 = NINT((TYMIN-tr(4))/tr(6)) J2 = NINT((TYMAX-tr(4))/tr(6)) IF ( J1.GT.J2 ) THEN itmp = J1 J1 = J2 J2 = itmp END IF I1 = MIN(MAX(isuba(1,igroup),I1),isuba(3,igroup)) I2 = MIN(MAX(isuba(1,igroup),I2),isuba(3,igroup)) J1 = MIN(MAX(isuba(2,igroup),J1),isuba(4,igroup)) J2 = MIN(MAX(isuba(2,igroup),J2),isuba(4,igroup)) IF ( ipall.EQ.0 ) GOTO 750 IF ( image(igroup).GT.0 ) THEN IF ( ipmod(igroup).EQ.0 ) THEN C Only image the data IF(zscale(1,igroup).EQ.zscale(2,igroup)) : zscale(2,igroup) = zscale(1,igroup)+1. IF(lctnam(igroup).GT.0) THEN CALL PLTCCT(cctnam(igroup), lctnam(igroup)) END IF IF ( itfun(igroup).GE.0 ) THEN CALL PGSITF(itfun(igroup)) ELSE CALL PLTHIS(Yray, i2drow, Nvec, I1, I2, J1, J2, : zscale(1,igroup), zscale(2,igroup) ) END IF CALL PGIMAG(Yray, i2drow, Nvec, I1, I2, J1, J2, : zscale(1,igroup), zscale(2,igroup), tr) CALL PGBOX('BCST',XSPAC,NSUBX(iwnum), : 'BCST',YSPAC,NSUBY(iwnum)) IF ( CXOPT(iwnum)(7:7).NE.'G') THEN CALL PGBOX(CXOPT(iwnum),XSPAC,NSUBX(iwnum), : CYOPT(iwnum),YSPAC,NSUBY(iwnum)) ELSE CXOPT1 = CXOPT(iwnum) CXOPT1(7:7) = ' ' CYOPT1 = CYOPT(iwnum) CYOPT1(7:7) = ' ' CALL PGBOX(CXOPT1,XSPAC,NSUBX(iwnum), : CYOPT1,YSPAC,NSUBY(iwnum)) CXOPT1 = 'G' CYOPT1 = 'G' CALL PLTSCI(IGCOL) CALL PLTSLS(IGLS) CALL PGBOX(CXOPT1,XSPAC,NSUBX(iwnum), : CYOPT1,YSPAC,NSUBY(iwnum)) END IF IF ( icbar(igroup).NE.0 ) THEN CALL PGWEDG('RI',1.4,3.0, : zscale(1,igroup),zscale(2,igroup),' ') END IF END IF END IF IF ( icont(igroup).GT.0 ) THEN IF ( ipmod(igroup).LE.0 ) THEN IF ( ipmod(igroup).NE.0 ) THEN C Plotting residuals imnum = ABS(ipmod(igroup)) ELSE C Just plot the data, use a dummy model number imnum = 1 END IF CALL PLCONB(Yray, i2drow, Nvec, I1, I2, J1, J2, & rlvcon(1,igroup), MXLEV, tr, NO, npts, ipmod(igroup), igroup, & icomp(1,imnum), pval(1,imnum), nterm(imnum), & icocon(1,igroup), ilscon(1,igroup), rlwcon(1,igroup) ) CALL PLTSCI(1) CALL PLTSLS(1) CALL PLTSLW(WIDTH) END IF END IF END IF C C- Plot model. 750 CONTINUE IF ( ipmod(igroup).GT.0 ) THEN imnum = ipmod(igroup) IF ( igroup.GT.MXGRP-MXMOD ) THEN C For the default model, we contour using the same contour levels as C the fitted data group, but with forced solid lines. iftg = ifitg(ipmod(igroup)) itmp = 0 DO i=1, MXLEV IF ( ilscon(i,iftg).EQ.1 ) THEN ilscon(i,0) = 4 ELSE ilscon(i,0) = 1 END IF END DO ELSE iftg = igroup itmp = iftg END IF IF ( iftg.LE.MX2D .AND. icont(iftg).NE.0 ) THEN CALL PLCONB(Yray, i2drow, Nvec, I1, I2, J1, J2, & rlvcon(1,iftg), MXLEV, tr, NO, npts, +1, iftg, & icomp(1,imnum), pval(1,imnum), nterm(imnum), & icocon(1,iftg), ilscon(1,itmp), rlwcon(1,iftg) ) GOTO 770 END IF CALL PLTSCI(icol(igroup)) CALL PLTSLS(lsty(igroup)) IF ( widlin(igroup).EQ.0.0) THEN CALL PLTSLW(WIDTH) ELSE CALL PLTSLW(widlin(igroup)) END IF IF ( nfpl.EQ.0 ) THEN C Plot model only at the x-coordinates of the group that was fitted. iftg = ifitg(ipmod(igroup)) new = 1 DO 760 I= 1,igrpos(2,iftg) CALL PLTXCC(Yray, i, iftg, xt, ndim, iyoff) IF ( XT(1).EQ.NO .OR. XT(1).LT.pmin(1) .OR. & XT(1).GT.pmax(1) ) THEN new = 1 GOTO 760 END IF YT = FNFIT(XT,ICOMP(1,ipmod(igroup)), & PVAL(1,ipmod(igroup)),nterm(ipmod(igroup))) IF ( YT.EQ.NO ) THEN new = 1 GOTO 760 END IF IF ( LOGX(iwnum).NE.0 ) XT(1) = & LOG10(MAX(XT(1),RMNLOG)) IF ( LOGY(iwnum).NE.0 ) YT = LOG10(MAX(YT,RMNLOG)) IF ( new.NE.0 ) THEN new = 0 CALL PGMOVE(XT(1),YT) ELSE CALL PGDRAW(XT(1),YT) END IF 760 CONTINUE ELSE C Plot model at evenly spaced locations. C %%% only works in 1D case. IF ( nfpl.LT.0 ) THEN iftg = ifitg(ipmod(igroup)) XLO = xymnmx(1,iftg) XHI = xymnmx(3,iftg) ELSE XLO = pmin(1) XHI = pmax(1) END IF IF ( LOGX(iwnum).NE.0 ) XLO = LOG10(MAX(XLO,RMNLOG)) IF ( LOGX(iwnum).NE.0 ) XHI = LOG10(MAX(XHI,RMNLOG)) XDEL = (XHI-XLO)/ABS(nfpl) new = 1 XCEN = XLO XT(2) = 0.0 DO I = 0,ABS(nfpl) XT(1) = XCEN IF ( LOGX(iwnum).NE.0 .AND. : XCEN.LT.1.E35 ) XT(1) = 10.**XCEN YT = FNFIT(XT,ICOMP(1,ipmod(igroup)), & PVAL(1,ipmod(igroup)),nterm(ipmod(igroup))) IF ( YT.EQ.NO ) THEN new = 1 ELSE IF ( LOGY(iwnum).NE.0 ) & YT = LOG10(MAX(YT,RMNLOG)) IF ( new.NE.0 ) THEN new = 0 CALL PGMOVE(XCEN,YT) ELSE CALL PGDRAW(XCEN,YT) END IF END IF XCEN = XCEN+XDEL END DO END IF END IF C End loop over plot groups 770 CONTINUE C C Now plot labels, if LAbel ON. (LAbel OFf dates from the days when C graphics devices were slow.) IF ( IAND(IPLAB,1).NE.0 .AND. ipall.NE.0) THEN CALL PLTSCI(1) CALL PLTCS(CSIZE) CALL PLTSLW(WIDTH) IF ( LOGX(iwnum).NE.0 ) THEN WXMIN = LOG10(MAX(WXMIN,RMNLOG)) WXMAX = LOG10(MAX(WXMAX,RMNLOG)) END IF IF ( LOGY(iwnum).NE.0 ) THEN WYMIN = LOG10(MAX(WYMIN,RMNLOG)) WYMAX = LOG10(MAX(WYMAX,RMNLOG)) END IF XCEN = (WXMIN+WXMAX)/2. TMP1 = WINLOC(3,iwnum)-WINLOC(1,iwnum) TMP2 = BOXVP(3,iwnum)- BOXVP(1,iwnum) XDEL = .025*CSIZE*(WXMAX-WXMIN)/(TMP1*TMP2) YCEN = (WYMIN+WYMAX)/2. TMP1 = WINLOC(4,iwnum)-WINLOC(2,iwnum) TMP2 = BOXVP(4,iwnum)- BOXVP(2,iwnum) YDEL = .025*CSIZE*(WYMAX-WYMIN)/(TMP1*TMP2) ctmp = CYLAB(iwnum) IF ( LENACT(ctmp).LE.0 ) THEN igroup = IFGRP(ipwin, MXGRP-MXMOD, iwnum) IF(igroup.EQ.0) igroup = 2 ctmp = cglab(igroup) END IF CALL PLTTEX(WXMIN-PYLAB*XDEL,YCEN, 90.,2,4,ctmp) CALL PLTTEX(WXMIN-3.0*XDEL,YCEN, 90.,2,4,COYLAB(iwnum)) IF(CXOPT(iwnum)(5:5).EQ.'N') THEN IF(LENACT(CXLAB(iwnum)).NE.0) THEN CALL PLTTEX(XCEN,WYMIN-2.5*YDEL, 0.0,2,4,CXLAB(iwnum)) ELSE IF ( ixvec.GT.0 ) THEN CALL PLTTEX(XCEN,WYMIN-2.5*YDEL, 0.0,2,4,cglab(ixvec)) END IF CALL PLTTEX(XCEN,WYMIN-3.7*YDEL, 0.0,2,4,COXLAB(iwnum)) END IF CALL PLTTEX(WXMIN,WYMAX+0.5*YDEL, 0.0,1,4,CFNAM(iwnum)) CALL PLTTEX( XCEN,WYMAX+1.8*YDEL, 0.0,2,4,CTLAB(iwnum)) CALL PLTTEX( XCEN,WYMAX+3.0*YDEL, 0.0,2,4,COTLAB(iwnum)) DO I = 1,MXLAB IF ( ILABEL(1,I).EQ.iwnum ) THEN xtmp = FLABEL(1,I) IF(LOGX(iwnum).NE.0) xtmp = LOG10(MAX(xtmp,RMNLOG)) YT = FLABEL(2,I) IF(LOGY(iwnum).NE.0) YT = LOG10(MAX(YT,RMNLOG)) XRANGE = WXMAX-WXMIN YRANGE = WYMAX-WYMIN CALL PLTSCI(ILABEL(4,I)) CALL PGMOVE(xtmp,YT) IF ( ILABEL(6,I).GE.0 ) THEN CALL PLTCS(FLABEL(7,I)) CALL PLTSMK(ILABEL(6,I)) CALL PLTPM(1,xtmp,YT) IF(ILABEL(2,I).EQ.1) THEN xtmp = xtmp+0.020*FLABEL(7,I)*XRANGE ELSE IF(ILABEL(2,I).EQ.3) THEN xtmp = xtmp-0.020*FLABEL(7,I)*XRANGE END IF END IF IF ( ILABEL(7,i).GT.0 ) THEN CALL PLTSLS(ILABEL(5,I)) xtmp = FLABEL(5,i) IF(LOGX(iwnum).NE.0) xtmp = LOG10(MAX(xtmp,RMNLOG)) YT = FLABEL(6,i) IF(LOGY(iwnum).NE.0) YT = LOG10(MAX(YT,RMNLOG)) CALL PGDRAW(xtmp,yt) IF(ILABEL(5,I).NE.1) CALL PLTSLS(1) ELSE IF ( FLABEL(6,I).GT.0. ) THEN C- Draw line from marked position outward to label CALL PLTSLS(ILABEL(5,I)) xtmp = xtmp+FLABEL(6,I)*XRANGE*COS(FLABEL(5,I)/RTD) YT = YT+FLABEL(6,I)*YRANGE*SIN(FLABEL(5,I)/RTD) CALL PGDRAW(xtmp,YT) IF(ILABEL(5,I).NE.1) CALL PLTSLS(1) END IF CALL PLTCS(FLABEL(4,I)) CALL PLTTEX(xtmp,YT,FLABEL(3,I), & ILABEL(2,I),ILABEL(3,I),CLABEL(I)) END IF END DO CALL PLTCS(CSIZE) END IF C End loop over all windows 790 CONTINUE C--- IF ( ipall.EQ.0 ) THEN CALL PGEBUF CALL PGUPDT GOTO 100 END IF C--- C- Put various labels on plot. IF ( IAND(IPLAB,1).NE.0 ) THEN C--- C- Numbered labels in viewport coodinates CALL PLTSVW(BOXVP, WINLOC, XYSCAL, LOGX, LOGY, IWADJ, 0) DO I = 1,MXLAB IF(ILABEL(1,I).LT.0) THEN xtmp = FLABEL(1,I) YT = FLABEL(2,I) CALL PLTSCI(ILABEL(4,I)) IF(ILABEL(6,I).LE.0) THEN CALL PGMOVE(xtmp,YT) ELSE CALL PLTCS(FLABEL(7,I)) CALL PLTSMK(ILABEL(6,I)) CALL PLTPM(1,xtmp,YT) IF(ILABEL(2,I).EQ.1) THEN xtmp = xtmp+0.020*FLABEL(7,I) ELSE IF(ILABEL(2,I).EQ.3) THEN xtmp = xtmp-0.020*FLABEL(7,I) END IF END IF IF(FLABEL(6,I).GT.0.) THEN C- Draw line from marked position outward to label CALL PLTSLS(ILABEL(5,I)) xtmp = xtmp+FLABEL(6,I)*COS(FLABEL(5,I)/RTD) YT = YT+FLABEL(6,I)*SIN(FLABEL(5,I)/RTD) CALL PGDRAW(xtmp,YT) IF(ILABEL(5,I).NE.1) CALL PLTSLS(1) END IF CALL PLTCS(FLABEL(4,I)) CALL PLTTEX(xtmp,YT,FLABEL(3,I),ILABEL(2,I),ILABEL(3,I), : CLABEL(I)) END IF END DO C--- C- Write model parameters on right edge. IF ( ipwin(MXGRP-MXMOD+icmod).GT.0 .AND. & IAND(IPLAB,2).NE.0 ) THEN CALL PLTSCI(1) CALL PLTSLW(1.0) CALL PLTCS(0.75) XDEL = .0225 NSTOP = nterm(ICMOD) IF ( PVAL(NSTOP+1,ICMOD).GE.0. ) NSTOP = NSTOP+2 NROW = 1+(NSTOP-1)/5 NMAX = INT((0.992-BOXVP(3,icwin))/XDEL) NMAX = MIN(NMAX,NROW) C- X position in viewport coordinates TMP = 0.992-(NMAX-1)*XDEL DO I = 1,NMAX IS = 1+5*(I-1) IE = MIN(IS+4, NSTOP) WRITE(CRLAB,831) (CPARM(ICOMP(1,ICMOD),K,nterm(ICMOD)), : PVAL(K,ICMOD),K = IS,IE) 831 FORMAT(1P,5(A,'=',G11.4,:,', ')) CALL PLTTEX(TMP,0.06,90.,1,4,CRLAB) TMP = TMP+XDEL C- Fortran 8x EXIT statment IF(TMP.GE.1.0 .OR. IE.GE.NSTOP) GOTO 850 END DO 850 CONTINUE END IF C- Plot the date. IF ( ITIME.NE.0 ) THEN CALL PGIDEN END IF END IF CALL PLTCS(CSIZE) C--- CALL PGEBUF CALL PGUPDT IF ( QHARD ) THEN CALL PGEND IOPEN = 0 QHARD = .FALSE. cpfile = CPSAV END IF GOTO 100 C--- 900 Ier = -1 C--- C Restore original state. 950 CONTINUE IF ( idoend.NE.0 ) THEN CALL PGEND ELSE IF ( IOPEN.EQ.0 ) THEN CALL PLTOPE(cpfile,ibcol,scrcol,cfont,pgpapw,pgpapa,Ier) END IF DO iwnum = 1,MXWIN IF ( iactw(iwnum).GT.0 ) THEN CALL PLTSVW(BOXVP,WINLOC,XYSCAL,LOGX,LOGY, & IWADJ,iwnum) GOTO 960 END IF END DO END IF 960 CONTINUE IF ( IOPEN.LT.0 ) CALL PLTTER('A') CALL STWARN(0) IOPEN = 0 CALL XSETIN(CEXT) RETURN END fv5.5/tcltk/plt/plt.hlp0000644000220700000360000025164313224715127013760 0ustar birbylhea1 HELP PLT is an interactive plotting and fitting facility. When it is time to plot the data you will be prompted for a plotting device. There are three valid responses: Type ? to get a list of legal devices. Type > to go directly into command mode (no plot is produced). Or input a valid device and the plot will be produced on that device. PLT does not distinguish between upper and lower case. In this documentation upper case is used to denote the shortest unique abbreviation. 2 CLear CLear Immediately clear the current plot device. 2 COlor COlor [#] ON|OFf [glist] The first (optional) number allows you to reset the default color index for the plot groups specified in "[glist]". If the first number is omitted, then color index is not changed but the plotting of groups in glist can be turned on or off. For example, if you have 85 groups and you only want to see group 3, you can do this with COlor OFf 1..999 ! second number only needs to be larger than 85 COlor ON 3 r y It is also possible to change the color of other features on the plot. COlor MOdel #
Plot the model using color index #. Color # ON Grid
Use the color index specified by # when plotting the grid in the currently active window. COlor ?
Generate a list of possible color indices and their default color representations. 3 examples 
PLT> COlor OFf 1,2,3  ! Suppress plotting of groups 1, 2, and 3
PLT> COlor ON  2      ! Turn on plotting of group 2
PLT> COlor 5 ON 3     ! Use color 5 when plotting group 3
2 CONtour CONtour [gnum] ?|COlor list|LEvel list|LStyle list|LWidth list|OFf This command causes PLT contour a two dimensional array of data. The first number denotes the plot group to be contoured. If you have not defined any two dimensional plot groups, then PLT will automatically create a group for you that consists of the largest possible chunk of the main data array. If you omit the first number then PLT uses the group number from the last time you used the CONtour, IMAge, DGroup (to define a 2D array). If none of these commands were used, the PLT will use group 1. A contour plot does not automatically turn off the normal plotting of the remaining plot groups, and typical arrays to be contoured may contains lots (hundreds!) of columns the possiblity that some of those groups will normally overwrite the contour is high. Thus you are advised to issue a COlor OFf 1..999 to suppress the normal ploting, unless, of course you are a PLT wizard and want to mix the two types of plot. If order for a contour to appear you must define a set of levels via the LEvel subcommand. 3 example Although this example is intended to be standalone, it will work with the fig06.qdp file. In other words, if you use qdp to plot fig06.qdp you can enter the following commands to get two contour plots in two windows. You will also note that group 1 is plotted in window 2 and group 2 in window 1. This was done purely to illustrate that it is possible. In general you will get a lot less confused if you stick to a simpler convention (e.g., group 1 in window 1, etc.) 
Yplot OFf 1..99         ! Turn off all previous plots
DGroup 2 1 1 10 20      ! Define group 2 to be a 2D group
WIN 1                   ! Define the window to use
LOC 0 0 0.5 0.5         ! Locate window in bottom left corner
YPL 2                   ! Plot group 2 in window 1
CON 2 LEvels -0.5 0 0.5 ! Create contours at three levels
CON 2 LStyle 4 4        ! Use dotted lines for negative levels
CON 2 LWidth,,3         ! Make the level=0 line fatter
GAP 0.0 Nerr            ! Best for contour plots
R                       ! Reset the scale in this window
DGroup 1 11 1 20 20     ! Define group 1
WIN 2                   ! Define a second window
YPL 1                   ! Plot group 1 in window 2
LOC 0.5 0.5 1.0 1.0     ! :ocate window in upper right corner
CON 1 LEvels -1.5 -0.5 0 0.5 1.5
CON 1 LWidth,,,3        ! Fatten up level=0 in this plot
CON 1 LStyle 4 4        ! Use dotted lines for negative levels
R                       ! Reset the scale in this window
3 hints PGPLOT draws the line segments that make up the contour such that one coordinate of an (x,y) pair is always at a integer pixel position, i.e., a pixel center. This makes sense if you assume the z value is correct at the center of the pixel and thus one is computing where the contour level intersects the line between two pixel centers. To correctly set the default scale for contour plot you should use: GAp 0.0 Noerrors R ! reset the default scale. The GAp 0.0 ensures that there is no extra gap around the data, and the Noerrors causes the error bars to be ignored when min/max values are computed. This causes the default scale to be set by the pixel centers. It is possible to plot both a contour and an image in the same window. If the contour and image are both from the same group the PLT automatically plots the image first and then the contour "on top" of the image. If the contour and image correspond to different groups, then you should make sure the image is assigned a lower group number. This is because PLT plots the groups in order from the lowest to the highest. 3 Color By default PLT plots the first contour with color index 1, the second with color index 2, etc. (Use the PLT COlor ? command to see the default mapping of color index into colors). The CONtour Color sub-command can be used to override this default. Thus to plot the first 10 levels with color index 1, you would use CON Color 1 1 1 1 1 1 1 1 1 1 and to change just the third level to color index 3 use CON Color,,,3 Note, you must use the CONtour LEv subcommand to define the levels before any contours will be plotted. 3 LEvel This subcommand is required must be used before a contour plot will appear. The CONtour LEvel subcommand is followed by a list of numbers that correspond to the levels to be contoured. You can define up to 32 (set by MXLEV in PLT code) contour levels. Thus CON LEV -20 -10 0 10 20 would define 5 levels. PLT remembers the previous levels so you change the value for level 3 only by CON LEV ,,,3.14159 To use fewer levels than what had been previously defined you must use the NO data value. Thus CON LEV,,,,no would leave the first 3 levels unchanged and stop plotting levels above 4. 3 LStyle By default all contours are plotted with a line style of one. (Use the PLT "LStyle ?" command to get a list of the possible styles.) You can use the CONtour LStyle sub-command to change this. Suppose you wanted to use dotted lines (line style of 4) to plot negative contours. You would do this with CON LEV -10 -20 0 10 20 CON LS 4 4 Thus the first two contour levels would now be plotted with line style of 2 and the remainder would use the default line style. Note, you must use the CONtour LEv subcommand to define the levels before any contours will be plotted. 3 LWidth By default all contours are plotted with a line width of 1. You can override this default using the CONtour LWidth subcommand. Thus CON LWidth,,,3 would plot the third level with a line width of 3. Note, you must use the CONtour LEv subcommand to define the levels before any contours will be plotted. 3 OFf This subcommand is use to switch off the plotting of a contour with a plot group. This you no longer wish to see plot group 2 plotted with a contour, then you would use CON 2 OFF Of course, if you now want to see plot group 2 plotted as a regular Y vs X manner, make sure you use the COlor ON command, i.e., COL ON 2. Since group 2 is now a two dimensional array, you will now see the entire array was was being contoured projected onto the X coordinate. If you wish to restore group 2 to its original one dimensional form you should use "DGrroup 2 2", i.e., define group 2 to be the second vector in the main data array. 2 CPD CPD [$] Change the current plotting device. The current plot device is released; the next plot will be produced on the new device. By default PLT uses the plotting device specified in the PGPLOT_TYPE environment variable. If this variable is not defined then PLT will prompt for a plotting device at startup. Note: "CPD" with no argument releases the current plotting device. This is useful when plotting to a file and closing the device is necessary to get PGPLOT properly terminate and close the file. Also "CPD ?" will list all the devices supported. 3 examples 
PLT> CPD /PS         ! Output Postscript commands to a file
PLT> Plot            ! Send the current plot to the file
PLT> CPD             ! Close the file
2 CQuit CQuit Immediately clear the plot device and exit subroutine PLT. 2 CSize CSize # Set character size to # where # is greater than zero and less than five (one is default). 3 example PLT> CSize 2.0 ! Use a character size twice the default 2 Device Device [$] Define the plotting device. This is a synonym for the "CPD" command. 2 DGroup DGroup gnum def The define group command, DGroup, allows programmers and/or users to define new plot groups. The PLT default is for each plot group to consist of a data vector (the SKip command provides another way to override this default). The DGroup command gives the user total control over how the plot groups are defined. The gnum is the group number and must be in the range 1 to MXGRP-MXMOD (typically 60). def is the group definition and can be either a) A single number. The number corresponds to a vector number in the main data array. Thus "DGroup 2 2" would define group 2 to be the second vector, which is the default. b) Four numbers. If you think of the main data array to be a two dimensional array with coordinates corresponding to the row and vector numbers, then the first two numbers define a row, vector coordinate of one corner and the second set form the other corner. Thus "DGroup 4 5 3 10 3" would define group 4 to be rows 5 through 10 of vector 3, and "DGroup 4 1 1 10 20" would cause group 4 to include rows 1 through 10 and vectors 1 to 20. c) Either the word Model or Residual. By default, PLT reserves the high numbered groups (typically 61 to 64) to contain the model. However if you want to plot the same model in different window than the default you can define a new group to be that model The "DGroup 3 Res" command would cause group 3 to contain the current model residuals. The data min and max values are recomputed every time the model is changed. Of course, PLT does not change the scale unless you issue a "Rescale" command. 3 residual_example 
PLT> MO 1 CO               ! Define a COnstant model
 23                        ! Starting parameter
PLT> DGroup 2 Res          ! Group 2 is the model residuals
PLT> YPL 2                 ! Plot group 2 in current window
PLT> R Y                   ! Rescale and replot
PLT> FIT                   ! Fit
PLT> P                     ! Replot using the original scale
PLT> R Y                   ! Rescale using currng residual min/max values
3 examples
PLT> DGroup 2 2            ! Group 2 is vector 2 (the PLT default)
PLT> DGroup 2 1 2 10 2     ! Group 2 is rows 1 to 10 of vector 2
PLT> DGroup 2 2 1 10 99    ! Group 2 is now two dimensional, consisting
                           ! of rows 2 through 10 and vectors 1 to 99.
PLT> Dgroup 2 Res          ! Group 2 is now the model residuals.
2 Error Error OFf [glist] Turn off the plotting of errors for all plot groups specified in "[glist]". Error ON [glist] Undo the effects of the "Error OFf" command for the specified plot groups. Error Sq [glist] Set errors equal to "SQRT(value)" for the specified plot groups. Error Dia [glist] Draw diamond style errors on specified groups. Error X ON|OFf [glist] This command controls the plotting of the x-error bars. For example, if groups 1,2, and 3 all have associated errors, then the command sequence "Xaxis 1"; "Error X ON 2"; "Error X OFf 3", would cause the x-errors to be plotted when group 2 is plotted but not when group 3 is plotted. When fitting data, error bars will be used to weight the data only if the errors are visible. Thus "Error OFf" followed by "Fit" will produce an unweighted fit. Also, note that only the y-errors are used to weight the data. 3 examples 
PLT> Error OFf 1,2,3  ! Turn off errors for groups 1, 2, and 3
PLT> Error Dia 2      ! Plot diamond errors on plot group 2
PLT> Error ON         ! Plot errors for all plot groups
PLT> SKip Sing        ! Turn on the `skip' mode
PLT> Error X OFF      ! Suppress plotting of errors in x-direction
2 EXit EXit Exit subroutine PLT. 2 Fit Fit [#] [Iterate #] Cause PLT to call the fitting routine to search for the best fitting parameters for the model specified with the "MOdel" command. The first optional number is the plot group to fit. If this number is omitted, then "Fit" will continue to fit the previous group that you were fitting if that plot group is still visible. For the first use of "Fit" or if the plot group has been "COlored OFf" then "Fit" will default to fitting the lowest numbered group which is visible. The "LAbel PArm" command controls whether the model parameters are plotted on the right side of the plot. Fitting continues until Delta chi^2 is less than 0.05. As a default, you will be prompted to continue fitting every 10 iterations. If you wish to increase the number of iterations without being prompted, then use the "Fit Iterate [#]". Thus, "Fit I 100", would allow the program to try up to 100 iterations before you would be prompted again. Fit ON [#] Cause the current model to be plotted on group #. If # is omitted, the model will be plotted on plot group that was most recently fitted. Fit OFf Cause the model to no longer be plotted. Fit Plot # Control where the model is evaluated when it plotted. If # is greater than zero, then the model is evaluated at # points between the current x-scale Minimum and Maximum. If # is less than 0, then the model is evaluated at "ABS(#)" points between the Data Min and Data Max --- i.e., no extrapolation is allowed. If # equals 0, then the model is evaluated at the values of the data points. (This is the default.) Fit Stat Chi|Ml # Set the default fitting statistic to either chi^2 or maximum likelihood. For example, "Fit Stat M 2" would vary the fit parameter to minimize the likelihood function when compared with plot group 2. 3 statistics Prior to 1998 Oct, Fit Stat ML would minimize the likelihood function: C = 2 * SUM{ model(i) - data(i)*ln(model(i)) + ln(data(i)!) } where data(i) is the observed number of *counts* in the i'th bin and model(i) is the model evaluated at that location. Of course, data(i)! is the factorial. On 1998-Oct-01, the statistic was changed to: C = 2 * SUM{ model(i) + data(i)*[ln(data(i))-ln(model(i))-1.] } which is the same statistic as is now used by XSPEC (the famous John Castor "priv. comm." statistic). This differs from the likelihood function in terms that depend only upon the data. Since the goal is to find the minimum with respect to changes in the model parameters, this function will have the same minimum as the likelihood function. The advantage of this new function is that when you get a good fit, then C ~ DOF similar to chi^2. Of course, I would not suggest using a chi^2 table to interpret any results. Prior to this change the "fit stat ml" would only work properly if you were fitting raw counts. If we assume that rate(i) +/- sigma(i) = data(i)/E +/- SQRT(data(i))/E where E is typically the exposure (area*time). Then it is easy to show that: E = rate(i)/(sigma(i)^2) (It is straightforward to handle the special case where data(i)=0.) Using this expression, the PLT version of CURFIT now scales the rate back into raw counts, and hence it is now possible to fit rates using "stat ml". If you accidently used "stat ml" with the old version, then don't worry, the main difference is the estimated parameter uncertainties, in the old version the estimate would be way off, and now they are approximately correct. Finally, there is the case where the model goes to zero. There is no problem where the data(i) is also zero as C will evaluate to zero at that location. Formally speaking if the data<>0 then clearly there is a background term that should be included in the model (and if don't include the background then you really should not be fitting points where model=0). On the other hand, if the background level is low, for example, most of the counts are in a single gaussian shaped feature, then it is real tempting to model this with a single gaussian term and no background. If you tried this with the old version then you would discover that the gaussian width would slowly increase. This happened because it would result in fewer non-zero model bins and this would improve the statistic. In the new version a model floor is defined. Thus if the model evalutates to less than the floor level, when calculating the statistic, the floor value is used. For now the floor value used is 1.0E-6 counts/bin. Thus if your model depends on seeing one (or fewer) count in a million bins, then this will result in a error or bias. On the other hand this does allow you to fit a narrow gaussian, no background and get a sensible result. 2 FNy FNy # Return the value of the current "MOdel" function at location #. 3 example 
PLT> MOdel LINR CONS ! Define a straight line
  1, LI: VAL( 1.00), SIG( 0.00 ), PLO( 0.00), PHI( 0.00)?
2.                   ! Set slope of line equal to 2
  2, CO: VAL( 1.00), SIG( 0.00 ), PLO( 0.00), PHI( 0.00)?
3.                   ! Set intercept of line equal to 3
PLT> FNY 3           ! Evaluate function at x=3.0
12.0                 ! The result
2 FOnt FOnt $ Set the default to the font specified by the character string. (Default is Simple font.) FOnt ? List possible fonts. 3 example PLT> Font Roman ! Use the Roman font 2 FReeze FReeze [plist] Can only be used after a model has been defined. This command causes all parameters listed in "[plist]" to be frozen, which means the parameter value is not allowed to vary during a "Fit". 3 examples 
PLT> FReeze 2       ! Freeze the value of parameter 2
PLT> FReeze 3..5 9  ! Freeze the values of parameters 3 through 5 and 9
2 GAp GAp # Control the size of the gap between the edge of the plot and the data extrema, when using the default scale. The effect of the "GAp" command can only be seen when you reset the default scale with "R", "R X", or "R Y" (all with no arguments). The default gap is 0.025 which will leave a 2.5 percent margin around the edge. The size of the gap in world coordinates, depends on whether the data are being plotted on a logarithmic scale. Therefore, if you wish to use a default, logarithmic scale, you should first issue the "LOg" and "GAp" commands and then use the "Rescale" command to reset the default scale. The default gap is calculated based on the minimum and maximum of the data. If your data contains errors, then it is often useful to include the error bars in the calculation. This can be done using the "GAp Error" command which means the gap is calculated based on the minimum and maximum values including a one sigma error bar on the data. To revert to the original behavior to not include errors, use "GAp NoError". 3 examples 
PLT> GAp 0.0        ! No gap
PLT> R X            ! Use default X scale
PLT> GAp 0.05       ! Reset gap, for use with Y scale
PLT> LOg Y          ! Log the Y scale
PLT> R Y            ! Use default Y scale
2 Grid Grid [clist] Control the plotting of a grid, where "[clist]" is one or more of "ON", "OFf", "X # #", "Y # #". For "Grid ON", the major tic marks are expanded to place a grid over the entire plot. "Grid OFf" turns off the grid replacing the tic marks. PGPLOT automatically selects the location of the major and minor tic marks. The "Grid" command allows you to override this selection. For example, "Grid X 10,2" would divide the x-axis into 10 major divisions and then divide each major division into 2 minor divisions. Use "Grid X 0,0" to go back to the default grid. The number -1 can be used to suppress the plotting of tic marks. Thus, "Grid X -1 0" would only plot minor tic marks on the x-axis and "Grid Y -1 -1" would prevent any tic marks from being plotted on the y-axis. IMPORTANT: PGPLOT only places major tic marks at locations where the least significant digit of the range increments by integer amounts. If you attempt to force PGPLOT to violate this condition, then unexpected things may happen. For example, suppose you had used "R Y 0 .15", in which case the range is 0.15 and the least significant digit is 0.01. Then using "Grid Y 3,2" would place grid lines at intervals of 0.05. However, if you had tried "Grid Y 2,2", then the grid lines would occur at intervals of 0.075, where the last digit (5) is not a significant digit. In this case, the plot will be incorrectly labeled. "Grid X 1.5,2" is legal and would correctly produce labels at intervals of 0.1. (Of course, only one label would actually be plotted in this case.) 2 Hardcopy Hardcopy [$] Generate a copy of the plot using the current hardcopy specification. In general, this makes a file that can later be printed. The default PLT hardcopy device for the first use can be set using the PLT_HARDCOPY logical name (on VMS systems) or environment variable (on UNIX systems). After the first time, the "Hardcopy" command defaults to the same device as was specified in the previous "Hardcopy" command. "Hardcopy" produces a copy of what you would see if you reissued the "Plot" command. This might not be an exact copy of what is currently displayed on the graphics device. Hardcopy ? Display on the terminal the default hardcopy specification. 3 example PLT> Hardcopy /PS ! Create a Postscript file 2 HElp HElp [pcommand] Get help on the PLT command specified by "[pcommand]". 2 IMAge IMAge [MIN #|MAX #|OFF|CCT $|LOG|LIN|SQRT|HISTO|TOT] This command will allow you to display your data as an image. 3 CCT IMAge CCT $ PLT currently has 3 built in color tables. Use PLT> IMA CCT ? to see a list of these and a brief description. Thus if you use "CCT 1" you will get the gray scale color where the minimum value appears black and the maximum as white. To invert the color table preceed the name with a minus sign (no space). Thus "CCT -1" would give a grayscale image where the minimum is white and the max is black. Color tables can also be defined in external ASCII files. If you have a file called "blue.ct" then you can read this with "CCT blue". Note, "CCT -blue" will invert the color table, hence you are advised not to use a minus sign as the first character in the file name. 4 example PLT> IMA CCT 2 ! Use builtin color table 2 to display images. 4 file_format A color table file is an ASCII file consisting of a series of rows each with 4 columns. The first column is the "normalized color index" which must be in the range 0 to 1 and monotonically increasing. The next 3 columns are for the red, green, and blue values and each number must be in the range 0 to 1. Thus a minimal color table would consist of just two rows. Here is some sample data from a file which we will call "blue.ct" 
!CI   R    G    B
 0.   0.   0.   0.
 1.   0.   0.   1.
Using "CCT blue" will cause the minimum value to be plotted in black (no color on) and the maximum value will be plotted with the blue color full on, but red and green colors off. How does the color table work? Suppose PGPLOT has allocated color indices 17 to 240 for images. Assume you have set the min value is 0 and the max is 100, and you are about to display a pixel value of 40. With the linear scaling PGPLOT would plot this value with a color index of 0.4*(240-17+1) = 90. The normalized color index is 40/(100-0+1) = 0.40. Since this color index two values in the file, the software will do a linear interpolation for the red, green and blue values. Using the blue.ct given above, red and green values would both be off and the blue value would be set to 40 percent of the maximum value. The reason for using a normalized color index and an normalized color intensities is to reduce the dependence on the graphics device, i.e., you don't need to know how many color indices the device supports nor which ones PGPLOT have allocated to the image. Anyone who has worked with colors knows that "blue full on" looks different on different devices, hence you will need to fine tune the color table to look nice on the device you are plotting to. 3 MIN 3 MAX 3 TOT 3 hints PGPLOT draws pixels centered on the integer pixel location and extending out to +/- half a pixel. Thus if you want your image to exactly fill the plotting window, you should use GAp 0.0 Errors R ! reset the default scale. The GAp 0.0 ensures there is no extra gap around the data, and the Errors causes the error bars to be included when min/max values are computed. Since IMAge only works when using XAx Linear and YAx Linear this effectively includes the extra half pixel when the min/max are computed. PLT works equally well with both "pseudo color" and "true color" devices (if you don't know what these terms mean you might want to read the history topic below). Since pseudo color can only have one lookup table active per program, using multiple color tables in different PLT windows can result in confusion when switching from a pseudo color device (such as a SUN X Window display) to a true color device (such as PostScript file). To avoid this confusion you should only use one color table for all plot windows. It is also suggested that you define this color table in the image that appears in the lowest numbered window i.e., the one that is plotted first. This ensures that the color table will be correctly loaded for all following windows. 3 history Pseudo color devices were invented early in the age of computers where processors were slow and memory was expensive. Thus it was not practical to store a 24 bit (Red,Green,Blue) RGB color triplet for every pixel. What was (typically) done was store an 8 bit color index instead which allows only 256 color indices at each pixel. However, even early monitors could diplay more than 256 colors resulting in a missmatch between the display adapter and the monitor. In order to give users the ability use more than 256 colors, a lookup table was implemented. For example, color index 2 could correspond to Red=255, Green=10, Blue=10 a red pixel. Thus the hardware would read the color index of a pixel, lookup corresponding color in the color lookup table and then draw the pixel on the screen. This can be done very quickly and is very memory efficient. Another advantage of using a color lookup table is it can be reloaded very quickly. For example, the IRAF image display exploits this feature by allowing the user to change the lookup table by draging the mouse around in the display window. Although this allows you to quickly find a color table that enhances the features they are interested in, it is worth noting that you are not enhancing the data, just the monitors ability to display the data. In other words, features that are visible when one lookup table is loaded, are still present (in the display memory) for all the other lookup tables tried. At the current time, it is typical for computers to display several windows each drawn by a different program. If all these programs can agree on a color lookup table then things work fine. On the other hand if a program wants total control of a lot of colors (IDL and Netscape are famous for this) then the operating system must swap lookup tables around as the user changes from window to window, program to program. Since the lookup table can be loaded very quickly this results in entire monitor flashing from one set of colors to another. It is no longer necessary to skimp on memory. Current machines have no problem loading 24 bit RGB indices at resolutions up to 1000 by 800 pixels (2.4 MB for display memory). In fact, since three is an odd number most displays load 32 bits per pixel, with 24 bits of RGB data and 8 bits of something else such as a "alpha overlay plane". This makes true color devices possible. What true color means, is each pixel is loaded with its true RGR color triplet, and hence there is no color lookup table. Thus pseudo color means a color index is stored in memory and lookup table is used to map the color index into a RGB triplet. A true color device stores the RGB triplet in memory. Many people assume X Windows pseudo color, however, X Windows can actually support either. Suns typically implement X in a pseudo color manner whereas SGIs typically implement true color. PostScript of course, is true color (i.e., no amount of messing with a color table is going to change what is printed on paper.) 2 IMOdel IMOdel [# # [#]] Integrate the current model over the range specified by the first two parameters. The third (optional) number, which defaults to 200, is the number of steps. For 2-dimensional data you can use IMOdel IMOdel [# # [#]] [# # [#]] where 2nd triplet of numbers specify the lower and upper limits, and the number of steps to use in the Y direction. The method only uses a simple rectangle rule to calculate the integral. 2 Info Info Call Display the various argument values in the original call to the PLT subroutine. Useful for programmers to figure out what they are really telling PLT to do. Info Groups For each active group, display some interval variables. Info Scales For each active plot group display the label and data min/max values. This is the default value. Info Windows Display PLT internal inforomation about the various active windows. 2 LAbel LAbel G#|X|Y|Top|OX|OY|OTop|File [label] Place a label. The command "LA G# label" associates a label with a particular plot group. Thus the command sequence "LAB G1 Time; Xaxis 1", associates the label "Time" with group 1. When the command "Xaxis 1" executes, it makes group 1 the x-axis group, and as a result the label "Time" will automatically appear on the x-axis. The arguments "X", "Y", and "Top" would place a label on the x-axis, y-axis, or the top of the plot. These labels override the Group labels so that if the x-axis is labelled with both a group label and a x label, then only the x label appears. When using the "Xaxis Linear" command, "LAbel X" the the only way to label the x-axis. It is possible to place an additional line of text just outside these locations by putting the letter `"O"' in front of these names. For example, "OT" would write a second label above the top label. Finally one can change the file name by using "LA File [name]". If you should at any time wish to delete a label, then just omit the "[label]" from the command. LAbel OFf Suppress plotting of all text labels. (This speeds up the production of the plot on slow devices.) LAbel ON Undo the effects of "LAbel OFf". LAbel NX|NY ON|OFf [winlist] where "[winlist]" is a list of windows. NX affects the plotting of the numeric labels on the x-axis, NY on the y-axis. Thus "LAbel NX OFF 1"; "LAbel NY OFF 1", will prevent the plotting of the numeric labels in both the x and y directions for the first window. (Note, there are 32 numbered labels, so using "LAbel NX OFf", followed by several "LAbel #" commands will allow you to create labels consisting of text strings etc. LAb POS Y # Allows the position of the y label(s) to be changed. The default position is "LA POS Y 2.0". LAbel Rotate Rotate numerical labels plotted on the y-axis. The default PGPLOT mode is to plot the y-axis numerical labels in the vertical direction. "LAbel Rotate" will rotate these labels so they are written in a horizontal direction. If you issue the command a second time, then the labels will flip back to vertical in the next plot. 3 examples 
PLT> LA F               ! Delete the file name from the plot
PLT> LA T Test! Plot    ! Top label is Test
PLT> LA T "Test! Plot"  ! Top label is Test! Plot
3 Parm LAbel Parm ON Display the parameter values associated with the current model, on the right side of the plot. (This is the default.) LAbel Parm OFf Suppress the display of the parameter values on the right side of the plot. 3 # LAbel # [clist] "string" Allow a label to be placed anywhere on the existing graph. Here # is a number in the range 1 to 32, "[clist]" is a list of subcommands that allow you to change various attributes of the label, and ``string'' is the (optional) text. For example, PLT> LAbel 1 Pos 2 2 "test" will create label 1 at position (2,2) containing the message "test". 4 CEnter LAbel # CEnter Top|Cap|Half|BAse|BOttom Control the vertical position of the text string. The default position is "Half", although the use of the "LIne" subcommand will override this. 4 COlor LAbel # COlor # Cause the label to be plotted with color index #. (Default is color index 1.) 4 CSize LAbel # CSize # Cause the label to be plotted with character size #. (Default is character size 1.0.) 4 Justify LAbel # Justify Left|Center|Right Control justification of text string. (Default is left justify.) 4 LIne LAbel # LIne # [#] Draw line at angle # (in degrees) from position to the label. If the second number is specified, then it will be used as the length of the line in viewport units. (Default line length is 0.08.) If no number follows the "LIne" command, then the line is turned off. 4 LStyle LAbel # LStyle # Control the line style of the line plotted, when the "LIne" subcommand is used. (Default is 1.) 4 Marker LAbel # Marker # Include marker # in the text line. The default will produce a left justified string just to the right of the marker. If you then right justify the string, then the string will appear to the left of the marker. In either case, the (x,y) position corresponds to the position of the marker. 4 MSize LAbel # MSize # Use the specified marker size with plotting the specified numbered label. Default size is 1.0. 4 Position LAbel # Position # # Specify the (x,y) location of the string in world coordinates. When using the "LIne" subcommand, "Position # #" gives the (x,y) location of the position being `pointed at' with the text string at the other end. If the "Marker" subcommand is used, then "# #" refers to the location of the marker. For other cases, "# #" is the location of the string. The "CEnter" and "Justify" subcommands can later override how text is plotted relative to a location. (The default location is (0,0).) 4 TExt LAbel # TExt one=%1% two=%2% All the text on the line following the TExt subcommand becomes the label. The main difference between using simple " and using TExt has to do with the command parsing. Thus with LAb 1 "%1%" the label would be the actual string %1% whereas LAb 1 TExt %1% would substitute %1% with the first argument. 4 To LAbel # To # # Draws a line from the position specified with the Pos # # option to the location in the To field. NOTE: If you add a text label, the text will be plotted at the "To" location. This is for maximum compatibility with the "LAb # LI 45 .1" command. Example: PLT> LAB 1 Pos 0 1 To 0 1 " " ! Draw line from (0,1) to (1,0) 4 Rotate LAbel # Rotate # Plot the label at an angle of # (degrees) relative to the x-axis. (Default angle is 0.) 4 VPos LAbel # VPos # # Specify the (x,y) location of the string in viewport coordinates. When using the "LIne" subcommand, "Position # #" gives the (x,y) location of the position being `pointed at' with the text string at the other end. If the "Marker" subcommand is used, then "# #" refers to the location of the marker. For other cases, "# #" is the location of the string. The "CEnter" and "Justify" subcommands can later override how text is plotted relative to a location. LAbel # VPos Curs Display the cursor at the current default position. You can move the cursor to the desired position using the standard (PGPLOT) cursor keys. Once at the location where you want the label, press the space bar. The next time the plot is drawn, the label will appear at the new location. 4 examples 
PLT> LAbel 1 "TEST"   ! Place the word TEST at location (0,0)
PLT> LAbel 1 P 10 10  ! TEST will now appear centered at (10,10)
PLT> LAbel 1 LIne 90  ! Draw a vertical line from the point (10,10) to
                      ! the word TEST.
PLT> LAbel 1 CO 3     ! Color line and word TEST green
PLT> LAbel 1 P 10 10 LIne 90 CO 3 "TEST"   ! Does all the above in a
PLT>                                       ! single command
2 LIne LIne ON [glist] Draw a line connecting all the points in each plot group specified in "[glist]". LIne OFf [glist] Produce a scatter diagram by turning off the line for each plot group specified in "[glist]". LIne Stepped [ON] [glist] Produce a stepped-line plot for each plot group specified in "[glist]". LIne # [ON] [glist] PLT always draws straight lines between mesh points and the default is each data point corresponds to a mesh point. When plotting a line it is sometimes useful to use more mesh points than data points. The LIne # will force PLT to use ABS(#) mesh points. If # is greater than zero, then the line is evaluated at # points between the current x-scale Minimum and Maximum. If # is less than 0, then the line is evaluated at "ABS(#)" points between the Data Min and Data Max --- i.e., no extrapolation is allowed. If # equals 0, then the line is evaluated at the data points. (This is the default.) If a mesh point lies between two data points then a cubic spline using Akima coefficients is used to evalute the location of the mesh point. This gives the illusion that a smooth line connects the data points. Note: this command will only work if the x values are strictly increasing. Note: If you set "Error OFf", "MArker OFf", and "LIne OFf", then the line will still appear. The only way to prevent data from being plotted is to use the "COlor OFf" command. 3 examples 
PLT> LIne ON         ! Use a line for all groups
PLT> LIne OFf 1,3    ! Turn off the line for groups 1 and 3
PLT> LIne Step 1,5   ! Plot groups 1 and 5 with a stepped line
PLT> LIne 200 ON 2   ! Plot 'smooth' line on 200 points over current X range
PLT> LIne -200 ON 3  ! Plot 'smooth' line over 200 points from data min
                     ! to data max
2 LOCation LOCation # [# [# [#]]] The "LOCation" command allows you to control the location of the currently active window. The default location of all windows is 0. 0. 1. 1. which means that all windows overlap and use the entire plotting surface. This command in combination with the "WIndow" command allows great control over where the windows are plotted. Thus a small window could be plotted inside a larger one. However, no attempt is made to erase a plotting region, so overlapping windows could result in overlapping text. 3 examples To create 4 windows in the 4 quadrants, use: 
PLT> WIndow 1
PLT> LOCation 0 .5 .5 1.
PLT> WIndow 2
PLT> LOCation .5 .5 1. 1.
PLT> WIndow 3
PLT> LOCation 0. 0. .5 .5
PLT> WIndow 4
PLT> LOCation .5 0. 1. .5
2 LOg LOG X|Y|X,Y ON|OFf [winlist] Controls whether a log scale is used when plotting in the windows specified in "[winlist]". Thus "LOG Y OFf 2 3 4", would turn off the use of a log scale in the y direction in windows 2 3 and 4. Also, "LOG X,Y OFf 3" would turn off the log scale in both the x and y directions when plotting in window 3. 2 LStyle LStyle # [ON] [glist] Change the default line style for the plot groups specified in "[glist]". The first number is the style type. Note, glist can also contain 'Model' to change the line style when plotting the current model, or 'Grid' to change the line style when plotting the grid in the currently active window. LStyle ? List possible line styles. 3 examples 
PLT> LStyle 2 ON 3    ! Use line style 2 when plotting group 3
PLT> LStyle 1         ! Use solid line when plotting all groups
PLT> LStyle 5 ON 1,4  ! Use line style 5 when plotting groups 1 and 4
PLT> LS 2 ON 3,MOD    ! Use line style 2 when plotting group 3 and the
                      ! current model.
2 LWidth LWidth # [ON] [glist] Set the line width to the value #. Allowed values are 1 or greater. On some laser printers, the default line width is very narrow and so, using thicker lines will enhance the output quality. If glist is omitted then this command resets the default line width for the entire plot. If you list some group numbers in glist then the groups listed in glist will no longer be plotted with the default line width but rather with the line width you specified. Also, glist can contain the word 'Model' to change the default line width when plotting the current model. 3 examples 
PLT> LWidth 3         ! Triple the default thickness of all lines
PLT> HArd /PS         ! and make a hardcopy
PLT> LWidth 1 ON 2    ! Plot group 2 with line width 1.  The rest of the
                      ! plot will still be plotted with line width 3.
PLT> LW 3 ON MOD      ! Plot current model with line width 3.
2 MArker MArker [#] ON [glist] Turn on the plotting of polymarkers. The first (optional) number is the marker type; if omitted the default marker type will not be changed. If "[glist]" is omitted, then markers will be used to plot all plot groups. MArker OFf [glist] Turn off the plotting of markers for all plot groups specified. If "[glist]" is omitted, then markers will be removed from all groups. MArker Size # ON [glist] Changes the size of the markers when plotting the plot groups specified in "[glist]". The size can range from 0.0 to 5.0, where 1.0 is the default. Thus every plot group can have a different marker size. MArker ? Draw a table of all the PGPLOT markers on your current graphics device. 3 examples 
PLT> MArk 19 ON 2     ! Use marker 19 when plotting group 2
PLT> MArk OFF 2       ! No longer plot group 2 with a marker
PLT> MArk ON 2        ! Use default marker when plotting group 2
PLT> MArk ON          ! Use markers when plotting all plot groups
PLT> MArk Size 5      ! Plot markers 5 times larger than default size
2 MMaster MMaster iwnum X|Y|XY wlist MMaster iwnum Off Use this command to slave the scales of the windows listed in the window list (wlist) to that of the master. For example if you use MM 1 X 3 4 7 Then every time you change the X scale in window 1 then the X scales of windows 3, 4 and 7 will also be updated to be the same as what is in window 1. Any attempt to change the X scale of windows 3, 4, and 7 for example using a "R X4" type command, will be ignored. 3 example 
! Plot
WIN  1
LOC  0 .5 .5 1
YPL  1
! Create window 2 in upper right corner and put the model in it.
WIN  2
LOC  .5 .5 1 1
YPL  2
! Create window 3 in bottom left corner and put residuals in it.
WIN  3
LOC  0 0 .5 .5
YPL  3
! Sync everything to window 1
WIN  1
MM   1 xy 2 3
r    600 800 550 750  ! Scales for Windows 1, 2, and 3 are all affected.
2 MOdel See definition subtopic for help on creating models. MOdel ? List all built-in model components. MOdel @filename Cause the model definition and parameters to be read from the file with name "filename". Although chi^2 is written to the model file it is important to refit before issueing an UNcertain command. This is to avoid potential problems with roundoff errors. 3 definition A model consists of several components that are added together. For example, "MOdel CONS LINR QUAD" will add a constant term, a linear term, and a quadratic term. For each parameter required by the "MOdel" command, you will be prompted for four numbers --- "VAL", "SIG", "PLO", and "PHI" --- as described below. For each parameter, you should enter an initial value for "VAL"; but you can usually default on the other three numbers. "VAL": This is the actual value of the parameter. Although CURFIT will often find the the best set of parameters to model the data, it never hurts to start it with parameters near the expected best fit. "SIG": Any value of "SIG">=0 will not affect the outcome of "Fit". After you fit the model, "SIG" will contain the one-sigma curvature errors. This number is used by the "Uncertainty" command to start a formal error determination. If the "Uncertainty" command fails to converge because the original error estimate is wrong, sometimes you can improve the convergence by adjusting "SIG" to be a better estimate before using "Uncertainty". If you set "SIG=-1", then the parameter is frozen such that CURFIT is not allowed to change the parameter value while fitting. If you set "SIG"=-IPAR, the next number ("PLO") will default to 1, such that the current parameter value is forced to equal the value of parameter IPAR. (Note: IPAR can not equal 1 or the current parameter number.) If you place a number (N) after "SIG", this will force the current parameter to be N times the specified parameter. (N defaults to 1.0.) PLT> MOdel GAUS GAUS 1, GC: VAL( 1.00), SIG( 0.00 ), PLO( 0.00), PHI( 0.00)? ,-4,2 2, GW: VAL( 1.00), SIG( 0.00 ), PLO( 0.00), PHI( 0.00)? 3, GN: VAL( 1.00), SIG( 0.00 ), PLO( 0.00), PHI( 0.00)? 4, GC: VAL( 1.00), SIG( 0.00 ), PLO( 0.00), PHI( 0.00)? 2. 5, GW: VAL( 1.00), SIG( 0.00 ), PLO( 0.00), PHI( 0.00)? 6, GN: VAL( 1.00), SIG( 0.00 ), PLO( 0.00), PHI( 0.00)? defines a model consisting of two gaussians, with the x values of the centers differing by a factor of 2. Although you did not enter a value for parameter 1, it will be set to the value of 6 (2 times value of parameter 4). This relation will be maintained throughout a fit. PLO, PHI: If SIG>=0 and if PLO MOdel ? will list all builtin model components. 3 2D_models PLT can fit functions to two dimensional data. In general this is best done with a COD file using the Y variable. A few common, simple functions are provided below. 4 CGau Circular Gaussian: FNY=FNY+Gn*EXP(-[xs**2-ys**2]/2.) where xs=(X-Xc)/Gw, ys=(Y-Yc)/Gw, and with integral SQRT(2*PI)*Gn*Gw*Gw. 4 NCga Normalized Circular Gaussian. Similar to CGau except the norm is now the integral: FNY=FNY+Gn*EXP(-[xs**2-ys**2]/2.)/(2.*PI*Gw*Gw) where xs=(X-Xc)/Gw, ys=(Y-Yc)/Gw, and with integral SQRT(2*PI)*Gn*Sx*Xy. 4 EGau Ellipical Gaussian: FNY=FNY+Gn*EXP(-[xs**2-ys**2]/2.) where xs=(X-Xc)/Sx, ys=(Y-Yc)/Sy, and with integral SQRT(2*PI)*Gn*Sx*Sy 4 NEga Normalized Ellipical Gaussian. Similar to EGau except the norm is now the integral: FNY=FNY+Gn*EXP(-[xs**2-ys**2]/2.) where xs=(X-Xc)/Sx, ys=(Y-Yc)/Sy, and with integral Gn. 4 LY Linear in Y FNY=FNY+Ly*Y Note the general model for a plane is Li*(X-Xc)+Ly*(Y-Yc)+b Expand and collect terms to get Li*X+Ly*Y+b-Li*Xc-Ly*Yc Which would be created with a MOdel of 'LI LY CO' and the CO would be set to an initial value of b-Li*Xc-Ly*Yc. Note, the maximum slope of the plane would be in the direction ATAN2(Ly,Li). 3 CONS Select a model with a constant component: FNY=FNY+CO. 3 LINR Select a model with a linear component: FNY=FNY+Li*X. 3 QUAD Select a model with a quadratic component: FNY=FNY+QU*X**2. 3 CUBI Select a model with a cubic component: FNY=FNY+CU*X**3. 3 X4 Select a model with an x^4 component: FNY=FNY+X4*X**4. 3 X5 Select a model with an x^5 component: FNY=FNY+X5*X**5. 3 POWR Select a model with a power-law component: FNY=FNY+PN*X**IN. 3 SIN Select a model with a sinusoidal component: FNY=FNY+SN*SIN(2*PI*(X-PH)/PE). 3 GAUS Select a model with a gaussian component: FNY=FNY+GN*EXP(-Z*Z/2.), where Z=(X-GC)/GW and with integral SQRT(2*PI)*GN*GW. 3 EXP Select a model with an exponential component: FNY=FNY+EN*EXP(-(X-EC)/EW). 3 AEXP Select a model with a symmetric exponential component (exp(-|x|) for all x): FNY=FNY+EN*EXP(-ABS(X-EC)/EW). 3 BURS Select a model with a burst component (linear rise followed by an exponential decay): FNY=FNY+0 for X 10^4) or models that involve reading a disk file, the user is advised to write a Fortran function using the user component. 4 example 
: NGAUS ! The file must contain a : followed by a dummy name
X       ! Push current value of X onto the stack
X       ! Push current value of X onto the stack
*       ! Multiply the top two numbers on the stack to get X*X
P1      ! Push the value of parameter 1 onto the stack
*       ! Multiply to get P1*X*X
NEG     ! Negate the number on the top of the stack (-P1*X*X)
EXP     ! Calculate EXP of -P1*X*X
P2      ! Push the value of parameter 2 onto the stack
*       ! Multiply to get P2*EXP(-P1*X*X)
;       ! The function must end with a ; character
This simple COD function ("NGAUS.COD") contains two parameters and calculates the value of "P2*EXP(-P1*X*X)". It could be written much more concisely as : NGAUS X X * P1 * NEG EXP P2 * ; 2 Newpar Newpar Display the values associated with all of the parameters and allow the user to change them. If you wish to display the parameter values without changing them, then use the "WModel" command. Newpar # Display the values associated with the parameter specified by the first argument. You can either enter return, leaving the parameter values unchanged, or enter new values. Newpar # # Change the value of the specified parameter to the value you entered in the second (and following) arguments. You will not be shown the original values. 3 examples 
PLT> Newp 2      ! Prompt for new values of parameter 2
  2, GW: VAL( 1.00), SIG( 0.00 ), PLO( 0.00), PHI( 0.00)?
3.               ! Value of parameter 2 is now set to 3
PLT> Newp 3 10   ! Value of parameter 3 is now set to 10
PLT> Newp 6,,-1  ! Freeze value of parameter 6
2 PAper PAper # # Resets the default size and aspect of the display/printing surface. The first number is the width of the plot in cm, the second number is the aspect ratio (height/width). This command uses the PGPLOT internal value for the resolution of the graphics device, and for some device types (such as displays) is only approximate. Some device types will ignore attempts to change the size. Use PAper 0 0 to reset to the default page size. Due to the way PGPLOT works, you may need to issue the CPD command to reinitialize the device to the correct default. 2 Plot Plot Cause the plot to be redrawn on the graphics device. Plot All Cause all data points, including those flagged as no-data, to be plotted. Plot Good Undo the effects of the "Plot All" command and prevent plotting of points flagged as no-data (default). Plot Vertical Plot up to 20 plot groups in separate panels, in a vertical stack. Plot Overlay Plot all groups in a single panel (default). Plot Zero ON Cause the plot groups that have color index zero to be plotted with the background color. This is sometimes useful for erasing plots. Plot Zero OFf Do not plot groups with color index zero (default). This is much faster than plotting with the background color. 3 Vertical Plot groups in separate windows in a vertical stack, with one plot group plotted in each window. For maximum compatibility with earlier versions of PLT, the windows are number with the group number. Thus group 3 is plotted in window 3. This allows commands like Rescale Y3 to rescale the window containing group 3. After you execute the Plot Vert command all the windows are treated as a single entity for both the `Rescale X' and `LAbel X' commands. Thus after a Plot Vert, using a Rescale X command will cause all visible windows to have the same X scale. Likewise, LAbel X will place the X label on the bottom window of the stack. This behavior will continue until you use the Window # command to select a given window, afterwhich the Rescale X and Label X commands will only affect the selected window. The WIndow All command can be used to restore the behavior where Rescale X affects all windows. The only way to restore the LAbel X behavior is to reissue the Plot Vert command. 2 PRompt PRompt $ Redefine the ``PLT>'' prompt. 2 Rescale Rescale X [#] [#] Reset XMIN and XMAX in the current window to the values specified. both XMIN and XMAX are omitted, then PLT will reset the range to the default. Rescale Y [#] [#] Reset YMIN and YMAX in the current window to the values specified. If both YMIN and YMAX are omitted, then PLT will reset the range to the default. Rescale [#] [#] [#] [#] Reset XMIN, XMAX, YMIN, and YMAX in the current window to the values specified. If all four numbers are omitted, then PLT will reset both the x- and y-ranges to the defaults. Rescale ? Display the current XMIN, XMAX, YMIN, and YMAX values for each window. Note: For Vertical plots each window can be specified separately; thus "R Y1" will rescale the y-range in window 1 and "R Y4" will rescale the y-range in window 4. 2 SCr SCr # # # # Immediately change the color representation for the specified color index. The first number is the color index and the following three numbers give the red, green, and blue color intensities and must lie in the range 0.0 to 1.0. This command only works on color devices for which the color representation can be changed. For color indices 0-15, the color representation you set will become the new default for as long as you stay in PLT. This means the HArdcopy command will show the colors you have set (if the device is capable). To restore the original default colors use set the Red color value to NO and then reissue the cpd command. Thus to restore the default color representation of color index 2 on your default /xs device, use: PLT> SCR 2 NO PLT> CPD /xs PLT> P Note, for PostScript files, color index 0 is *anyways* transparent and thus the color of the paper. I.e., there is no way to change the background color (other than loading different color paper in the printer) for PostScript files. If you want to change the background color, use the /PNG device. 3 Black/White/Default SCr [Black|White|Default] This allows PLT to override the default PGPLOT background color. In particular, /XS and /GIF devices produce white lines on a black background, whereas a PostScript hardcopy would be black lines on white paper. Thus PLT> SCr White will always force the background to be white. Note, SCr Black is not recommended as it would require white toner and black paper in order for it to work with PostScript devices. SCr Default restores the default behavior where PGPLOT picks the background color. 3 examples 
PLT> SCR 0 1. 1. 1.  ! Set the background color to be white
PLT> SCR 1 0 0 0     ! Plot color index 1 in black
PLT> SCR 2 0 1 0     ! Plot color index 2 in green
3 SEt Allows user to set various PLT internal variables. Currently you can only set the maximum length of lines written with the WData command. PLT> SEt LEngth 64 ! Don't write lines longer than 64 characters. 2 SHow Allows user to show the current values of various PLT internal variables. Currently you can only show the maximum length of lines written with the WData command. PLT> SHow LEngth 256 ! Maximum length of lines written with the WData command. 2 SKip Most PLT commands operate on `groups' of data points. The default is for each vector of the input data to be in a separate group. For the default mode, commands like "COlor" and "MArker" affect the appearance of an entire vector. Using the "SKip" command, it is possible to independently control the appearance of sub-sets of data within a single vector. Thus, when using "SKip", a single y vector can be divided into several plot groups that can be independently controlled with "COlor", "MArker", "R Y1", etc. Currently, "SKip" should only be used when the input data consists of two vectors as the other vectors will not be plotted. Note, "SKip" cannot affect whether a data point has an error associated with it. SKip OFf Each vector of the input data is plotted as a separate group (default). SKip Single A new plotting group begins every time x-coordinate equals "NO" (the no data flag) ONE or more consecutive times. "SKip Single" is useful when you wish to plot different groups with different markers. SKip Double A new plotting group begins every time x-coordinate equals "NO" (the no data flag) TWO or more consecutive times. "SKip Double" is useful when you wish to plot different groups using lines that contain breaks. 3 example Consider the QDP file: 
  1  2
  2  1
  NO NO
  3  4
  4  3
  NO NO
  NO NO
  5  6
  6  5
With the default "SKip Off", the above will be plotted as two groups each containing nine points. Using "SKip Single", would cause the above data to be divided into three groups. The first group would consist of the data in the first three lines, the second would come from lines four to seven, and the third group from lines eight and nine. Using "Skip Double" would cause the above data to be plotted as two groups with lines one through seven being in the first group and the last two lines making the second group. 2 STatistics STatistics [fgroup] where "[fgroup]" is the default group for fitting. This command causes a short table to be printed on your terminal that displays some basic statistical properties about that group of data. The first line tells you which group is fitted and over what range. Next the unweighted average, variance, and 3rd moment are displayed. For the unweighted data, the column labeled "SUMW" contains the total number of points used in the calculation, for weighted data, "SUMW" is the sum of the weights. "YMIN" and "YMAX" are the minimum and maximum data values in the range. If the plot group has errors associated with it, then weighted values of the average, variance, and 3rd moment will be displayed. The next row contains "WCHI" and "WRED" which are the chi^2 and reduced chi^2. The "W" is appended to remind you that the actual errors on the data were used. The line labeled "Sum of Y*XDEL" contains the sum of the y values times the Delta x values, where Delta x is given by the x-error bars. This is a rectangle rule integral of the data. The last line gives the (unweighted) linear correlation coefficient of the y vs. x data. For maximum accuracy, this routine makes two passes through the data, once to calculate the average, and the second time to calculate moments based on the difference between the data and the average. If you don't understand the difference between the unweighted and weighted values then you should use unweighted quantities. 3 example 
PLT> STat
Group  2, from   430.0    , to   540.0

        YBAR        YVAR        Y3M         SUMW       YMIN        YMAX
UNWTD  0.5915      0.1341     -8.3771E-03   23.00     2.2100E-02   1.096
  WTD  7.8728E-02  2.0009E-02  1.2435E-02  4.9056E+05
 WCHI=  9.389E+03,  WRED=  426.768

     Sum of Y*XDEL=   0.883411
Correlation coeff.=  -0.853596
2 THaw THaw [plist] Can only be used after a model has been defined. This command causes all parameters listed in "[plist]" to be thawed, which means the parameter value will be allowed to vary when fitting. 3 examples 
PLT> THaw 2         ! Cause parameter 2 to be thawed
PLT> THaw 3..5 9    ! Cause parameters 3 through 5 and 9 to be thawed
2 Time Time ON Cause the date and time to be plotted in the lower right corner (default). Time OFf Remove the date and time from future plots. 2 Uncertain Uncertain [# [# [#]]] Vary the specified parameter(s) in order to estimate their uncertainties. Each specified parameter, in turn, is stepped and chi^2 is minimized. Stepping stops when the requested value of Delta chi^2 is obtained. "Uncertain" can take up to 3 numbers as arguments. If one number contains a decimal point, then that number is interpreted as the requested value of Delta chi^2 (which for the first time defaults to 2.7 and for later times defaults to the previous value). The remaining two numbers in the "Uncertain" command specify the lower and upper parameter numbers for which you want to estimate the error. If only one number is given (without a decimal point), then the error is generated only for a single parameter. If errors are currently turned off (or do not exist), then the routine works out a correction factor that converts the W-VAR to chi^2. 2 UPper UPper # ON [glist] If a number in one of the groups specified in glist is less than # sigma from zero, then plot that number as a #-sigma upper limit. 3 example 
PLT> UPper 2.7 ON 3   ! When plotting group 3, all numbers within 2.7
PLT>                  ! sigma of zero will be plotted as an upper limit.
2 VErsion VErsion Return the date of last modification to the current version of PLT. 
2015-06-12 - Call FRELUN if WModel command fails.
2015-06-11 - 'Model insensitive to parameter' had gone away...
2014-02-04 - Fixed bug reading mal-formed model (.mod) files.
2012-11-05 - Ignore NO data values when plotting residuals.
2012-03-23 - Additional check when reading CMD array.
2011-04-20 - Internal bug fixes.
2011-01-14 - SCR B/W does not restart plot device.
2010-11-10 - Fix bug in SEt LEngth command.
2010-09-23 - Add the LY (Linear in Y) component.
2010-07-13 - Fix plotting bug when SKip ON reduces the number of groups.
2010-07-13 - Fix format for WHead with IMAge MIN less than zero.
2010-06-30 - If FPNUM finds an error, it now returns NO (was 0.0).
2010-06-03 - Fix another image related WH bug.
2010-06-01 - SCR (for indices 0-15) is remembered.
2010-05-28 - Several fixes to WH command.
2010-05-26 - Another XAX/SKIP bug fixed.
2010-05-20 - Fix 20 year old error in example fig04.pco.
2010-04-23 - CURFIT would randomly pick 0.001 as a stopping condition.
2010-03-29 - Xaxis # refers to vectors not groups (software and doc).
2010-03-25 - New SEt/SHow to change maximum length of lines written with WD.
2010-03-24 - Fix potential infinite loop in spline/akima components.
2009-07-02 - When FIT plots final model, it no lonver redraws the labels.
2009-03-10 - Increase MXLAB to 200.
2008-12-16 - Splines handle too many knots before asking user for all pars.
2008-03-17 - LAb # To now works correctly with log coordinates.
2007-09-17 - Increase MXLAB to 100.
2007-04-05 - Contour plots written with WE should now work.
2007-02-02 - Upper limits now plot correctly on LOG scale.
2007-01-08 - The sequence Fit/UN/Fit now works with splines.
2007-01-08 - MO @file/UNcer 2 is now illegal (and never worked correctly).
2006-08-31 - STat command works again.
2006-08-30 - Fit now works if x coordinate is decreasing.
2006-04-10 - Fit Plot -100 (negative number) should now work (again).
2005-09-22 - CURFIT now always writes out the "model insensitive to" error.
2005-08-24 - YAX LIN now affects groups not windows (like XAX LIN).
2005-08-15 - WM adds parameter numbers as comment, mo @ ignores comments.
2005-06-29 - Fix use of GETLUN/FRELUN when using WEnvir.
2004-07-22 - Add LAb # Pos x1 y1 To x2 y2 option.
2004-02-27 - Fix bug that caused "LAb 1 VPort Curs" to fail.
2004-02-24 - Fix bug that prevented same COD file from being used twice.
2004-02-04 - In cod functions, "ASLO" no longer matches "ASin".
2004-01-22 - Fix case where MA ? would be displayed in background color.
2003-07-21 - LIne Step now works if X-coordinate is decreasing.
2003-07-17 - Fix crashes when user uses an undefined group.
2003-04-15 - GRid ON now works with images.
2002-08-02 - Fix bug where PLT incorrectly decides no points are in fit range.
2002-04-02 - Model is now plotted for entire displayed range not fitted range.
2002-03-21 - Add CGau and NCGa built-in functions.
2002-03-19 - SCR [White|Default|Black] added to set default background color.
2002-03-18 - Cursor keys now work with xterms (change to cget.f).
2002-01-22 - STat and IMOdel commands now works with 2D groups.
2002-01-22 - Y range limit implemented for 2D fitting.
2002-01-22 - Fix calling of PLTSVW from PLTCUR routine.
2002-01-17 - Increase to MXPAR=120, MXFREE=100 (computers are faster).
2001-07-18 - "err sq y", "gap err", "r y" now correctly sets the scale.
2001-04-30 - rdqdp now ignores blank lines.
2001-04-23 - YPL # no longer "forgets" if # had been DG'ed to be a 2D group.
2001-04-23 - WH does a better job at writing DG commands.
2001-03-29 - Fix bug in COD a2tn function incorrectly testing for 0,0 case.
2000-10-06 - Fix LAB # ma 2 lin 90 .02 failing on some devices.
2000-10-04 - If using XAX LIN; ERR OFF; STAT, then sum Y*XDEL will be correct.
2000-08-23 - Initilize the fit group var before it is used...
2000-08-10 - Error [X,Y] Gehrels sets the error to 1+SQRT(0.75+N).
2000-08-08 - Error X Sq now works again.
2000-07-03 - bug fix, can now see fits to groups.GT.10.
2000-06-15 - "LIne # on" now works again.
2000-06-14 - If X value is NO then point is ignored in fitting, etc.
2000-02-18 - Fix contour bug that sometimes prevented contours from appearing.
2000-01-25 - DGroup #; XAX # now works correctly.
2000-01-13 - IMA CCT file, now searches same path as scripts.
1999-09-09 - Fix default plotting when using SKip ON, sigh.
1999-09-05 - Scale the CURFIT errors when using "ERR OFF/FIT STAT CHI".
1999-09-05 - Fix bug when using "ERR OFF/FIT STAT ML".
1999-09-05 - Initialize variable qhard to make g77 (and others) happy.
1999-05-20 - DGroup 4 Res; YPlt 4 now work for line plots.
1999-05-17 - Fix bug introduced by inline models.
1999-05-11 - Fix default plotting when using SKip OF.
1999-04-29 - Make inline model files more transparent.
1999-04-22 - Add optional call to hdecod to rdqdp.f.
1999-04-21 - Can include model parameters in QDP files by enclosing in quotes.
1999-04-16 - Add the MMaster commend.
1999-04-15 - WH now writes DGroup commands.
1999-04-14 - Fix bug when WH writes R X command.
1998-12-17 - Line Step now works (again) if no X error bars
1998-11-25 - Groups can now have independent LOG/LIN/SQRT image scaling.
1998-11-18 - DGroup [Model|Residuals] now working properly.
1998-10-06 - PLT no longer does an "Error OFf" if plotting > 2000 points.
1998-10-05 - Redid internal data structures for the X coordinate.
1998-10-01 - Fixed up Fit Stat ML (see HElp FIt statistics for details)
2 Viewport Viewport #,[#,[#,#]] Control location of the viewport in normalized device coordinates, where (0.0,0.0) is the bottom left corner and (1.0,1.0) the top right corner. The default viewport is 0.1 0.1 0.9 0.9, with the first two numbers giving the location of the bottom left corner and the next two numbers, the upper right corner. If you use "Viewport" with and only specify two numbers then PLT centers the viewport about the center of the plot, thus "View x,y" is the same as "View x,y,1.0-x,1.0-y". If you do not wish to center the viewport, then you can specify all four numbers, where the last two numbers refer to the top right corner. 3 examples 
PLT> View .4 .4        ! Viewport extends from (.4,.4) to (.6,.6)
PLT> View .8 .8 .9 .9  ! Use small viewport in top right corner
PLT> View .1 .1        ! Go back to the default viewport
2 WData WData [$] Write all data between the current x-scale minimum and maximum to a QDP file. If you want all the data to be written to the file then you should use the "R X" command to reset current scale to include the minimum and maximum data values. A blank file name will cause the data to be written to your current terminal screen. The "WData" command will not write any PLT commands to the file. However, it will include a reference to an indirect file. For example, "WData TEST" will create a file called "TEST.QDP" that includes the line "@TEST". The PLT command "WHead" can be used to create a "TEST.PCO" file that contains all the PLT commands needed to re-create the current plot. WData [$] # Write the data with only # digits of accuracy (numbers will be rounded). If # is negative, the error on a number is written out to (-#) number of digits and the number itself is written to the same accuracy. 3 examples 
PLT> WData          ! Write the data to the terminal screen
PLT> WData TEST     ! Write the data to TEST.QDP
PLT> WData TEST 3   ! Write the data (3 significant digits) to TEST.QDP
PLT> WData TEST -2  ! E.g., 123.758 +/- 2.698 will be written 123.8 2.7
PLT> WData,,-2      ! As above, but written to the terminal screen.
2 WEnviron WEnviron [$] This command does the same thing as if you entered a "WHead" command followed by a "WData" command. This command should be used if you want to save both the current data and the PLT commands needed to re-create the current plot. 3 examples 
PLT> WEnvir         ! Write commands and data to the terminal screen
PLT> WEnvir TEST    ! Create TEST.PCO and TEST.QDP files
PLT> WEnvir TEST 3  ! Write the data (3 significant digits) to TEST.QDP
PLT> WEnvir TEST -2 ! E.g., 123.758 +/- 2.698 will be written 123.8 2.7
PLT> WEnvir,,-2     ! As above, but written to the terminal screen.
2 WHead WHead [$] This command only writes the list of PLT commands needed to create the current figure. Since this command will NOT write any data, it will run faster than the "WEnviron" command. Typically one would first use "WEnviron" to write both the PLT commands and the data to files. If any changes are made to the appearance of the plot (such as adding labels, etc.) then the "WHead" command can be used to update the PLT command file without over-writing the QDP file containing the data. 3 examples 
PLT> WHead          ! Write commands to the terminal screen
PLT> WHead TEST     ! Write commands to TEST.PCO
PLT> WHead TEST 3   ! Same as previous (the 3 is ignored)
2 WIndow WIndow # This command sets the currently active window to be the number specified by #. After the window command has been issued, commands like "Rescale X", "LA Y" will affect the currently active window. For maximum compatibility, a "Plot Vertical" command creates N windows numbered by the number of the plot group that they contain. Thus if group 1 is used on the x-axis, then the upper (first) window plotted will contain plot group 2 and will be plotted in window 2. To return PLT to the default mode where commands affect all windows, use the "WIndow All" command. 2 WModel WModel [$] Write the current model into the named file. The model written out can later be read with the "MOdel @filename" command. If you do not enter a file name, the model will be written to your terminal screen. Since all significant digits are written, writing a file provides a good way to save your current "MOdel" parameters. If you have previously "Fit" the data then this command will write two additional lines at the end of the model file as comments. These lines contain the WVAR and NBIN determined in the most recent fit. 2 Xaxis Xaxis # The X-axis can be any column containing coordinates (not errors) in the original data. Errors are considered to be attached to the coordinate and a coordinate with any errors is called a vector. Thus "Xaxis 3" will use the 3rd vector to define the X-axis. Note, different plot windows can have different defining X coordinates. Xaxis Linear # # Cause the x variable to be a linear function. Thus, the command "Xaxis Linear 10. 1" would cause the first point to be plotted at x=10, the second point at x=11, the third at x=12, etc. 2 YAxis Yaxis Lin # # Specify the y-axis coordinate to be used in the current plot window. This is only useful when plotting 2D data. 3 example Assume you have a 10 by 10 array of data, then the commands then 
PLT> Xax L 10 1  ! Would cause the X values to range from 10 to 19
PLT> Yax L 5 1   ! Would cause the Y values to range from 5 to 14
PLT> CON Lev 1,2,3 ! Draws a contour plot with these scales
2 Yplot Yplot [ON|OFf] [glist] where "[glist]" is a list of plot groups. This command is more intuitive to naive users than the "COlor ON|OFf" command. This command causes the plot groups specified in "[glist]" to turned on (plotted) in the currently active window. 2 $ $ [command] Spawn to the operating system, where "[command]" is an operating system command. If no command is specified, then a system shell is created that will allow you to enter several commands until you logout (under VMS) or exit (under UNIX or DOS). 3 examples 
PLT> $       ! Spawn to system
Spawning...  ! Wait for something to happen
$ # enter UNIX commands
$ exit
PLT>         ! You have now returned to PLT
PLT> $ ls    ! This will display your current directory
Spawning...  ! Wait for something to happen
(directory appears here)
PLT>         ! and you are left in PLT.
2 @
@ $
Execute commands from an indirect command file. Command files can be nested to a depth of 10. The default file type is ".PCO" (for Plt COmmands). 3 example PLT> @nice ! Execute the PLT commands in the file nice.pco 2 fortran PLT is a Fortran program with the following calling sequence: 
      SUBROUTINE PLT(Y, IERY, MXROW, NPTS, NVEC, CMD, NCMD, IER)
      REAL      Y(*)
      INTEGER   IERY(*), MXROW, NPTS, NVEC, NCMD, IER
      CHARACTER CMD(*)*(*)
C---
C General plot subroutine.
C---
C Y(*)      I    The data array.  The array should be dimensioned
C                Y(MXROW,MXCOL) where MXROW and MXCOL are the actual
C                sizes of the arrays in the calling program.
C                MXCOL=NVEC+NSERR+2*NTERR  where NSERR is the number
C                of vectors that have symmetric errors and NTERR
C                is the number of vectors that have two-sided errors.
C IERY(*)   I    =-1 plot errors as SQRT(Y)
C                = 0 no errors.
C                =+1 explicit symmetric errors.
C                =+2 for two-sided errors
C MXROW     I    The actual first dimension of the Y array.
C NPTS      I    The number of points to plot (NPTS<=MXROW).
C NVEC      I    The number of vectors to be plotted.
C CMD(*)    I    Array of commands.
C NCMD      I    Number of commands.
C IER         O  Error flag, =-1 if user entered EOF, =0 otherwise.
2 history The QDP/PLT program has evolved over a long period. In the late 1970's Andy Szymkowiak wrote a QDP (Quick and Dirty Plotter) program for the PDP 11/70 used by the X-ray group at Goddard Space Flight Center. This original QDP would read an ASCII file and produce a plot on a Vector General device. It was then possible for the user to issue commands interactively that would affect the appearance of the plot. When the user achieved the desired plot, it was a simple matter to produce a `hardcopy' of the plot on a Versatec printer/ plotter. I, Allyn Tennant, quickly adopted QDP and started to add some new features to it. In 1983 I moved from Goddard to Cambridge, England to join Andy Fabian's group, and took along the idea of QDP program. Rather than port the existing code, it was decided it would be best to start over and to rewrite the code with the following goals: 1) The plotting routine would be isolated from all other activities such as reading data from disk. A separate routine was provided to read ASCII (QDP) files. 2) All of the author's scientific graphics would be done with PLT. Thus when a new function was needed it would be added to PLT. This would be done in such a way that existing software would not need to be modified to use the new function. 3) The interface to the low level graphics routines would be minimized. Thus all high level functions would be written in Fortran and hence be portable to new systems. This goal was met by using the PGPLOT graphics package. Over the years, the goal of always using PLT to produce line graphics has resulted in the slow accretion of functionality, so that now the QDP name has been changed to stand for the Quick and Dandy Plotter. PGPLOT has now been ported to several systems and, in addition, there is a version of PGPLOT that works with GKS. The appearance of MONGO on Starlink in 1984 influenced the evolution of PLT. Up to that time, the only way to change the defaults was for the user to type in a command. When MONGO appeared, it was realized that the calling program could also issue some commands to PLT. At this time, the calling sequence to PLT was updated to allow a command list to passed to it. PLT can now be completely controlled through this command list: It will never again be necessary to change the calling sequence. The development of PLT at Cambridge was influenced by the interaction with Rick Shafer and his XSPEC program. Rick and I would often compete to design the `most user friendly interface'. This resulted in the free exchange of ideas between XSPEC and PLT; as a result, these programs now have similar (but not identical) user interfaces. One of the strengths of QDP has always been its ability to FIT the data. With the original Goddard version, it was possible to fit either a constant or a line through the data. At Cambridge, PLT was enhanced to allow fitting of any linear combination of `components'. The list of components slowly grew to include many functions such as sine, exponential, log, and two types of spline. In order to keep the specialized components from becoming part of the standard PLT/FIT program, a user model was created. This allows users to link a program using PLT/FIT that contains a single specialized component. This component could then be added to components from the existing list of built-in functions to construct an advanced model. While workable, this method entailed making people link `private' versions of standard programs. In late 1987, development started on a new way to define a model component, that would entail reading a `program' stored in an ASCII disk file. Clearly the program would be an interpreted language and, for maximum speed and efficiency, this language would need to be stack oriented. Hence, COD (COmponent Definition) files were created. Although COD is now an integral part of QDP/PLT/FIT, the programming language itself is still evolving. In 1988, Allyn Tennant moved from Cambridge to the Marshall Space Flight Center in Huntsville. All questions, complaints, requests, etc., should now be directed to Huntsville. In early 1989 the first edition of the User's Guide was produced for distribution by the EXOSAT group at ESTEC. I'm grateful to Nick White for his encouragement of this effort and to Steve O'Dell who greatly assisted in producing the original LaTeX version of the manual. Finally, many people have contributed ideas for additional features and many of these have been included. You are still encouraged to suggest enhancements (yes, you are even encouraged to point out minor bugs). 2 QDP_commands QDP commands must be inserted at the beginning of a QDP file, as these commands tell QDP how to read in the data. Any command not recognized by QDP is passed to PLT. QDP separates command lines from data lines based on the first non-blank character in the line. If this character is + - . or a digit then the entire line will be read as data. 3 READ 4 Serr READ Serr [vlist] Tell QDP/PLT which vectors have symmetric errors. The command "READ Serr 1 3 5" will cause vectors 1, 3, and 5 to be read with symmetric errors and vectors 2 and 4 to be read without. Only one "READ Serr" command should appear in a QDP file Example: 
READ Serr 1 3 5
 1. .1     2.    3. .3    4.   5. .5
would be read as 5 vectors; 1. +/- .1; 2. (no error); 3. +/- .3; 4.(no error); 5. +/- .5. Without the "READ Serr" command, the above would be read as 8 vectors. 4 Terr READ Terr [vlist] Tell QDP/PLT which vectors have two-sided errors. It takes three columns to specify a vector with two-sided errors. The first column is the central value, the second column, which must be positive, specifies the upper bound, and the third column, which must be negative or zero, specifies the lower bound. Example: 
READ Serr 1
READ Terr 2
 1. .1    2. +.1 -2.
would be read as 1. +/-.1; 2 +.1,-2. Note: In fitting, non-positive errors are ignored and so, the first error, of two-sided errors, should be positive. fv5.5/tcltk/plt/pltcct.f0000644000220700000360000001145613224715127014110 0ustar birbylhea SUBROUTINE PLTCCT(Ctable, Ltable) CHARACTER Ctable*(*) INTEGER Ltable C--- C Change Color Table. C From PGPLOT manual I = 0.30*R + 0.59*G + 0.11*B C--- C Ctable I C Ltable I C--- INTEGER MXCOL PARAMETER (MXCOL=256) REAL FPNUM INTEGER LENACT C CHARACTER cbuf*256, cnam*256, ctmp*256 REAL bint(MXCOL), gint(MXCOL), rint(MXCOL), rnci(MXCOL) REAL bint1(2), gint1(2), rint1(2), rnci1(2) REAL bint2(4), gint2(4), rint2(4), rnci2(4) REAL bint3(7), gint3(7), rint3(7), rnci3(7) REAL tmp INTEGER i, ier, invert, ios, is, itab INTEGER kp, lbuf, ltmp, lun, ncol C C Gray scale DATA rint1/0., 1./ DATA gint1/0., 1./ DATA bint1/0., 1./ DATA rnci1/0., 1./ C C Original Cambridge LUT DATA rint2/0., 0., 1., 1./ DATA gint2/0., 1., 0., 1./ DATA bint2/1., 0., 0., 1./ DATA rnci2/0., .3333333, .6666666, 1.0/ C C Color spectrum LUT DATA rint3/0., .30, .20, .05, .70, .90, 1./ DATA gint3/0., .00, .20, .60, .70, .13, 1./ DATA bint3/0., .30, .95, .05, .05, .13, 1./ DATA rnci3/0., .167, .333, .500, .667, .833, 1./ C 11 FORMAT(A) C C Check to see if color table should be inverted. IF ( Ctable(1:1).EQ.'-' ) THEN is = 2 invert = 1 ELSE is = 1 invert = 0 END IF C ncol = 0 itab = NINT(FPNUM(Ctable(is:),Ltable-is+1,ier)) IF ( ier.EQ.0 ) THEN IF ( itab.EQ.1 ) THEN ncol = 2 DO i=1,ncol rnci(i) = rnci1(i) rint(i) = rint1(i) gint(i) = gint1(i) bint(i) = bint1(i) END DO ELSE IF ( itab.EQ.2 ) THEN ncol = 4 DO i=1,ncol rnci(i) = rnci2(i) rint(i) = rint2(i) gint(i) = gint2(i) bint(i) = bint2(i) END DO ELSE IF ( itab.EQ.3 ) THEN ncol = 7 DO i=1,ncol rnci(i) = rnci3(i) rint(i) = rint3(i) gint(i) = gint3(i) bint(i) = bint3(i) END DO END IF ELSE CALL GETLUN(lun) cnam = Ctable(is:) CALL XTEND(cnam, 'ct') CALL OPENWR(lun,cnam,'OLD',' ',' ',0,1,ier) IF ( ier.NE.0 ) THEN C Search user defined directory (if it exists) CALL TRLOG('MY_XCOMS',8,ctmp,ltmp) IF ( ltmp.GT.0 ) THEN ctmp(ltmp+1:) = cnam CALL OPENWR(lun,ctmp,'OLD',' ',' ',0,1,ier) END IF IF ( ier.NE.0 ) THEN C Search system directory ctmp = cnam CALL PTEND('$XANADU','xanlib/xcoms',ctmp) CALL OPENWR(lun,ctmp,'OLD',' ',' ',0,1,ier) IF ( ier.NE.0 ) THEN ltmp = LENACT(ctmp) WRITE(*,*) 'Unable to open file=',ctmp(:ltmp) GOTO 340 END IF END IF END IF 310 CONTINUE READ(lun,11,IOSTAT=ios) cbuf IF ( ios.NE.0 ) GOTO 340 lbuf = LENACT(cbuf) C Ignore blank lines, or comment linew IF ( lbuf.LE.0 .OR. cbuf(1:1).EQ.'!' ) GOTO 310 ncol = ncol + 1 kp = 0 CALL ALF(cbuf, lbuf, kp, ctmp, ltmp) rnci(ncol) = FPNUM(ctmp, ltmp, ier) CALL ALF(cbuf, lbuf, kp, ctmp, ltmp) rint(ncol) = FPNUM(ctmp, ltmp, ier) CALL ALF(cbuf, lbuf, kp, ctmp, ltmp) gint(ncol) = FPNUM(ctmp, ltmp, ier) CALL ALF(cbuf, lbuf, kp, ctmp, ltmp) bint(ncol) = FPNUM(ctmp, ltmp, ier) IF ( ncol.LT.MXCOL ) GOTO 310 340 CONTINUE C WRITE(*,*) 'Read',ncol,' colors.' CLOSE(UNIT=lun) CALL FRELUN(lun) END IF C IF ( ncol.NE.0 ) THEN C Got a valid color table, invert it if needed. IF ( invert.NE.0 ) THEN DO i=1,ncol/2 tmp = rnci(i) rnci(i) = 1.0 - rnci(ncol+1-i) rnci(ncol+1-i) = 1.0 - tmp tmp = rint(i) rint(i) = rint(ncol+1-i) rint(ncol+1-i) = tmp tmp = gint(i) gint(i) = gint(ncol+1-i) gint(ncol+1-i) = tmp tmp = bint(i) bint(i) = bint(ncol+1-i) bint(ncol+1-i) = tmp END DO END IF C Load table. CALL PGCTAB(rnci,rint,gint,bint,ncol,1.0,0.5) ELSE C User gave an invalid color table, give him some help. WRITE(*,*) 'Builtin color tables are:' WRITE(*,*) ' 1 - Grayscale' WRITE(*,*) ' 2 - Black, Blue, Green, Red, White' WRITE(*,*) ' 3 - Black, Magenta, Blue, Yellow, Green, '// & 'Orange, Red, White' END IF RETURN END fv5.5/tcltk/plt/pltcur.f0000644000220700000360000000244513224715127014126 0ustar birbylhea SUBROUTINE PLTCUR(WINLOC, BOXVP, XYSCAL, MXWIN, LOGX, LOGY, : IACTW, Iwadj, IWNUM, VX, VY, WX, WY, CHR) INTEGER MXWIN, LOGX(*), LOGY(*), IACTW(*), Iwadj(*) INTEGER IWNUM REAL BOXVP(4,*), WINLOC(4,*), XYSCAL(4,*) REAL VX, VY, WX, WY CHARACTER CHR C--- C Wrapup for PGCURSE. C--- C IWNUM O The window containing the cursor position. C VX,VY O The cursor position in NDC. C WX,WY O The cursor position in window coordinates for IWNUM. C--- INTEGER I C--- CALL PLTSVW(BOXVP, WINLOC, XYSCAL, LOGX, LOGY, Iwadj, 0) CALL PGCURSE( VX, VY, CHR) DO 120 I=1,MXWIN IF(IACTW(I).GT.0) THEN IF(WINLOC(1,I).LE.VX .AND. VX.LE.WINLOC(3,I) .AND. : WINLOC(2,I).LE.VY .AND. VY.LE.WINLOC(4,I)) THEN IWNUM=I GOTO 130 END IF END IF 120 CONTINUE WX=VX WY=VY RETURN C--- C The window has been identified, so convert to window coordinates. 130 CONTINUE CALL PLTSVW(BOXVP, WINLOC, XYSCAL, LOGX, LOGY, Iwadj, IWNUM) CALL PLTVTW(VX, VY, WX, WY) IF(LOGX(IWNUM).NE.0 .AND. WX.LT.32.) THEN WX=10.**WX END IF IF(LOGY(IWNUM).NE.0 .AND. WY.LT.32.) THEN WY=10.**WY END IF RETURN END fv5.5/tcltk/plt/plthis.f0000644000220700000360000000050313224715127014111 0ustar birbylhea SUBROUTINE PLTHIS(A,IDIM,JDIM,I1,I2,J1,J2,BLACK,WHITE) INTEGER IDIM, JDIM, I1, I2, J1, J2 REAL A(IDIM,JDIM) REAL BLACK, WHITE C--- C Dummy routine, waiting for PGPLOT to add needed routines. C----------------------------------------------------------------------- RETURN END fv5.5/tcltk/plt/pltlab.f0000644000220700000360000000701013224715127014064 0ustar birbylhea SUBROUTINE PLTLAB(LUN, ICLAB, CLAB, FLAB, ILAB) INTEGER LUN, ICLAB CHARACTER CLAB(*)*(*) REAL FLAB(7,*) INTEGER ILAB(7,*) C--- C PLT support routine to write out commands of the form LA # 'test' C--- C LUN I C ICLAB I C CLAB I C FLAB I C ILAB I C--- C 1990-Mar-01 - New routine [AFT] C--- INTEGER LENACT C CHARACTER CBUF*132 CHARACTER CHPOS(3)*3, CVPOS(5)*3 INTEGER ISAV, LBUF, LTMP DATA CHPOS/'Lef','Cen','Rig'/ DATA CVPOS/'Top','Cap','Hal','Bas','Bot'/ C--- 11 FORMAT(A) C--- IF(ILAB(1,ICLAB).NE.0) THEN CBUF = 'LAB ' LBUF = 5 CALL CRAMI(ICLAB,CBUF,LBUF) LBUF = LBUF+1 ISAV = LBUF IF(ILAB(4,ICLAB).NE.1) THEN CBUF(LBUF+1:LBUF+3) = 'COL' LBUF = LBUF+4 CALL CRAMI(ILAB(4,ICLAB), CBUF, LBUF) LBUF = LBUF+1 END IF IF(FLAB(4,ICLAB).NE.1.0) THEN CBUF(LBUF+1:LBUF+2) = 'CS' LBUF = LBUF+3 CALL CRAMF(FLAB(4,ICLAB), CBUF, LBUF) LBUF = LBUF+1 END IF IF( Ilab(7,iclab).GT.0 ) THEN CBUF(LBUF+1:LBUF+2) = 'TO' LBUF = LBUF+3 CALL CRAMF(FLAB(5,ICLAB), CBUF, LBUF) LBUF = LBUF+1 CALL CRAMF(FLAB(6,ICLAB), CBUF, LBUF) LBUF = LBUF+1 ELSE IF(FLAB(6,ICLAB).GT.0.0) THEN CBUF(LBUF+1:LBUF+3) = 'LIN' LBUF = LBUF+4 CALL CRAMF(FLAB(5,ICLAB), CBUF, LBUF) LBUF = LBUF+1 IF ( ABS(FLAB(6,ICLAB)-0.08).GT.0.00001 ) THEN CALL CRAMF(FLAB(6,ICLAB), CBUF, LBUF) LBUF = LBUF+1 END IF END IF IF(ILAB(5,ICLAB).NE.1) THEN CBUF(LBUF+1:LBUF+2) = 'LS' LBUF = LBUF+3 CALL CRAMI(ILAB(5,ICLAB), CBUF, LBUF) LBUF = LBUF+1 END IF IF(ILAB(6,ICLAB).GE.0) THEN CBUF(LBUF+1:LBUF+3) = 'MAR' LBUF = LBUF+4 CALL CRAMI(ILAB(6,ICLAB), CBUF, LBUF) LBUF = LBUF+1 IF(FLAB(7,ICLAB).NE.1.0) THEN CBUF(LBUF+1:LBUF+4) = 'MSIZ' LBUF = LBUF+5 CALL CRAMF(FLAB(7,ICLAB), CBUF, LBUF) LBUF = LBUF+1 END IF END IF IF(FLAB(3,ICLAB).NE.0.) THEN CBUF(LBUF+1:LBUF+3) = 'ROT' LBUF = LBUF+4 CALL CRAMF(FLAB(3,ICLAB), CBUF, LBUF) LBUF = LBUF+1 END IF C--- C Add Center and Justification to end of string, so Line and Mark C will not over-ride these settings. IF(ILAB(3,ICLAB).NE.3) THEN CBUF(LBUF+1:LBUF+7) = 'CEN '//CVPOS(ILAB(3,ICLAB)) LBUF = LBUF+8 END IF IF(ILAB(2,ICLAB).NE.2) THEN CBUF(LBUF+1:LBUF+7) = 'JUS '//CHPOS(ILAB(2,ICLAB)) LBUF = LBUF+8 END IF IF(LBUF.GT.ISAV) WRITE(LUN,11) CBUF(:LBUF-1) C--- C Always write a line of the form, LAB # POS # # "label" CBUF = 'LAB ' LBUF = 5 CALL CRAMI(ICLAB,CBUF,LBUF) LBUF = LBUF+1 IF(ILAB(1,ICLAB).LT.0) THEN CBUF(LBUF+1:LBUF+3) = 'VIE' ELSE CBUF(LBUF+1:LBUF+3) = 'POS' END IF LBUF = LBUF+4 CALL CRAMF(FLAB(1,ICLAB), CBUF, LBUF) LBUF = LBUF+1 CALL CRAMF(FLAB(2,ICLAB), CBUF, LBUF) LTMP = MAX(LENACT(CLAB(ICLAB)), 1) WRITE(LUN,161) CBUF(:LBUF),CLAB(ICLAB)(:LTMP) 161 FORMAT(A,' "',A,'"') END IF RETURN END fv5.5/tcltk/plt/pltskp.f0000644000220700000360000000544713224715127014137 0ustar birbylhea SUBROUTINE PLTSKP(Y, Iery, Mxrow, Npts, Nvec, Mxgrp, & Iskip, Ixvec, Ngroup, Igrpos, Ipyer, Ipwin) INTEGER Iery(*), Mxrow, Npts, Nvec, Mxgrp, Iskip INTEGER Ixvec, Igrpos(3,*), Ipyer(*), Ipwin(*), Ngroup REAL Y(*) C--- C Initialize the Igrpos array when using SKIP. C--- C Y I Main data array C Iery I C Mxrow I C Npts I C Nvec I C Mxgrp I C Iskip I C Ixvec I C Ngroup I/O Total number of PLT groups C Igrpos(1,*) O The y-coordinate offset C Igrpos(2,*) O Number of points in current group C Igrpos(3,*) O Original vector number for the Y data C Ipyer O C Ipwin O C--- C 1990-Feb-28 - Extracted from PLT - [AFT] C--- REAL NO PARAMETER (NO=-1.2E-34) INTEGER IOFSET C--- REAL tmp INTEGER i, icnt, igrp, ioff, itmp, ivec, ixoff, iytmp INTEGER lasgrp, nno C--- C Mark any previously defined groups as undefined. DO igrp=1,Ngroup igrpos(1,igrp) = -1 IF ( Ipwin(igrp).GT.0 ) THEN Ipwin(igrp)=-ABS(Ipwin(igrp)) END IF END DO C ixoff= IOFSET(Ixvec, Iery, Nvec, Mxrow) ioff = IOFSET( 1, Iery, Nvec, Mxrow) nno = Iskip icnt = Iskip lasgrp= 1 Ngroup= 0 DO i=1,Npts icnt=icnt+1 tmp = Y(ixoff+i) IF ( tmp.EQ.NO ) THEN nno=nno+1 ELSE IF ( nno.GE.Iskip ) THEN C Load number of points for previous set of groups. Don't include the C ending NO data flags counted Iskip times in the count. DO igrp=lasgrp,Ngroup Igrpos(2,igrp)=icnt-nno-1 END DO lasgrp = Ngroup+1 icnt = 1 iytmp = ioff+I-1 DO ivec=1,Nvec IF ( ivec.NE.Ixvec ) THEN Ngroup = MIN(Ngroup+1,Mxgrp) CALL PLTXCN(Ngroup, 1, 0) itmp = iofset(ixvec, Iery, ixvec, Mxrow)+i-1 CALL PLTXCG(Ngroup,1,ixvec,itmp,iery) Igrpos(1,Ngroup) = iytmp Igrpos(3,Ngroup) = ivec Ipyer(Ngroup) = MIN(Iery(ivec), 1) END IF iytmp = iytmp+Mxrow IF(Iery(ivec).GT.0) iytmp = iytmp+Iery(ivec)*Mxrow END DO END IF nno = 0 END IF END DO C--- DO igrp=lasgrp,Ngroup Igrpos(2,igrp) = icnt-nno END DO C--- C Make sure any newly defined groups are assigned plot windows. DO igrp=1,Ngroup IF ( Igrpos(1,igrp).GE.0 ) THEN IF ( Ipwin(igrp).LT.0 ) THEN Ipwin(igrp)=ABS(Ipwin(igrp)) ELSE Ipwin(igrp)=1 END IF END IF END DO C RETURN END fv5.5/tcltk/plt/pltsub.f0000644000220700000360000000411713224715127014124 0ustar birbylheaC--- PLTSUB.FOR Contains high level routines called by PLT. C IOFSET C PLTGAP C--- INTEGER FUNCTION IOFSET(Ivec, Iery, Ngroup, Mxrow) INTEGER Ivec, Iery(*), Ngroup, Mxrow C--- C Compute offset into the Y data array C--- C Ivec I C Iery I C Ngroup I C Mxrow I C--- C AFT C--- INTEGER i, ix, loc C--- ix=MIN(MAX(1,Ivec),Ngroup) loc=0 DO i=1,Ngroup IF ( i.EQ.ix ) THEN IOFSET=loc RETURN END IF loc=loc+mxrow IF ( Iery(i).GT.0 ) loc=loc+Mxrow*Iery(i) END DO WRITE(*,*) 'ERROR--IOFSET, Unable to find vector',Ivec IOFSET = 0 RETURN END C********* SUBROUTINE PLTGAP(Rmini, Rmaxi, Space, Log, Rmino, Rmaxo) REAL Rmini, Rmaxi, Space, Rmino, Rmaxo INTEGER Log C--- C PLT subroutine to add in the user selected whitespace to the C data min/max for the plot boundaries C--- C Rmini I Min C Rmaxi I Max C Space I Size of the whiteSpace C Log I Flag, If not zero, then the spacing is Log C Rmino O Min C Rmaxo O Max C--- C 8-Oct-1988 - rashafer C--- REAL tmpmin, tmpmax, delta C IF (Space.EQ.0) THEN Rmino = Rmini Rmaxo = Rmaxi RETURN END IF tmpmin = Rmini tmpmax = Rmaxi IF ( (Log.NE.0).AND.(tmpmin.GT.0.).AND.(tmpmax.GT.0.) ) THEN C** Its log spacing to be done delta = tmpmax / tmpmin IF ( delta .LE. 1.) THEN C** they're degenerate, so just allow a single decade delta = 3.4 ELSE delta = MAX( delta ** ABS(Space), SQRT(10.5/delta) ) END IF Rmino = tmpmin / delta Rmaxo = tmpmax * delta ELSE C** linear spacing delta = tmpmax - tmpmin IF ( delta .LE. 0.) THEN IF (tmpmin .EQ. 0.) THEN delta = 0.5 ELSE delta = Space*ABS(tmpmin) END IF ELSE delta = delta*Space END IF Rmino = tmpmin - delta Rmaxo = tmpmax + delta END IF RETURN END fv5.5/tcltk/plt/pltxc.f0000644000220700000360000001553713224715127013755 0ustar birbylhea SUBROUTINE PLTXCC(Yray, Ipos, Igrp, Xc, Ndim, Iyoff) REAL Yray(*), Xc(*) INTEGER Ipos, Igrp, Ndim, Iyoff C Entry PLTXCD INTEGER Iold, Inew C Entry PLTXCE REAL Xm, Xp C Entry PLTXCG INTEGER Idim, Ixveci, Ixoff, Iery(*) C Entry PLTXCI INTEGER Mxrowi C Entry PLTXCL REAL Offi, Slopi C Entry PLTXCN INTEGER Ndimi, Npci C Entry PLTXCO REAL Xoffi C Entry PLTXCP INTEGER Ipxei C--- C The X-coordinate "object". This subroutine stores all the internal C data needed to compute the x-coordinate of data point Ipos in plot C group with Igrp. To allow for 2D (or higher), Xc is an array, C with Xc(1) the traditional X position, Xc(2) Y, etc. as needed. C--- C Yray I The master data array C Igrp I The plot group to compute the Xc array for C Ipos I The index into the plt group C Xc O The X coordinates C--- C 2000-08-10 - all the pltxcp entry - [AFT] C 1998-10-05 - created from FNX - AFT C--- REAL NO PARAMETER (NO=-1.2E-34) INTEGER MXDIM, MXGRP PARAMETER (MXDIM=2, MXGRP=500) C REAL slop(MXDIM, MXGRP), off(MXDIM, MXGRP) SAVE slop, off REAL slop0(MXDIM, MXGRP), off0(MXDIM, MXGRP) SAVE slop0, off0 REAL xoff(MXDIM, MXGRP) SAVE xoff INTEGER ierx(MXDIM, MXGRP), ipxer(MXDIM, MXGRP) SAVE ierx, ipxer INTEGER ixbeg(MXDIM, MXGRP), ixvec(MXDIM, MXGRP) SAVE ixbeg, ixvec INTEGER ndims(MXGRP), new(MXDIM, MXGRP), npc(MXGRP) SAVE ndims, new, npc INTEGER mxrow SAVE mxrow INTEGER icolm1, id, ig, irow C--- Ndim = Ndims(Igrp) IF ( Ndims(Igrp).GT.1 ) THEN C icolm1 is the column number minus 1 icolm1 = (Ipos - 1)/npc(Igrp) irow = Ipos - icolm1*npc(Igrp) Xc(2)=off(2,Igrp)+icolm1*slop(2,Igrp)+xoff(2,Igrp) iyoff = irow + mxrow*icolm1 ELSE Xc(2) = 0.0 irow = Ipos Iyoff = irow END IF IF ( ixbeg(1,Igrp).LT.0 ) THEN Xc(1)=off(1,Igrp)+(irow-1)*slop(1,Igrp)+xoff(1,Igrp) ELSE Xc(1)=Yray(ixbeg(1,Igrp)+irow)+xoff(1,Igrp) END IF RETURN C*** ENTRY PLTXCD(Iold, Inew) C Duplicate the X coordinate of an existing group DO id=1,MXDIM slop(id, Inew) = slop(id, Iold) off(id, Inew) = off(id, Iold) xoff(id, Inew) = xoff(id, Iold) ierx(id, Inew) = ierx(id, Iold) ipxer(id, Inew) = ipxer(id, Iold) ixbeg(id, Inew) = ixbeg(id, Iold) new(id, Inew) = new(id, Iold) END DO ndims(Inew) = ndims(Iold) npc(Inew) = npc(Iold) RETURN C*** ENTRY PLTXCE(Yray, Ipos, Igrp, Idim, Xm, Xp) C Return the X error IF ( ipxer(Idim,Igrp).EQ.-2 ) THEN Xp = 1+SQRT(0.75+ABS(Yray(ixbeg(Idim,Igrp)+Ipos))) Xm = -Xp ELSE IF ( ipxer(Idim,Igrp).EQ.-1 ) THEN Xp = SQRT(ABS(Yray(ixbeg(Idim,Igrp)+Ipos))) Xm = -Xp ELSE IF ( ipxer(Idim,Igrp).EQ.0 ) THEN Xp = 0.0 Xm = 0.0 ELSE IF ( ixbeg(Idim,Igrp).LT.0 ) THEN C XAx LIN is easy Xp = ABS(slop(Idim,Igrp))/2. Xm = -Xp ELSE C This uses XAx # C%%% fails for 2d arrays, i.e., YAx # IF ( Ierx(idim, Igrp).EQ.1 ) THEN Xp = Yray(Mxrow+ixbeg(Idim,Igrp)+Ipos) Xm = -Xp ELSE IF ( Ierx(idim, Igrp).EQ.2 ) THEN Xp = Yray( Mxrow+ixbeg(Idim,Igrp)+Ipos) Xm = Yray(2*Mxrow+ixbeg(Idim,Igrp)+Ipos) ELSE Xp = 0.0 Xm = 0.0 END IF END IF END IF RETURN C*** ENTRY PLTXCG(Igrp, Idim, Ixveci, Ixoff, Iery) C Implement XAX # . The first X coordinate is at Yray(Ixbeg+1). C--- C Trap coding errors.... IF ( Ixveci.LE.0 ) THEN WRITE(*,*) 'PLTXCG--ixveci=',ixveci STOP END IF IF ( Idim.GT.MXDIM ) THEN WRITE(*,*) 'PLTXCG--Idim,MXDIM=',Idim,MXDIM STOP END IF IF ( Igrp.GT.MXGRP ) THEN WRITE(*,*) 'PLTXCG--Igrp,MXGRP=',ixveci,MXGRP STOP END IF C ixvec(Idim, Igrp) = Ixveci ierx(Idim, Igrp) = Iery(Ixveci) ipxer(Idim, Igrp) = 1 xoff(Idim, Igrp) = 0. ixbeg(Idim, Igrp) = Ixoff RETURN C*** ENTRY PLTXCI(Mxrowi) C Initialize the "new" array. This allows pltxc to remember the first C XAX LIN numbers, hence the user does not need to remember this. Why? C Because, the first XAX LIN is often defined in the *.qdp, *.pco, or C otherwise in the calling program. mxrow = Mxrowi DO ig=1, MXGRP DO id=1,MXDIM new(id, ig) = 1 C Default XAX LIN 1 1 ixbeg(id, ig) = -1 off(id, ig) = 1.0 slop(id, ig) = 1.0 off0(id, ig) = 1.0 slop0(id, ig) = 1.0 C No "extra" offset xoff(id, ig) = 0.0 END DO END DO RETURN C*** ENTRY PLTXCL(Igrp, Idim, Offi, Slopi) C Implement XAX/YAX LIN ixbeg(Idim, Igrp) = -1 IF ( Offi .EQ.NO .AND. Slopi.EQ.NO ) THEN C Both values are NO, then restore the first set of numbers. off(Idim, Igrp) = Off0(Idim, Igrp) slop(Idim, Igrp) = Slop0(Idim, Igrp) ELSE IF ( Offi .NE.NO ) off(Idim, Igrp) = Offi IF ( Slopi.NE.NO ) slop(Idim, Igrp) = Slopi C An increment of zero can cause problems later. So fudge value here. IF ( slop(Idim, Igrp).EQ.0. ) slop(Idim, Igrp) = 1. IF ( new(Idim,Igrp).NE.0 ) THEN new(idim, Igrp) = 0 off0(Idim, Igrp) = off(Idim, Igrp) slop0(Idim, Igrp) = slop(Idim, Igrp) END IF END IF xoff(Idim, Igrp) = 0. ipxer(Idim, Igrp) = 1 RETURN C*** ENTRY PLTXCN(Igrp, Ndimi, Npci) C Set number of dimensions IF ( Ndimi.GT.MXDIM ) THEN WRITE(*,*) 'PLTXCN--Attempt to create', Ndimi, & ' dimensional array.' WRITE(*,*) 'PLTXCN--Maximum allowed is',MXDIM, '.' STOP ELSE IF ( Igrp.GT.MXGRP ) THEN WRITE(*,*) 'PLTXCN--Attempt to create group number', Igrp WRITE(*,*) 'PLTXCN--Maximum allowed group is',MXGRP, '.' STOP END IF ndims(Igrp) = Ndimi npc(Igrp) = Npci IF ( ndims(Igrp).GT.1 .AND. npc(Igrp).EQ.0 ) THEN WRITE(*,*) 'PLTXCN--Npc must be non-zero for 2D data!' STOP END IF RETURN C*** ENTRY PLTXCO(Igrp, Idim, Xoffi) C Implement XAX OFF command xoff(Idim, Igrp) = Xoffi RETURN C*** ENTRY PLTXCP(Igrp, Idim, Ipxei) C Implement ERR X on/off/sqrt/ger ipxer(Idim, Igrp) = Ipxei RETURN C*** ENTRY PLTXCQ(Igrp, Idim, Ipxei) C Query plot X error status. Ipxei = ipxer(Idim, Igrp) RETURN END fv5.5/tcltk/plt/ptbuf.f0000644000220700000360000000214013224715127013725 0ustar birbylhea SUBROUTINE PTBUF(Cline, Lline) CHARACTER Cline*(*) INTEGER Lline C--- C This routine writes a single line to the current output device. C If line editing is activated, then the line editing IO routines C are used. C--- C Cline I The line to be written. C Lline I The number of valid characters in Cline. Lline=-1 C -causes LENACT to determine the number of valid characters. C--- C 2002-May-23 - Adapted from ttwrt [AFT] C--- INCLUDE 'edicmn.inc' INTEGER ILF PARAMETER (ILF = 10) INTEGER ICR PARAMETER (ICR = 13) INTEGER LENACT C REAL rbuf(1) INTEGER itmp C itmp=Lline IF ( itmp.LT.0 ) itmp=LENACT(Cline) IF ( ICEDIT.EQ.0 ) THEN WRITE(*,111) Cline(:itmp) 111 FORMAT(A) ELSE IF ( IFTYPE.LT.0 ) CALL PUTSTR(CHAR(ICR)//CHAR(ILF), 2) CALL PUTSTR(Cline, itmp) CALL PUTSTR(CHAR(ICR), 1) IF ( IFTYPE.GT.0 ) CALL PUTSTR(CHAR(ILF),1) CALL FLUSH(6) END IF C C And log CALL LOGGER(5,rbuf,0,Cline,itmp) RETURN END fv5.5/tcltk/plt/rdqdp.f0000644000220700000360000001642613224715127013733 0ustar birbylhea SUBROUTINE RDQDP(Ichat, Lunin, Cnam, Yray, Mxpts, Iery, Mxvec, : Nrow, Npts, Nvec, Cmd, Mxcmd, Ncmd, Ier) INTEGER Mxpts, Mxvec, Mxcmd CHARACTER Cnam*(*), Cmd(Mxcmd)*(*) REAL Yray(Mxpts) INTEGER Iery(Mxvec) INTEGER Ichat, Lunin, Nrow, Npts, Nvec, Ncmd, Ier C--- C Opens and reads a QDP file. C--- C Ichat I >0 print row/col info, >10 means print comment lines, C =-1 do an HTML decode C Lunin I <>0 means file already open on lun. C Cnam I/O File name. C Yray O The data array C Mxpts I The actual size of the Y array. C Iery O The PLT error flag array C Mxvec I The actual size of the Iery array C Nrow O Maximum number of rows that the file could contain. C Npts,Nvec O Needed by PLT C Cmd O Command array (Mxcmd input dimension). C Ncmd O Number of commands read C Ier O =-1 if user entered EOF, =0 file read, =1 no file read. C--- C 1989-Jul-31 - Changed calling sequence to allow RDQDP to optimize storage. C 1989-Feb-13 - Latest mod [AFT] C--- REAL FPNUM INTEGER ISNUM, LENACT C CHARACTER cbuf*1024 CHARACTER ctok*128, ctmp REAL value INTEGER i, icon, ierf, icol, ios, itmp, ix INTEGER kp, lbuf, Lnam, ltok, lun, ncol C--- 11 FORMAT(A) C--- Nvec=0 C- Open file if needed. lun=Lunin IF ( lun.EQ.0 ) THEN 100 IF ( Cnam.EQ.' ' ) THEN CALL GTBUF('QDP file name:',Ier) IF ( Ier.LT.0 ) GOTO 900 CALL GTCHAR(Cnam,Lnam) END IF IF ( Cnam.EQ.' ' ) THEN Ier=1 GOTO 950 END IF 130 CALL XTEND(Cnam,'qdp') IF ( lun.EQ.0 ) THEN CALL GETlun(lun) ELSE CLOSE(UNIT=lun) END IF CALL OPENWR(lun,Cnam,'OLD',' ',' ',0,1,ios) IF ( ios.NE.0 ) THEN Cnam=' ' GOTO 100 END IF END IF INQUIRE(UNIT=lun,NAME=Cnam) C--- Ier=0 DO i=1,Mxvec Iery(i)=0 END DO Ncmd=0 IF ( Ichat.GE.0 .AND. Ncmd.LT.Mxcmd ) THEN Ncmd=Ncmd+1 Cmd(Ncmd)='LA F '//Cnam END IF Npts=0 C--- 200 CONTINUE READ(lun,11,END=800) cbuf lbuf=LENACT(cbuf) C Skip blank lines. IF ( lbuf.EQ.0 ) GOTO 200 IF ( ichat.EQ.-1 ) CALL HDECOD(cbuf, lbuf) C--- kp=0 CALL ALFSKS(cbuf, lbuf, kp) IF ( cbuf(kp+1:kp+1).EQ.'!' ) THEN C Echo all comment lines (if chatter on). IF ( Ichat.GT.10 .AND. lbuf.GT.0) WRITE(*,221) cbuf(:lbuf ) 221 FORMAT(1X,A) GOTO 200 END IF ctmp = cbuf(kp+1:kp+1) CALL ALF(cbuf,lbuf,kp,ctok,ltok) C Special treatment for a single number and a continuation mark as C the trailing minus would causes ISNUM to return not a number. IF ( ctok(ltok:ltok).EQ.'-' ) THEN itmp=ltok-1 ELSE itmp=ltok END IF IF ( ISNUM(ctok,ltok).NE.0 .AND. ctmp.NE.'"' ) GOTO 300 CALL UPC(ctok) IF ( ctok(1:4).EQ.'READ' ) THEN CALL ALF(cbuf,lbuf,kp,ctok,ltok) CALL UPC(ctok) ierf=0 IF ( ctok(1:1).EQ.'S' ) ierf=1 IF ( ctok(1:1).EQ.'T' ) ierf=2 IF ( ierf.EQ.0 ) GOTO 200 C--- 230 CALL ALF(cbuf,lbuf,kp,ctok,ltok) IF ( ltok.LE.0 ) GOTO 200 ix=FPNUM(ctok,ltok,Ier) IF ( ix.LT.0 .OR. ix.GT.Mxvec ) GOTO 230 Iery(ix)=ierf GOTO 230 ELSE IF ( Ncmd.LT.Mxcmd ) Ncmd=Ncmd+1 IF ( lbuf.GT.0) Cmd(Ncmd)=cbuf(:lbuf ) END IF GOTO 200 C--- C Read a data line. 300 CONTINUE IF ( lbuf.LE.0 ) THEN itmp=0 ELSE itmp=INDEX(cbuf(:lbuf),'!') END IF IF ( itmp.GT.1) lbuf=LENACT(cbuf(:itmp-1) ) IF ( lbuf.GT.0 .AND. cbuf(lbuf:lbuf).EQ.'-' ) THEN icon=1 lbuf=lbuf-1 ELSE icon=0 END IF C If this is the first data point then calculate Nvec, Nrow, and ncol. C Ensure that neither Y nor Iery arrays will overflow. IF ( Npts.EQ.0 ) THEN C First we calculate the number of tokens on the line kp=0 icol=0 310 CONTINUE CALL RDCONR(lun,Ichat,icon,cbuf,lbuf,kp,ctok,ltok,value) icol=icol+1 Yray(icol)=value IF ( kp.LT.lbuf ) GOTO 310 C C Next we match tokens to vectors. This is done here because user C may not have forgotten to include an error on a vector in which C an error is expected from an 'READ xERR' command. ncol=0 330 CONTINUE Nvec=Nvec+1 ncol=ncol+1 IF ( Iery(Nvec).EQ.1 ) THEN C Skip one column for symmetric errors ncol=ncol+1 ELSE IF ( Iery(Nvec).EQ.2 ) THEN C or two columns for two-sided errors ncol=ncol+2 END IF IF ( ncol.LT.icol .AND. Nvec.LT.Mxvec ) GOTO 330 C Nrow=Mxpts/ncol IF ( Ichat.GT.0 ) THEN WRITE(*,351) ncol, Nvec, Nrow 351 FORMAT(/,' Reading',I5,' columns,',I5,' vectors.', : ' Maximum number of rows is',I8,'.',/) END IF C C We can now move the first row to the proper location in the Y array. C This is done from the top down to avoid the possibility of trashing C a number before moving it. IF ( ncol.GT.1 ) THEN itmp=Nrow*(ncol-1)+1 DO i=ncol,2,-1 Yray(itmp)=Yray(i) Yray(i)=0. itmp=itmp-Nrow END DO END IF Npts=1 ELSE C IF ( Npts.GE.Nrow ) THEN WRITE(*,*) 'RDQDP--Too many lines in file.' GOTO 800 END IF kp=0 Npts=Npts+1 itmp=Npts DO icol=1, ncol CALL RDCONR(lun,Ichat,icon,cbuf,lbuf,kp,ctok,ltok,value) Yray(itmp)=value itmp=itmp+Nrow END DO END IF GOTO 200 C--- C No error 800 CONTINUE Ier=0 GOTO 950 C--- C Error 900 CONTINUE Ier=-1 C Common exit 950 CONTINUE IF ( lun.GT.0 ) THEN CLOSE(UNIT=lun) CALL FRElun(lun) END IF RETURN END C********* SUBROUTINE RDCONR(Lun,Ichat,Icon,Cbuf,Lbuf,Kp,Ctok,Ltok,Value) CHARACTER Cbuf*(*), Ctok*(*) INTEGER Lun, Ichat, Icon, Lbuf, Kp, Ltok REAL Value C--- C Read with continuation a real number. C--- C Lun I The open unit being read C Ichat I =-1 to hdecod lines as they are read C Icon I/O C Cbuf I/O C Lbuf I/O C Kp I/O C Ctok I/O C Ltok I/O C Value O C--- REAL FPNUM INTEGER LENACT C INTEGER ier, itmp C--- 11 FORMAT(A) C--- CALL ALF(Cbuf, Lbuf, Kp, Ctok, Ltok) Value = FPNUM(Ctok, Ltok, ier) C 100 CONTINUE IF ( Kp.GE.Lbuf .AND. Icon.GT.0 ) THEN READ(Lun,11,END=800) Cbuf Lbuf=LENACT(Cbuf) IF ( ichat.EQ.-1 ) CALL HDECOD(Cbuf, Lbuf) IF ( Lbuf.LE.0 ) THEN itmp=0 ELSE itmp=INDEX(Cbuf(:Lbuf),'!') END IF IF ( itmp.GT.1) Lbuf=LENACT(Cbuf(:itmp-1) ) IF ( Lbuf.GT.0 .AND. Cbuf(Lbuf:Lbuf).EQ.'-' ) THEN Icon=1 Lbuf=Lbuf-1 ELSE Icon=0 END IF Kp=0 CALL ALFSKS(Cbuf, Lbuf, Kp) IF ( Kp.GE.Lbuf ) GOTO 100 END IF C--- 800 RETURN END fv5.5/tcltk/plt/rescal.f0000644000220700000360000000066013224715127014063 0ustar birbylhea SUBROUTINE RESCAL(CAX, IWNUM, VMIN, VMAX, CTMP, LTMP) CHARACTER CAX*1, CTMP*(*) INTEGER IWNUM, LTMP REAL VMIN, VMAX C--- CTMP='R '//CAX LTMP=6 IF(IWNUM.LE.0) THEN LTMP=LTMP+3 ELSE CALL CRAMI(IWNUM,CTMP,LTMP) LTMP=MAX(LTMP+1,6) END IF CALL CRAMF(VMIN,CTMP,LTMP) LTMP=LTMP+1 CALL CRAMF(VMAX,CTMP,LTMP) RETURN END fv5.5/tcltk/plt/set_pgdev.f0000644000220700000360000000125313224715127014571 0ustar birbylheac c set_pgdev -- get PGPLOT device name c subroutine set_pgdev(indevice) character*(*) indevice integer*4 lenstr integer lenact character cret*64 integer lret lenstr = lenact(indevice) if (indevice(1:1) .eq. '?') then call pgdev('?') ccc call trlog ('PGPLOT_DEVICE',13,cret,lret) call trlog ('PGPLOT_TYPE',11,cret,lret) indevice(:lret) = cret(:lret) lenstr = lret if (indevice(1:1) .eq. ' ') then indevice(1:1) = '?' end if end if call setenv(indevice) return end fv5.5/tcltk/plt/spline.f0000644000220700000360000001562513224715127014113 0ustar birbylheaC---SPLINE.FOR Contains the FIT Spline model routines. C--- SUBROUTINE SPLIM(PAR, PLIM, NT, NTERM) REAL PAR(*), PLIM(3,*) INTEGER NT, NTERM C--- C This routine must be called every time a parameter is changed. C--- C PAR(NTERM) I Contain X and Y locations of the knots. C PLIM(1,NTERM) I/O <0. means parameter is froozen. C NKNOT I/O =NTERM/2 C--- C- MXKNOT=MXPAR/2 C--- INTEGER MXKNOT PARAMETER (MXKNOT=60) REAL YMIN, YMAX INTEGER IND, IX C REAL Y2, U, XDEL, YDEL INTEGER NKNOT, IPER COMMON /SPLCMN/Y2(MXKNOT),U(MXKNOT),XDEL,YDEL,NKNOT,IPER C--- NKNOT=NTERM/2 IF(NKNOT.GT.MXKNOT) THEN WRITE(*,101) MXKNOT 101 FORMAT(' SPLIM--Maximum number of knots is=',I6) NKNOT=MXKNOT END IF IF ( NT.EQ.-1 ) THEN NTERM=2*NKNOT RETURN END IF XDEL=(PAR(NT+NKNOT-1)-PAR(NT))/(20.*NKNOT) CALL AJUST(XDEL,PAR,PLIM,NT,NKNOT,YMIN,YMAX) YDEL=(YMAX-YMIN)/500. IF(YDEL.LE.0.) YDEL=1./500. IPER=0 IND=NT+2*NKNOT-1 IX=NINT(-PLIM(1,IND)) IF(IX.EQ.NT+NKNOT .AND. PLIM(2,IND).EQ.1.) THEN C- If first and last Y values are equal, force periodic boundary C- condition. IPER=1 END IF CALL SPLINE(PAR(NT), PAR(NT+NKNOT), Y2, U, NKNOT, IPER) RETURN END C********* REAL FUNCTION FNSP(X, PAR) REAL X, PAR(*) C--- C Evaluate Spline for use in FIT. C--- INTEGER MXKNOT PARAMETER (MXKNOT=60) REAL FNECSP C REAL Y2, U, XDEL, YDEL INTEGER NKNOT, IPER COMMON /SPLCMN/Y2(MXKNOT),U(MXKNOT),XDEL,YDEL,NKNOT,IPER C--- FNSP=FNECSP(X, PAR, Y2, NKNOT, IPER) RETURN END C********* REAL FUNCTION FNECSP(X, PAR, Y2, NKNOT, IPER) REAL X, PAR(*), Y2(*) INTEGER NKNOT, IPER C--- C Evaluates a cubic SPLINE. This routine finds the value of J such C that PAR(J)<=XT0, then the first derivative is forced to match at the C beginning and ending of the interval. This creates a smooth C periodic function. C--- C X(*) I The X locations of the knots C Y(*) I The Y locations of the knots C--- REAL AJ, RDIAG, SLOP, SLOP1, SLOPN INTEGER J C--- C- Solve the tridiagonal matrix given in 3.3.7 of Press. In the C- first pass, eliminate terms below the diagonal, and set terms on C- the diagonal equal to 1. The U(*) represent the terms above the C- diagonal, and Y2(*) the current right-hand side of the equation. IF(IPER.EQ.0) THEN Y2(1)=0. U(1)=0. ELSE SLOP1=(Y(2)-Y(1))/(X(2)-X(1)) SLOPN=(Y(NKNOT)-Y(NKNOT-1))/(X(NKNOT)-X(NKNOT-1)) SLOP=(SLOP1+SLOPN)/2. RDIAG=(X(2)-X(1))/3. Y2(1)=(SLOP1-SLOP)/RDIAG U(1)=1./2. END IF C- DO 120 J=2,NKNOT-1 AJ=(X(J)-X(J-1))/6. RDIAG=(X(J+1)-X(J-1))/3.-AJ*U(J-1) Y2(J)=((Y(J+1)-Y(J))/(X(J+1)-X(J))- : (Y(J)-Y(J-1))/(X(J)-X(J-1))-AJ*Y2(J-1))/RDIAG U(J)=(X(J+1)-X(J))/(6.*RDIAG) 120 CONTINUE C- IF(IPER.EQ.0) THEN Y2(NKNOT)=0. ELSE AJ=(X(NKNOT)-X(NKNOT-1))/6. RDIAG=AJ*(2.-U(NKNOT-1)) Y2(NKNOT)=(SLOP-SLOPN-AJ*Y2(NKNOT-1))/RDIAG END IF C--- C- Now eliminate terms above the diagonal. DO 140 J=NKNOT-1,1,-1 Y2(J)=Y2(J)-U(J)*Y2(J+1) 140 CONTINUE RETURN END fv5.5/tcltk/plt/weight.f0000644000220700000360000000211413224715127014075 0ustar birbylhea REAL FUNCTION WEIGHT(Ydat, Mxrow, Iery) REAL Ydat(*) INTEGER Mxrow, Iery C--- C Compute the statistical weight for point Y(1). If Iery>0 then C error is assumed to be at location Y(1+Mxrow). C--- C Ydat I C Mxrow I C Iery I <0 Poisson C =0 No weighting C >0 Explicit error C--- C [AFT] C--- REAL NO PARAMETER (NO=-1.2E-34) C--- WEIGHT=0. IF ( Ydat(1).EQ.NO ) RETURN C IF ( Iery ) 10,20,30 IF ( Iery.GT.0 ) GOTO 30 IF ( Iery.EQ.0 ) GOTO 20 C--- 10 CONTINUE IF ( Iery.EQ.-2 ) THEN C Gehrels (ApJ 1986, 303, p336) WEIGHT=1./(1.+SQRT(0.75+ABS(Ydat(1))))**2 ELSE C Poisson WEIGHT=1./MAX(1.0,ABS(Ydat(1))) END IF RETURN C--- C No weighting 20 CONTINUE WEIGHT=1. RETURN C--- C Use formal errors 30 CONTINUE IF ( Iery.GE.4 ) THEN C Special case, error is the weight. WEIGHT=Ydat(1+Mxrow) RETURN END IF IF(Ydat(1+Mxrow).GT.0.) WEIGHT=1./(Ydat(1+Mxrow)*Ydat(1+Mxrow)) RETURN END fv5.5/tcltk/plt/wrqdat.f0000644000220700000360000000635613224715127014124 0ustar birbylhea SUBROUTINE WRQDAT(Lun, Ndig, Y, Iery, Mxrow, Nvec) INTEGER Lun, Ndig, Mxrow, Nvec INTEGER Iery(*) REAL Y(*) C Entry wrqsl/wrqql INTEGER Mxlen1 C--- C Write a single row of data to a QDP file. C--- C Lun I Open LUN C Ndig I Number of digits to write out C Y I Data array C Iery I Error array C Mxrow I First index of Y C Nvec I Number of vectors C--- C 1996-Jan-24 - [AFT] C--- CHARACTER cbuf*1024 CHARACTER ctok*80 REAL rtmp, tmper INTEGER idig, igroup, ind, itmp, lbuf, ltok INTEGER mxlen SAVE mxlen DATA mxlen/256/ C--- 11 FORMAT (A) C--- cbuf = ' ' lbuf = 0 ind = 1 DO igroup = 1,Nvec rtmp = Y(ind) ind = ind + Mxrow ctok = ' ' ltok = 0 IF(iery(igroup).GT.0) THEN tmper = Y(ind) IF(Ndig.LT.0) THEN idig = 500 IF(rtmp.NE.0) idig = INT(LOG10(ABS(rtmp))+500.) itmp = 500 IF (tmper.NE.0) itmp = INT(LOG10(ABS(tmper))+500.) idig = Ndig-idig+itmp CALL CRAMFF(rtmp,6,idig,ctok,ltok) ltok = ltok+1 CALL CRAMFF(tmper,6,Ndig,ctok,ltok) IF (iery(igroup).GT.1) THEN ltok = ltok+1 tmper = Y(ind+Mxrow) CALL CRAMFF(tmper,6,Ndig,ctok,ltok) END IF ELSE IF (Ndig.EQ.0) THEN CALL CRAMF(rtmp,ctok,ltok) ltok = ltok+1 CALL CRAMF(tmper,ctok,ltok) IF(iery(igroup).GT.1) THEN ltok = ltok+1 tmper = Y(ind+Mxrow) CALL CRAMF(tmper,ctok,ltok) END IF ELSE CALL CRAMFF(rtmp,0,-Ndig,ctok,ltok) ltok = ltok+1 CALL CRAMFF(tmper,0,-Ndig,ctok,ltok) IF(iery(igroup).GT.1) THEN ltok = ltok+1 tmper = Y(ind+Mxrow) CALL CRAMFF(tmper,0,-Ndig,ctok,ltok) END IF END IF ind = ind+iery(igroup)*Mxrow ELSE IF (Ndig.EQ.0) THEN CALL CRAMF(rtmp,ctok,ltok) ELSE CALL CRAMFF(rtmp,0,-ABS(Ndig),ctok,ltok) END IF IF (lbuf+ltok.GT.mxlen) THEN C Write at most mxlen columns on a line, then continue WRITE(Lun,11) cbuf(:lbuf-1)//'-' cbuf = ' '//ctok lbuf = ltok + 3 ELSE cbuf(lbuf+1:lbuf+ltok) = ctok(:ltok) lbuf = lbuf + ltok + 1 END IF END DO C WRITE(Lun,11) cbuf(:lbuf-1) RETURN C--- ENTRY wrqdl() C Display (SHow) current value. WRITE(*,311) mxlen 311 FORMAT('LEngth ',I5,' ! Maximum length of lines written with', & ' the WData command.') RETURN C--- ENTRY wrqsl(Mxlen1) IF ( Mxlen1.LE.10 ) THEN WRITE(*,*) 'LEngth must be larger than 10. Ignored.' ELSE IF ( LEN(cbuf).LT.Mxlen1 ) THEN WRITE(*,*) 'LEngth set to maximum of',LEN(cbuf) mxlen=LEN(cbuf) ELSE mxlen=Mxlen1 END IF RETURN C--- ENTRY wrqql(Mxlen1) mxlen1=mxlen RETURN END fv5.5/tcltk/plt/wrtcol.f0000644000220700000360000000355113224715127014126 0ustar birbylhea SUBROUTINE WRTCOL(Lun, Icol, Ngroup) INTEGER Lun, Icol(*), Ngroup C--- C Generate the COLOR command strings for the PLT WHead command. C--- C Lun I Output logical unit number C Icol I Which color to use for each group C Ngroup I Number of groups to check in Icol list. C--- C 1993-Apr-15 - New routine [AFT] C--- CHARACTER ctmp*80 INTEGER ig, iend, istart, ltmp C--- 11 FORMAT(A) C--- ctmp = 'COL OFF ' ltmp = 9 istart = 0 iend = 0 DO 190 ig=1, Ngroup IF(Icol(ig).LE.0 ) THEN C Current group is colored off, add to list. IF ( istart.LE.0 ) THEN istart = ig ELSE iend = ig END IF END IF IF(Icol(ig).GT.0 .OR. ig.EQ.Ngroup ) THEN C This group is colored on, write out colored off list, if any. IF ( istart.GT.0 ) THEN CALL CRAMI(istart, ctmp, ltmp) IF ( iend.GT.0 ) THEN ctmp(ltmp+1:ltmp+2) = '..' ltmp = ltmp + 2 CALL CRAMI(iend, ctmp, ltmp) END IF IF ( ltmp.GE.72 ) THEN WRITE(Lun,11) ctmp(:ltmp) ctmp = 'COL OFF ' ltmp = 9 ELSE ltmp = ltmp+1 END IF istart = 0 iend = 0 END IF END IF 190 CONTINUE IF(ltmp.GT.9) WRITE(Lun,11) ctmp(:ltmp-1) C Now do COlor ON command. DO 290 ig=1, Ngroup IF(Icol(ig).GT.0 .AND. Icol(ig).NE.ig ) THEN ctmp = 'COL ' ltmp = 4 CALL CRAMI(Icol(ig), ctmp, ltmp) ctmp(ltmp+1:ltmp+4) =' ON ' ltmp = ltmp + 4 CALL CRAMI(ig, ctmp, ltmp) WRITE(Lun,11) ctmp(:ltmp) END IF 290 CONTINUE RETURN END fv5.5/tcltk/plt/wrtcon.f0000644000220700000360000000350213224715127014124 0ustar birbylhea SUBROUTINE WRTCON(LUN, ICNUM, RLEV, ICOCON, ILSCON, : RLWCON, MXLEV, CTMP) INTEGER LUN, ICNUM, ICOCON(*), ILSCON(*), MXLEV REAL RLEV(*), RLWCON(*) CHARACTER CTMP*(*) C--- C Write out lines that describe the current contour plot. C--- C LUN I C ICNUM I Contour plot number C RLEV I C ICOCON I C ILSCON I C RLWCON I C MXLEV I C CTMP S Scratch area C--- C 1989-Oct-03 - [AFT] C--- REAL NO PARAMETER (NO=-1.2E-34) C INTEGER I, LTMP, NLEV C--- 11 FORMAT(A) C--- NLEV=0 DO 110 I=1,MXLEV IF(NLEV.EQ.0 .AND. RLEV(I).EQ.NO) NLEV=I-1 110 CONTINUE IF(NLEV.EQ.0) NLEV=MXLEV C WRITE(CTMP,121) ICNUM,'LEVEL' 121 FORMAT('CONT',I3,1X,A5,1X) LTMP = 14 DO 130 I=1,NLEV CALL CRAMFF(RLEV(I), 7, 0, CTMP, LTMP) LTMP=LTMP+1 130 CONTINUE IF(LUN.EQ.0) THEN WRITE(*,11) CTMP(:LTMP-1) ELSE WRITE(LUN,11) CTMP(:LTMP-1) END IF C WRITE(CTMP,121) ICNUM,'COLOR' LTMP = 14 DO 150 I=1,NLEV CALL CRAMIF(ICOCON(I), 7, CTMP, LTMP) LTMP=LTMP+1 150 CONTINUE IF(LUN.EQ.0) THEN WRITE(*,11) CTMP(:LTMP-1) ELSE WRITE(LUN,11) CTMP(:LTMP-1) END IF C WRITE(CTMP,121) ICNUM,'LSTYL' LTMP = 14 DO 170 I=1,NLEV CALL CRAMIF(ILSCON(I), 7, CTMP, LTMP) LTMP=LTMP+1 170 CONTINUE IF(LUN.EQ.0) THEN WRITE(*,11) CTMP(:LTMP-1) ELSE WRITE(LUN,11) CTMP(:LTMP-1) END IF C WRITE(CTMP,121) ICNUM,'LWID' LTMP = 14 DO 190 I=1,NLEV CALL CRAMFF(RLWCON(I), 7, 0, CTMP, LTMP) LTMP=LTMP+1 190 CONTINUE IF(LUN.EQ.0) THEN WRITE(*,11) CTMP(:LTMP-1) ELSE WRITE(LUN,11) CTMP(:LTMP-1) END IF RETURN END fv5.5/tcltk/plt/wrtima.f0000644000220700000360000000245313224715127014117 0ustar birbylhea SUBROUTINE WRTIMA(Lun, Ig, Itfun, Icbar, Zscale, & Cctnam, Ctmp) INTEGER Lun, Ig, Itfun, Icbar REAL Zscale(2) CHARACTER Cctnam*(*), Ctmp*(*) C--- C Write out lines that describe the current contour plot. C--- C Lun I C Ig I Image number C Itfun I C Icbar I C Zscale I C Cctnam I C Ctmp S Scratch area C--- C 2010-May-28 - [AFT] C--- INTEGER LENACT C INTEGER ltmp C--- 11 FORMAT(A) C--- WRITE(Ctmp,121) Ig,Zscale(1),Zscale(2) 121 FORMAT('IMAG',I4,' MIN',1PG11.4,' MAX',G11.4) ltmp = 37 C IF ( itfun.LT.0 ) THEN Ctmp(ltmp+1:)='HIST ' ltmp=ltmp+5 ELSE IF ( itfun.EQ.1 ) THEN Ctmp(ltmp+1:)='LOG ' ltmp=ltmp+5 ELSE IF ( itfun.EQ.2 ) THEN Ctmp(ltmp+1:)='SQRT ' ltmp=ltmp+5 END IF C IF ( icbar.GT.0 ) THEN Ctmp(ltmp+1:)='CBar ON ' ltmp=ltmp+8 END IF C--- IF(Lun.EQ.0) THEN WRITE(*,11) Ctmp(:ltmp-1) ELSE WRITE(Lun,11) Ctmp(:ltmp-1) END IF C WRITE(Ctmp,151) Ig,cctnam(:LENACT(cctnam)) 151 FORMAT('IMAG',I4,' CCT ',A) ltmp=LENACT(Ctmp) IF(Lun.EQ.0) THEN WRITE(*,11) Ctmp(:ltmp) ELSE WRITE(Lun,11) Ctmp(:ltmp) END IF RETURN END fv5.5/tcltk/plt/yorn.f0000644000220700000360000000235013224715127013577 0ustar birbylhea SUBROUTINE YORN(CPROM, IDEF, IANS) CHARACTER CPROM*(*) INTEGER IDEF, IANS C--- C Simple routine to ask the user a Yes/No question. C--- C Cprom I The prompting question C Idef I/O The default answer. Idef=0 means user cannot default. C Ians O =1 for yes, =-1 for no, =0 for EOF. C--- C 1992-Jul-22 - [AFT] C--- INTEGER LENACT C CHARACTER CTMP*80 CHARACTER CDUM*3 INTEGER IER, ITMP, LDUM C--- ITMP=LENACT(CPROM) IF( IDEF.LT.0 ) THEN CTMP=CPROM(:ITMP)//' (N)?' ELSE IF ( IDEF.GT.0 ) THEN CTMP=CPROM(:ITMP)//' (Y)?' ELSE CTMP=CPROM(:ITMP)//'?' END IF C--- 100 CALL GTBUF(CTMP, IER) IF(IER.LT.0) THEN IANS=0 ELSE CALL GTREST(CDUM, LDUM) IANS = 0 IF ( LDUM.EQ.0 ) THEN IANS = IDEF ELSE IF(CDUM(1:1).EQ.'Y' .OR. CDUM(1:1).EQ.'y') THEN IANS = 1 ELSE IF(CDUM(1:1).EQ.'N' .OR. CDUM(1:1).EQ.'n') THEN IANS = -1 END IF IF ( IANS.EQ.0 ) THEN WRITE(*,121) 121 FORMAT(' Please answer Y or N') GOTO 100 END IF IF ( IDEF.NE.IANS ) IDEF = IANS END IF RETURN END fv5.5/tcltk/pow/0000755000220700000360000000000013224715130012441 5ustar birbylheafv5.5/tcltk/pow/About.html0000644000220700000360000000075113224715127014412 0ustar birbylhea About Pow

About Pow

POW is a curve plotting and image display interface tool written and distributed by the HEASARC at NASA/GSFC.

The current version of POW is 3.0 and it is still under active development. POW features a very flexible developer's interface and a "friendly" end user GUI interface. POW is a Tcl/Tk extension and can be called from standard C or FORTRAN main programs.

fv5.5/tcltk/pow/Blinking.html0000644000220700000360000001102213224715127015066 0ustar birbylhea Blink Images/Graphs

Blink Images/Graphs

Within POW, multiple images can be examined for differences by the common technique of overlaying them and blinking them in rapid succession. Pow provides two methods for doing this.

Blink Images...

Multiple images can be placed within a single POW graph. This can be achieved by merging the contents of several graphs into a single one (via POW's Merge Graphs or Edit Graphs menu items), or, if the data is part of a 3-D data cube, by using an outside tool (eg, fv) to produce a graph with each 2-D slice of the cube treated as a separate image. After the graph containing all the desired images has been created and selected, select Blink Images from the Edit menu. A dialog box containing information about the current graph and controls for the blinking behavior will be displayed.

At the top of the dialog box is the name of the selected graph followed by the number of images in the graph and the image number currently in the foreground. The Prev and Next buttons immediately below this information step through the images, bringing each one to the foreground in turn. It is possible to either blink all the images in order or in a specified sequence. The Add to List button appends to this sequence list the image currently in the foreground. The sequence List entry box consists of a comma-separated list of image numbers and/or ranges (e.g., 1-3,5,8-10,14). A pair of radio buttons determines with the sequence list is used or all the images are blinked in order. Two checkbuttons control whether blinking is Looped--repeated indefinitely--or stopped after the last image is displayed, or blinked in Reverse order. A slidebar controls the Speed at which blinking occurs. All these controls can be modified while images are being blinked and will take effect immediately. To have a new list of frames take effect, though, one must reselect the List radio button.

When the controls are set to their desired values, press the Blink Images button to begin blinking. The button changes to Stop Blinking.

If the selected graph is changed while the dialog box is open, press the Reload Info button to update the dialog with the new information.

Blink Graphs...

It is not always possible to put all one's images into a single graph--images may lack a common coordinate system for automatic alignment--preventing the previous blinking method from being used. The Blink Graphs menu item allows individual graphs to be blinked. There is no "natural order" with which to blink graphs, so the user is presented with a list of all Available Graphs and must specify which graphs to blink and in which order. The Add and Insert buttons append to the end or insert at the current selection point of the Blink Order list the highlighted graphs from the Available Graphs list. A graph may appear multiple times in the Blink Order list. The Delete button removes all highlighted entries from the Blink Order list. As in the Blink Images method, a slidebar controls the speed of the blinking.

Blink begins when the Blink Graphs button is pressed. Blinking is always in the specified order (no reverse option) and will repeat indefinitely until the Stop Blinking button (same as the Blink Graphs button) is pressed.

As graphs normally don't initially overlap and will likely need to be repositioned, the graphs in the Blink Order list can be moved from within the dialog box. A compass labeled Shift & Align Graphs is present in the center of the dialog box. Clicking on the center of the compass aligns all the graphs in the list according to the top right corner of the first graph. Clicking on any of the arrows shifts the highlighted graphs 10 pixels in that direction. Shift-clicking an arrow shifts the graphs 1 pixel at a time. The graphs continue to move in these increments until the mouse button is released or the cursor leaves the compass arrow. (Note: if an individual graph is present several times in the Blink Order list, each instance of it in the highlighted selection will experience the shift.) Graphs can be repositioned with the compass while blinking.

If graphs are added to the POW canvas while the dialog box is open, press the Reload Info button to create a new list of Available Graphs.

fv5.5/tcltk/pow/Color.html0000644000220700000360000000634313224715127014421 0ustar birbylhea POW and Color

POW and X Colormaps

POW allows some interactive manipulation of the Colortable used to display grayscale images. POW has detailed X Colormap handling options. There are four different ways of dealing with colormaps. The powColormap options are available in fv by using the "-cmap" command line argument to fv. The different options are:

  • 0 - let POW attempt to determine the optimum colormap setup for you. This is the default.
  • 1 - Force POW to setup a private colormap. POW will setup this colormap to minimize (but not eliminate) flashing.
  • 2 - Force POW to use truecolor. If you have a 16 or 24 bit truecolor visual available, this looks very nice, and allows different colortables for different images, but interactive changes to the image colortable are slow. If you only have 8 bit truecolor, this will look pretty bad.
  • 3 - Force POW to use the screen default colormap. This guarantees no flashing, but may force truecolor image mode to be used with an 8-bit visual which looks really awful.
Generally, if you experience colormap problems, mode 1 is probably the most robust unless you don't have any pseudocolor visuals (e.g. a Linux machine running in 16 or 24 bit mode).

The POW Color Menu

The POW Color menu has four parts:

  1. The top section contains three hierarchical menus listing a bunch of colortables from which to choose. They are divided into Continuous (colors vary in a smooth manner), Ramps (colormap is divided into separate colors within which the intensity varies from dark to bright), and Steps (colormap is divided into blocks of a constant color/intensity).
  2. You can reverse the "dark to light" direction of your colortable by checking the Invert Colortable button.
  3. There are four scalings of the colortable available in the next section. The first three linear, sqrt, and log apply the indicated function to the color table. The next item -- Histo Equalize -- will compute a histogram of an image (within a user-configurable range) and attempt to distribute colors equally amongst the pixels. The Rescale Image command allows the user to define what intensity range over which to apply the color table. The window which comes up contains the original and current intensity range and a histogram of the current image. A new range can be either typed in directly or selected using the histogram.
  4. The final item -- Create Colorbar -- will create a new graph containing a colorbar for the current image.

You can interactively change the contrast and brightness of the current image's colortable by dragging the left mouse button across the image.

fv5.5/tcltk/pow/Contours.html0000644000220700000360000000656513224715127015165 0ustar birbylhea Contour Creation

Contour Maps

Selecting Make Contour Map from the Edit menu brings up a dialog box which allows one to specify how the contour map will be created for the current image in the current graph (indicated by the green bounding box)...

Image Range: Minimum and maximum pixel values of the selected image.

Contour Range: Minimum and maximum values to contour over. The values are initially taken from a "clean" approximation of the min and max pixel values of the image, but the user can change these values to whatever is desired. (Note that the min value need not be less than the max value.)

# Contours: Number of contour levels to produce between the range points. One can either click on the < or > buttons to decrease/increase the number or type in a new number directly.

Scale: Scaling method for interpolating contour levels. The linear method will space the contours over a constant interval from the min and max range. The other two options -- sqrt and log -- do much the same thing but based on the square root or logarithm of the min and max values. These latter options bring out the finer details at the lower contour levels in images with a large dynamic range.

Contours: This is the actual list of contours to draw. The previous contour items update this list each time they are clicked, but the list may be customized prior to clicking the Make Contours button.

Resolution: This determines how detailed (and accurate) the contours will be. At high resolution, contours will be produced based on the value from each pixel of the image. Low resolution will produce contours using the average pixel value in 3x3 sections, resulting in a lot few points to be plotted and, therefore, faster performance. Medium resolution uses 2x2 sections. Using high resolution when the contour intervals are similar in size to the image noise will create an enormous number of points, significantly slowing down POW.

Separate Graph: If this box is checked, when the contours are created, the contours will be placed in a separate graph by itself. Otherwise, the contours will be placed on top of the current graph along with the original image.

Click on the Make Contours button to build and draw the contours. After a set of contours is created, its parameters can still be modified in this dialog box and the contours recreated (replacing the previous version) with the Make Contours button. Contours are created as a POW curve, so one can control its display features (color, line style, etc) from the Edit Graphs dialog box.

If the original image contains WCS information, the contours will be created in terms of celestial coordinates. (Without WCS information, contours will be drawn in pixel coordinates.) As a result, one can place the contours made from one image into a graph containing another image (with its own, possibly different, WCS information) and the contours will be positioned appropriately for the new graph. This can be used to compare observations of the same object at different wavelengths (eg, radio and optical).

fv5.5/tcltk/pow/DefaultOptions.html0000644000220700000360000002030413224715127016274 0ustar birbylhea Preferences

Preferences

The Preferences... item in the Edit menu, brings up a dialog box in which one can set the default display behavior for new graphs. One can control the tick frequency, grid line colors, and scaling for graph axes; color, point styles, and line types for scatter plots; and colormaps and scaling of images. The window has a paned format in which the options affecting each part of the graph has a pane which can be brought forward by clicking the appropriately labeled tab.

  • POW
    
     This pane sets the application level preferences for how POW
     looks and behaves.  Cursor sets the image to use as the
     mouse cursor when in POW's main window.  POW's "GUI" consists of
     the 3 pixel readouts, the Scopebox, and the Zoom In/Out buttons
     usually located at the top of the window.  The GUI
     Position option allows you to move these to any side of the
     window or turn them off altogether.  Scopebox Size alters
     the size of the scopebox -- the window showing a small overview
     of the current graph -- or hides it altogether.  Resize
     Window determines whether the POW window will get bigger or
     smaller (as far as possible) whenever you change the objects in
     the main POW window, so as to show you everything currently
     displayed in the main POW window without scrolling.
     Using the color grid or button, Background Color will set
     the color to use for the background of all of POW's windows.
  • Graph
    
     This pane has been modified, containing a pair of entry
     boxes labeled Size, a set of buttons labeled
     Scaling and new control to choose functionality for
     right or left mouse buttons [More options are available when 
     editting a real graph (see Edit Graphs).]  Enter
     into the Size boxes, the default width and height to use
     when creating a new graph.  When a graph is created by another
     program (such as fv), it determines the size of the graph, so
     these options are usually overridden.  The Scaling buttons
     activate logarithmic graphs.  The first row of linear and
     log buttons cause each axis to be drawn in either linear
     or logarithmic format.  This does not affect the data, just how
     the graph coordinates are interpretted and labeled.  You can
     control the logarithmic conversion of individual curve data from
     the Points and Lines panes.

     The mouse control button can be clicked to switch the functionality
     of mouse buttons. Default will be left mouse button to control image
     zoom factor, and right mouse button to control brightness/contrast.
  • Fonts
    
     This pane controls the appearance of text in the graph.  One can
     independently set the font, size, style, and color of the Title,
     Axis Labels, Tick Labels, and default Text Labels.
     The Text Label value is used only for the initial text label.  All
     subsequent labels inherit their values from the previous label.
  • Ticks
    
     This pane controls the appearance of the tick marks and
     associated grid lines.  Use the slidebars to indicate
     approximately how many tick marks should be drawn (and labeled)
     on each axis of the graph.  At the far left, no tickmarks will be
     drawn on each axis.  At the far right, about 30 may be drawn.
     The X Ticks and Y Ticks options control whether the
     X and Y tickmarks are drawn inside or outside the graph's box and
     whether they are labeled on the left and bottom axes.  The
     Tick Labels option selects between Decimal and Base 60
     (degrees minutes seconds) numerical formats.  Base 60 is only used
     when a graph contains WCS information.  If the Grid Lines
     checkbox is selected, lines will drawn on the graph, tracing the
     path of each tick mark coordinate.  One can control the
     Color and line Style (solid, dashed, etc) of these
     lines.
  • Points
    
     The checkbox at the top of this item indicates whether the
     individual points of the curve should be drawn.  The points can
     be drawn as any of the 7 listed shapes.  The size
     of the points (except Dot which is always 1 point) can either be
     fixed at a constant size indicated by the slidebar, or
     drawn with widths/heights indicating the X and Y error
     bars.  If there are X/Y error bars but the points are drawn
     in a fixed style, the error bars will be indicated by
     horizontal/vertical lines centered on the point.  Points can be
     Filled or just drawn in outline.  Finally, select the
     desired color from the displayed colorbar.  This can be a
     different color than selected in the Lines pane.

     At the bottom are a pair of LogX/logY checkbuttons labeled
     Transform (This is the same option as in the Lines pane).
     Checking these will cause curves to have the logarithm of their
     data plotted instead of the data itself.  This does not
     automatically result in logarithmic axes, which are turned on
     from the Graph pane.  Unless you will always want your data to be
     converted to a certain logarithm format, these options should be
     left unset.
  • Lines
    
     The checkbox at the top of this pane indicates whether data
     points will be connected with a continuous line.  The line can be
     of several patterned styles or widths.  The points
     can also be connected directly (Normal) or in a
     stair-step pattern (Histogram).  In the latter mode, the
     Fill Boxes option draws the histogram as a series of solid
     boxes instead of an outline.  Finally, select the desired color
     from the displayed colorbar.  This can be a different color than
     selected in the Points pane.

     At the bottom are a pair of LogX/logY checkbuttons labeled
     Transform (This is the same option as in the Points pane).
     Checking these will cause curves to have the logarithm of their
     data plotted instead of the data itself.  This does not
     automatically result in logarithmic axes, which are turned on
     from the Graph pane.  Unless you will always want your data to be
     converted to a certain logarithm format, these options should be
     left unset.
  • Image
    
     This pane controls the appearance of images.  Most of the pane
     consists of a bunch of different colormaps.  They are grouped in
     the same sequence as listed in the Color menu: smooth, continuous
     colormaps, followed by ramps, then the step functions.  The
     Invert option will reverse the order of the colormap when
     turned on.  The Scaling option controls how the colormap
     is applied to the image.  For Linear scaling, each
     colormap level corresponds to a constant intensity range in the
     image.  Square-Root scaling changes the mapping such that
     the intensity range covered by each color level increases as the
     square-root function, producing higher contrast at lower
     intesities.  Logarithmic scaling uses the logarithmic
     function for colormapping, giving even more contrast at low
     intensities than sqrt.  Histo Equalize scaling computes
     a histogram of the image and tries to distribute colors equally
     over the number of pixels.

Clicking the Reset button will revert the options to their values when the dialog box was initially opened, undoing any modifications. Clicking the Save button will make the current settings the defaults for new graphs and save them in your .powrc file. The Get Current button grabs any available options from the current graph. Its current image (if present) will be used for the default image options and its first curve (if present) for the default curve options. Exitting will also make the new settings the current defaults, but won't save them.

fv5.5/tcltk/pow/Edit.html0000644000220700000360000000553413224715127014231 0ustar birbylhea The POW edit menu

The POW edit menu

  • Edit Graph: This sequence of dialogues allows you to change the curves and images displayed on a graph, and to define new curves and new images from existing data. The ability to read in new data will be available soon.
  • Add Text Label: You can add an arbitrary text label to a graph. One can control the font used for each label. Labels can be attached either to the graph's geometry (eg, legends) or to its coordinate system (eg, labeling objects).
  • Choose Graph Size: You can resize the currently selected graph to given dimensions (in pixels).
  • Duplicate Graph: Make an exact duplicate of the current graph.
  • Delete Graph: Permanantly remove a graph. The objects within the graph are not destroyed, however, and are still available from the Edit Graph window.
  • Merge Graphs: Selecting a graph from the hierarchical menu will cause the contents of that graph to be copied into the currently selected graph.
  • Hide Graph: This allows you to remove any graph from display on the POW canvas. The graph may be replotted later.
  • Replot Graph: This allows you to restore a previously hidden graph to the POW canvas. Replotting a graph will cause POW to recalculate the x and y limits of the graph to allow you to see all of the defined items on that graph; that is all the points of all the curves and all of the images will be visible.
  • Axes Transforms: Select the type of logarithmic/linear axes to use for the current graph. Any curves present will be remapped to the appropriate axes. POW will attempt to maintain the current axes bounds.
  • Tick Labels: You may choose decimal or Base 60/degree (WCS) formats for the axis labels on your graphs and for what shows up in the Coordinate tracker. "Base 60" axes only apply to graphs which contain images or curves with WCS coordinate information.
  • Grid Line Options: You can toggle the grid on or off and choose dashed and colored grid styles for the currently selected graph. More options are available from the Edit Graphs dialog box.
  • Preferences: Set default behaviors and appearance for POW, curves, images, and graphs. See Preferences.
fv5.5/tcltk/pow/EditGraphs.html0000644000220700000360000002145113224715127015372 0ustar birbylhea Edit Graph

Edit Graph

A POW Graph consists of a number of Curves and Images drawn within a given rectangular region. The Edit Graph item in the Edit menu brings about a dialog box from which one can control what objects are drawn, how they are displayed, and how the graph itself is drawn...

The dialog box consists of 3 major regions. The top portion controls the contents of the current (or new) graph. The box on the left lists the objects currently in the graph. The box on the right lists all the available objects which are not in the graph. In both boxes, the type of each object (image or curve) will be indicated in parentheses after the objects' names. The Add and Remove buttons in between allows one to move the selected objects between the two lists. The name of the graph being editted is given below the left box. This can be changed if one wants to create a new graph rather than modify the current one. The Edit Objects button under the right box opens up another dialog box which allows one to edit the data structures which define Curves and Images.

The second region, below the graph contents section, contains the editable display options for the graph and graph objects. It has a paned format. At its top are a series of labeled tabs. Click on one of the tabs to view and edit that set of options. Each tab and its options are described below...

  • Graph

    This pane contains the highest-level options affecting a graph's appearance. The first entry box contains the graph's title string. By default it is the graph name used internally by POW, but it can be any string or even blank. The entry boxes list, for both the X and Y axes, the Label to be written, the Min and Max values of the axis (actually, the lower-left and upper-right bounds of the graph's display region), the Units label of the values (printed within parentheses after the axis label), and the Size of the graph on the screen in pixels. Any or all of these may be NULL which tells POW to use the default values. In the case of the bounding box (Min/Max), default values will be determined by the minimum values required to display all the graph's contents. For Units, a NULL value will indicate not to list any units in the label axes. Clicking the Reset Min/Max button at the bottome sets all the bounding box values to NULL.

    Below the entry boxes are a set of buttons labeled Scaling. These activate logarithmic graphs. The first row of linear and log buttons cause each axis to be drawn in either linear or logarithmic format. This does not affect the data, just how the graph coordinates are interpretted and labeled. The Scale curve data to axes check button determines whether the curves in this graph will be converted to the same axis format. Do not check this if any of your curves already contain logarithmic values (instead of the true values) and you only need to change how the axes are displayed, not how the curves are plotted. You can control the logarithmic conversion of individual curve data from the Points and Lines panes.

  • Fonts

    This pane controls the appearance of text in the graph. One can independently set the font, size, style, and color of the Title, Axis Labels, Tick Labels, and default Text Labels. The Text Label value is used only for the initial text label. All subsequent labels inherit their values from the previous label.

  • Ticks

    This pane controls the appearance of the tick marks and associated grid lines. Use the slidebars to indicate approximately how many tick marks should be drawn (and labeled) on each axis of the graph. At the far left, no tickmarks will be drawn on each axis. At the far right, about 30 may be drawn. The X Ticks and Y Ticks options control whether the X and Y tickmarks are drawn inside or outside the graph's box and whether they are labeled on the left and bottom axes. The Tick Labels option selects between Decimal and Base 60 (degrees minutes seconds) numerical formats. Base 60 is only used when a graph contains WCS information. If the Grid Lines checkbox is selected, lines will drawn on the graph, tracing the path of each tick mark coordinate. One can control the Color and line Style (solid, dashed, etc) of these lines.

  • Points

    The checkbox at the top of this item indicates whether the individual points of the curve should be drawn. The points can be drawn as any of the 7 listed shapes. The size of the points (except Dot which is always 1 point) can either be fixed at a constant size indicated by the slidebar, or drawn with widths/heights indicating the X and Y error bars. If there are X/Y error bars but the points are drawn in a fixed style, the error bars will be indicated by horizontal/vertical lines centered on the point. Points can be Filled or just drawn in outline. Finally, select the desired color from the displayed colorbar. This can be a different color than selected in the Lines pane.

    At the bottom of the pane is a pair of LogX/logY checkbuttons. Checking these will cause this curve to have the logarithm of its data plotted instead of its true values. If the data is logarithmic already, leave these options unchecked, but select the appropriate Scaling mode in the Graph options (see above).

  • Lines

    The checkbox at the top of this pane indicates whether data points will be connected with a continuous line. The line can be of several patterned styles or widths. The points can also be connected directly (Normal) or in a stair-step pattern (Histogram). In the latter mode, the Fill Boxes option draws the histogram as a series of solid boxes instead of an outline. Finally, select the desired color from the displayed colorbar. This can be a different color than selected in the Points pane.

    At the bottom of the pane is a pair of LogX/logY checkbuttons. Checking these will cause this curve to have the logarithm of its data plotted instead of its true values. If the data is logarithmic already, leave these options unchecked, but select the appropriate Scaling mode in the Graph options (see above).

  • Image

    This pane controls the appearance of images. Most of the pane consists of a bunch of different colormaps. They are grouped in the same sequence as listed in the Color menu: smooth, continuous colormaps, followed by ramps, then the step functions. The Invert option will reverse the order of the colormap when turned on. The Scaling option controls how the colormap is applied to the image. For Linear scaling, each colormap level corresponds to a constant intensity range in the image. Square-Root scaling changes the mapping such that the intensity range covered by each color level increases as the square-root function, producing higher contrast at lower intesities. Logarithmic scaling uses the logarithmic function for colormapping, giving even more contrast at low intensities than sqrt. Histo Equalize scaling computes a histogram of the image and tries to distribute colors equally over the number of pixels. The Range entry boxes at the bottom list the intensity range over which the colormap should be applied. Initially, they will contain the full intensity range of the image. The Reset button resets these values to the full range of the image.

At the very bottom of the dialog box are 3 buttons. Apply will update the selected graph using the modified parameter values. The Reset button will reset the parameter options and object lists based on the currently selected graph (for when one either wants to revert to the original parameters, or if one selected a new graph, or if new objects were created). The Exit button closes the dialog box. Any changes will be lost if not Applyed before exitting.

fv5.5/tcltk/pow/EditObjects.html0000644000220700000360000000764213224715127015545 0ustar birbylhea Edit Objects

Edit Objects

The Edit Objects dialog box has much the same layout as the Edit Graphs dialog box. It is divided into 3 regions...

At the top of the dialog box are two list boxes. The box on the left lists all known display objects (curves and images). The box on the right lists all known data objects. The number following the data objects' names indicates the number of values contained within each object. (The NULL data object is used to specify no data for certain elements of Curve objects.) The name of the display object being editted is indicated by the entry box below the left box. New objects are editted by simply entering a unique name. (Note that curves and images are treated separately, so one can have both a curve and image with the same name.) The Edit Data button on the right currently does nothing. In a future release, one will be able to edit old and create new data objects.

The middle portion of the dialog box lists the parameters defining the selected object. Using the pair of radio buttons at the top of this region one can alternate (or convert) between editting the object as a Curve or Image...

  • Curve:

    A POW Curve is formed by specifying up to 4 data objects: X, Y, X-error, and Y-error. To assign data to the curve, highlight one of the data objects in the top right box and then click on the appropriate button in the curve parameter list. Either X or Y must be specified, but the others are all optional. If an X or Y data object is given as "NULL", POW will generate a simple integer count instead.

    A curve can contain WCS information which allows it to be plotted in celestial coordinates instead of pixels. Enter (or edit) the values at the bottom of the parameter list and select the WCS Info check box.

  • Image:

    A POW Image is created from a single data object; highlight the desired data object and click on the Data button. The NULL data object cannot be used for an image. The Units entry box lists the units of the array values (not the X/Y coordinates). A data object is one-dimensional, so the image needs to know how to convert the data into a 2-D array. This is done by entering the X and Y Dimensions of the image in the first pair of entry boxes. Below them are the 3 image scale parameters. Origin specifies the coordinates of the center of the bottom left pixel of the image. By convention, FITS images have an origin of (1,1) when specified in pixels. The Pixel Size specifies the linear scale of the pixels (in units/pixel) and Units specify the physical units used for the Orign and Pixel Size.

    An image can contain WCS information which allows it to be labeled in celestial coordinates instead of pixels. Enter (or edit) the values at the bottom of the parameter list and select the WCS Info check box. WCS information overrides the image scale parameters (origin, pixel size, and units).

At the bottom of the dialog box are 3 buttons. Create Object creates the indicated object. If the Object Name is unique, a new object will be created otherwise, it will replace the old version. (Note than a curve and image can have the same name and but will still be considered unique.) Creating/Editting an object does not immediately affect the graphs in which that object already exists, so it is necessary to update them manual from the Edit Graphs dialog box. Reload Info will reset the parameter list and update the object/data boxes with the current list of known objects. The Exit button closes the dialog box. Any changes will be lost if an object wasn't created before exitting.

fv5.5/tcltk/pow/File.html0000644000220700000360000000075313224715127014221 0ustar birbylhea The POW File Menu

The POW File Menu

There are two actions on the POW file menu:
  1. Print/Save Plot will call up the POW print controller window.
  2. Close Pow will shut down POW. Most applications that use POW will be unaffected by this and allow you to launch POW again later when needed.
fv5.5/tcltk/pow/HOWTO0000644000220700000360000000351413224715127013275 0ustar birbylheaThe only really tricky part about using POW from TCL is getting a pointer to your data passed to it. This must be done through the clientData argument when you call Tcl_CreateCommand for whatever command is going to read the data. The file readpha.c is an example in the current POW distribution. The routine for the command that's going to create/read the data will have the standard look for a TCL command written in C: #include "pow.h" int readpha(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]) { Now define a pointer to pointer to use to do the "pointer pass": int **databuff You'll also presumably have a pointer to the actual data you want to "create" in POW: void *imagebuff Now do whatever you need to to get imagebuff to point at the array you want to "create" in POW, and then: databuff = clientData; *databuff = (int *)imagebuff; You probably want to have your TCL command return the things that powCreateData is expecting (i.e. a data type and the number of elements in the array, something like: sprintf(interp->result,"%i %i", array_type, width*height); array type can be either a string or an integer: BYTE 0 SHORTINT 1 INT 2 REAL 3 DOUBLE 4 You can now do: eval [concat powCreateData mydata [readpha filename]] So the high level TCL commands which work now are: %powCreateData data_name data_type length %powCreateImage image_name data_name xoffset yoffset width height xorigin xinc yorigin yinc xunits yunits zunits %powCreateGraph graph_name curves images xunits yunits xlabel ylabel xdimdisp ydimdisp There are actually more, but they can all be accessed through the POW GUI, so I'm not going to describe them right now. fv5.5/tcltk/pow/Labels.html0000644000220700000360000000575013224715127014546 0ustar birbylhea Text Labels

Add Text Labels...

Users can add short text strings to a graph in a number of fonts, sizes, and styles. To add a label, select the graph to be used, then choose the Add Text Labels command in the Edit menu. The Annotations window will come up.

Type in the string to be created in the top entry box and select the appropriate display options. Only a small subset of commonly-used font families are included in the font listing. Click the color button to specify a color. (Note: For the first label created, the default font values found here are obtained from the Edit Graph/Set Default Options settings for Text Labels. For all subsequent labels, though, the values are inheritted from the previous label created.)

The Position entry boxes list the coordinates at which the label is to be placed; the position corresponds to the bottom left corner of the text string. The values are interpretted based on the following option.

The Attach To radiobuttons determine how the Position values are interpretted and how the text handled. The Graph option will make the label a graph object which will be placed at a fixed position relative to the graph but independent of the axes values (like the title or axis labels). The lower-left corner of the graph is position 0,0 and the top-right corner is 1,1. The label can be placed outside the graph as well as inside. Zooming has no effect on it, but resizing the graph will move the label so that its relative position is the same. This option is good for adding notes or legends to the graph. The Coordinates option will make the label a plotted object which will be placed according to the graph's axes. If the indicated position is not within the current bounds -- due to zooming or panning -- the label will not be displayed. This option is good for labeling objects in images or parts of curves. The Position values will be converted between these two coordinate systems when the option is changed.

The Add button creates a new label. The Delete button removes the current label from the graph. And the Apply button modifies the current label.

Once created, labels can be repositioned by dragging them with the left mouse button. If a label is attached to a graph's Coordinates and you drag it outside the graph, the label will disappear when dropped. The label still exists, but is just positioned outside the graph's axes range. Alter the axes to display the labels new position.

Double-clicking a label will bring up the Annotations window, if it doesn't already exist, with the label's information. When this window is open, a single-click is sufficient for selecting a different label for editting.

fv5.5/tcltk/pow/Makefile0000644000220700000360000000633713224715127014120 0ustar birbylheaHD_COMPONENT_NAME = tcltk HD_COMPONENT_VERS = HD_LIBRARY_ROOT = pow HD_LIBRARY_SRC_c = PowCanvCurve.c PowColormap.c PowCommands.c \ PowCreateCurve.c PowCreateData.c PowCreateGraph.c \ PowCreateImage.c PowCreateVector.c \ PowEventHandlers.c PowGrid.c PowInit.c PowUtils.c \ PowWCS.c Visu_colors.c Visu_generic.c Visu_Init.c \ Visu_lut.c Visu_shared_colors.c Visu_tkImgPict.c # unused: orbit.c PowDrvr.c readpha.c tclShared.c tkAppInit.c HD_CFLAGS = -I${TCL_DIR}/../generic -I${TK_DIR}/../generic \ ${XINCLUDES} ${HD_STD_CFLAGS} \ -DVISU_LIBRARY=\"${HD_LIB}/pow\" HD_INSTALL_LIBRARIES = ${HD_LIBRARY_ROOT} HD_SHLIB_LIBS = ${HD_LFLAGS} -l${CFITSIO} -l${TCL} -l${TK} ${XLIBS} ${CURL_LIB} HD_ADD_SHLIB_LIBS = yes HD_INSTALL_SHELL_SCRIPTS = POWplot HD_INSTALL_HEADERS = pow.h tkpict.h HD_INSTALL_EXTRA = install-pow-extras default: build-libpow all: default publish include ${HD_STD_MAKEFILE} # Get cfitsio source files and prepend ${CFITSIO_DIR} prefix to each filename. CFITSIO_OBJ_TMP = ${shell if [ -f ${CFITSIO_DIR}/Makefile ]; then ${MAKE} -f ${CFITSIO_DIR}/Makefile cfitsioLibObjs; fi | grep buffers} CFITSIO_OBJ = ${shell if [ "x${CFITSIO_OBJ_TMP}" != "x" ]; then echo ${CFITSIO_OBJ_TMP}; fi | sed "s: : ${CFITSIO_DIR}/:g" | sed "s:^:${CFITSIO_DIR}/:"} ${CFITSIO_OBJ}: @for file in ${CFITSIO_OBJ}; do \ if [ ! -f $$file ]; then \ echo "Cannot find CFITSIO object $$file"; exit 1; \ fi; \ done # Get wcslib source files and prepend ${WCSLIB_DIR} prefix to each filename. WCSLIB_OBJ_TMP = ${shell if [ -f ${WCSLIB_DIR}/makedefs ]; then cd ${WCSLIB_DIR}/C; ${MAKE} echo_modules FLAVOUR=${WCSFLAV} WCSTRIG=WRAPPER; fi | grep fitshdr} WCSLIB_OBJ = ${shell if [ "x${WCSLIB_OBJ_TMP}" != "x" ]; then echo ${WCSLIB_OBJ_TMP}; fi | sed "s: : ${WCSLIB_DIR}/C/:g" | sed "s:^:${WCSLIB_DIR}/C/:"} ${WCSLIB_OBJ}: @for file in ${WCSLIB_OBJ}; do \ if [ ! -f $$file ]; then \ echo "Cannot find WCSLIB object $$file"; exit 1; \ fi; \ done wcslib-obj-remove: rm -f ${WCSLIB_OBJ} ${WCSLIB_DIR}/C/libwcs-PIC.a build-libpow: @if [ "x${CFITSIO_OBJ}" = x ]; then \ echo "CFITSIO_OBJ macro is empty"; exit 1; \ fi @if [ "x${WCSLIB_OBJ}" = x ]; then \ echo "WCSLIB_OBJ macro is empty"; exit 1; \ fi ${HD_MAKE} pow HD_LIBRARY_ROOT=pow \ HD_LIBRARY_OBJ="${HD_LIBRARY_SRC_c:.c=.${OSUF}} ${CFITSIO_OBJ} ${WCSLIB_OBJ}" POW_TCL = html_library.tcl notebook.tcl Notifications.tcl \ PowCmdsClass.tcl powEdit.tcl powImgProbe.tcl \ powMovie.tcl POWplot.tcl powProfile.tcl powRgn.tcl \ powRuler.tcl powScript.tcl pow.tcl RegionList.tcl \ Region.tcl Shape.tcl visu_widgets.tcl tclIndex \ powXRange.tcl POW_HTML = About.html Blinking.html Color.html Contours.html \ DefaultOptions.html EditGraphs.html Edit.html \ EditObjects.html File.html Labels.html \ Moving_Graphs.html Options.html Overview.html \ POWAPI.html Probe.html Profile.html Regions.html \ ROI.html Ruler.html Scripting.html Tools.html \ PrintControl.html XRange.html POW_EXTRAS = mhh7.gif stretcharrow.xbm # pow.def pow.dsp pow.dsw powMacResource.r pow.pch pow.sit.hqx install-pow-extras: @for extra in ${POW_TCL} ${POW_HTML} ${POW_EXTRAS}; do \ ${HD_INSTALL} $$extra ${HD_LIB}/pow/$$extra ${HD_CP_P}; \ done fv5.5/tcltk/pow/Makefile.develop0000644000220700000360000000160213224715127015543 0ustar birbylheaCFLAGS = -g -I../local/include/itcl -I../visu-2.0/src -I../fitsTcl/cfitsio LDFLAGS = -g -L. -lpow -L../fitsTcl/ -lcfitsio -L../visu-2.0/src -lVISU2.0 -L../local/lib/itcl/ -ltk4.1i -ltcl7.5i -lX11 -lm SRC = PowCommands.o \ PowCreateCurve.o PowCreateData.o \ PowCreateGraph.o PowCreateImage.o \ PowCreateVector.o PowEventHandlers.o \ PowInit.o PowUtils.o \ readpha.o all: libpow.a libpow.so $(CC) $(CFLAGS) tkAppInit.c -o powwish $(LDFLAGS) libpow.a: $(SRC) rm -f libpow.a ar r libpow.a $(SRC) libpow.so : $(SRC) rm -f libpow.so ld -shared -o libpow.so $(SRC) install: libpow.a libpow.so cp libpow.a ../local/include cp libpow.so ../local/lib cp pow.tcl ../local/lib clean: rm -rf *.o *~ powwish *.a *.so .f.a: $(FC) $(FFLAGS) -c $*.f $(AR) $(ARFLAGS) $@ $(> TAGS rm CTAGS powLibObjs: @echo ${OBJECTS} orbit.o # This target actually builds the objects needed for the lib in the above case objs: ${OFILES} orbit.o .c.o: ${CC} -c ${CFLAGS} ${DEFS} ${IFLAGS} $< fv5.5/tcltk/pow/Moving_Graphs.html0000644000220700000360000000271513224715127016105 0ustar birbylhea POW Graph Movement

POW Graph Movement and Stretching

Any graph in POW can be moved to any position in the main POW window. Just left click and drag either the graph's Title at the top of the graph or the yellow bounding box of the currently selected graph. Clicking anywhere inside a graph's region (the area within the yellow box when selected) will select the graph. You may drag your cursor outside the POW window on your desktop (at least it works with the X window managers we've tried so far).

To change the displayed size of a graph, left click and drag the double headed arrow at the lower right corner of the graph. This preserves the aspect ratio of the plot by default. To independently change the length of the X or Y axis, hold down the 'shift' key while dragging the mouse." You can also set the graph size directly using the Choose Graph Size item from the Edit menu. Note: resizing images to large dimensions can rapidly consume all of the memory on your machine, resulting in lots of swapping and/or crashing. To zoom in on just a portion of an image, see Zooming in on a Region of Interest.

fv5.5/tcltk/pow/Notifications.tcl0000644000220700000360000001744013224715127015772 0ustar birbylhea######################################################################## # # class: Notifications # # purpose: Provide a message distribution center for special events. # Any number of objects/users can ask to be notified when # a given event occurs. # # usage: To create/access the notification center: # set newObj [gNotifications] # or # set oldObj [gNotifications default] # where the first example creates a new notification center # and the later returns pre-existing one of an unknown # name (or creates a new one if one doesn't already exist). # In most cases, an application should have only one # notification object, so either create one and store it in # a global variable, or always access it through the "default" # method. # # To send a message: # NotificationObj postMessage object message ?args? # where "object" is the object to which "message" applies, # usually the sending object. "message" is a string # describing the event which has just taken place... # eg, "graphHasFinishedDrawing". "args" contains extra # information observers may use. # # To register to receive messages: # NotificationObj addObserver observer cmd object message # where "observer" is the object (or function name) to be # called when "message" is posted by (or for) "object". "cmd" # is either the observing object's method to be used or a # extra/dummy argument passed to an observing function. An # observing object needs to implement the method: # body observer::cmd { object message opts } {...} # while an observing function implements the procedure: # proc observer { cmd object message opts } {...} # where opts is an optional list of additional information # sent by the object. # # To unregister: # NotificationObj removeObserver observer ?object? ?message? # where "observer" is the same as before. An observer can # unregister for all messages or just ones from particular # objects and messages. # ####################################################################### itcl::class Notifications { constructor {} {} destructor {} public { method addObserver { observer cmd object message } method removeObserver { observer {object ""} {message ""} } method postMessage { object message args } method registerRemote { rNotes } { set remoteNotes $rNotes } } private { variable lookup variable remoteNotes "" method locateObserver { observer observerList } } } ####################################################################### # # gNotifications ?default? # # Use this procedure to create/access instances of Notifications in # the global namespace # ####################################################################### proc gNotifications { args } { if { [llength $args]==1 && [lindex $args 0]=="default" } { set args "" set gNote [lindex [itcl::find objects ::* -class Notifications] 0] if { $gNote != "" } { return $gNote } } return [uplevel #0 Notifications #auto $args] } ######################################################################## # # addObserver cmd object message # # Use this method to register an object/procedure as an observer for # a particular object/message # ######################################################################## itcl::body Notifications::addObserver { observer cmd object message } { set object [string trimleft $object :] if { $cmd=="-" } { set cmd $message } if { $remoteNotes != "" \ && $object != "" && $object != "*" && [itcl::find object *::$object] != "" \ && [$object isa DistantObject] && $message != "connectionHasClosed" } { # Looking for a message not sent by a DO, so pass registration # to remote Notification center. $remoteNotes addObserver $observer $cmd $object $message return } if { [info exists lookup($message,$object)] } { set currentObservers $lookup($message,$object) if { [locateObserver $observer $currentObservers]==-1 } { lappend currentObservers [list $observer $cmd] } } else { set currentObservers [list [list $observer $cmd]] } set lookup($message,$object) $currentObservers } ######################################################################## # # removeObserver observer ?object? ?message? # # Use this method to remove an object/procedure from receiving # certian notifications # ######################################################################## itcl::body Notifications::removeObserver { observer {object ""} {message ""} } { set object [string trimleft $object :] if { $remoteNotes != "" \ && $object != "" && $object != "*" && [itcl::find object *::$object] != "" \ && [$object isa DistantObject] && $message != "connectionHasClosed" } { # Looking for a message not sent by a DO, so pass registration # to remote Notification center. $remoteNotes removeObserver $observer $object $message return } if { $object!="" && $message!="" } { if { ![info exists lookup($message,$object)] } return set currentObservers $lookup($message,$object) set idx [locateObserver $observer $currentObservers] if { $idx == -1 } return set lookup($message,$object) [lreplace $currentObservers $idx $idx] } else { foreach key [array names lookup] { foreach [list o m] [split $key ","] {} if { ($object=="" || $object==$o) && \ ($message=="" || $message==$m) } { set currentObservers $lookup($key) set idx [locateObserver $observer $currentObservers] if { $idx != -1 } { set lookup($key) [lreplace $currentObservers $idx $idx] } } } } } ######################################################################## # # postMessage object message # # Use this method to send a message to all observers # ######################################################################## itcl::body Notifications::postMessage { object message args } { set object [string trimleft $object :] ########### # # Build list of ... # set allObservers {} # # ... observers of fully-resolved object-message, ... # if { [info exists lookup($message,$object)] } { eval lappend allObservers $lookup($message,$object) } # # ... observers of all messages from this object, ... # if { [info exists lookup(*,$object)] } { eval lappend allObservers $lookup(*,$object) } # # ... observers of this message from all objects # if { [info exists lookup($message,*)] } { eval lappend allObservers $lookup($message,*) } # # Now send notifications to each observer # foreach observer $allObservers { foreach [list obs cmd] $observer {} # DebugStr "... notifying \"$obs\" of $message" if { [catch {$obs $cmd $object $message $args} res] } { # DebugStr "*** Notify error: $obs $cmd $object $message" # DebugStr "$res" } } } ######################################################################## # # Private methods... # itcl::body Notifications::locateObserver { observer observerList } { set idx 0 foreach oldObserver $observerList { if { $observer == [lindex $oldObserver 0] } { return $idx } incr idx } return -1 } fv5.5/tcltk/pow/Options.html0000644000220700000360000000022713224715127014771 0ustar birbylhea The POW Options Menu

Superceded by Preferences dialog and Edit menu. fv5.5/tcltk/pow/Overview.html0000644000220700000360000000373513224715127015153 0ustar birbylhea POW help

POW Help

Overview

The main displayed object in POW is a graph. A graph is defined by a list of curves and images that belong to it. When a graph is selected (by clicking anywhere within its bounds) a thumbnail version of the whole graph will be displayed in the scope window at the upper right showing all of the curves and images that belong to that graph. The displayed version of the graph, in the main POW window, lower left, will only display those members of the graph that fall within the X and Y ranges for the current region of interest.

The most important thing to remember when using pow is that all actions, such as dragging out a region for GTI selection in Xselect, or choosing a region of interest to zoom in on refer to the currently selected graph. The currently selected graph is surrounded by a yellow box in the main POW window, it is displayed in the scope window, and its name is shown in the yellow box above the scope. So remember to click on the graph you're interested in before dragging your mouse.

Menu

  • File: Printing; Closing POW
  • Edit: Changing the parameters of a graph, and creating new graphs.
  • Color: Modifying image colortables and screen colormaps.
  • Tools: Blinking/animation, creating region files and image contours, analyzing images and create X ranges.
  • Zoom: Zooming in on a Region of Interest
  • Replot: Replot or unzoom the current selected plot/image to zoom factor of 1.
    • fv5.5/tcltk/pow/POWAPI.html0000644000220700000360000010567213224715127014347 0ustar birbylhea 
    
POW works in terms of objects (although at the moment, it's not written 
using object-oriented TCL).  Each of these objects has a name (just an 
ASCII string).  Once an object is "constructed", you use the name
to refer to it in the various things you want to do to it ("methods").
The main objects are:

PowData - this object is an array (in the C sense) in memory somewhere
          along with info on data type and the length of the array.
          At creation, you can specify that POW should make it's own copy
          of the data, allowing you to "free" your copy, or you can save
          space by allowing POW to use your copy of the data, just don't
          free or change it unless you destroy the PowData object first.

PowVector, PowImage - these are your choices for what you can create using
          your PowData, they give "physical" meaning to the data by specifying
          units and, for images, dimensions.  You can make any number of 
          Images and Vectors from one chunk of Data, and you can specify 
          offsets so as to use only part of the Data.

PowCurve - This is a collection of 1 to 6 vectors which represent a curve in
           space and its associated errors. Currently, nothing is done
           with the z and z-error vectors, but suggestions are welcome.

PowGraph - This is the only *displayed* object in POW.  I.e. you can display
           your Images and Curves only by creating a Graph with them as 
           members, or by plotting them on an existing Graph (at which
           point they become part of that Graph).  One Image or vector
           can, of course, appear in any number of Graphs.  


The TCL interface:

*arguments in angle brackets are optional


"Constructors"
powSetupColormap  toplevel free_cells ?force_cmap? ?options? -
	You should call this to create the first toplevel window for your
	application unless you really want to do your own colormap 
	management.  This proc will use the default colormap if it can
        allocate enough colors or will allocate a Private pseudocolor colormap
        with an	attempt to minimize flashing.  If this fails to find any
	pseudocolor visuals, it will use the default colormap and disable
        pseudocolor images in POW.

	toplevel - this is the name of the toplevel you want to create.
	           it should probably be the first toplevel your application
                   creates (e.g. .mytop)  and all subsequent toplevel creation
                   statements should include a "-colormap .mytop" option.

	free_cells - the number of colors your application will need in 
	             addition to what POW allocates for itself.  If you get
	             BadColor errors (or the like) in your application, try 
	             making this number bigger.  If you keep getting a Private
                     colormap when your Default colormap is full, try making 
	             this number smaller.
	
	force_cmap - Forces different colormap behaviors.  You might want 
                     to give your users a way to set this themselves.: 
	           0 - Default behavior.  I.e. choose the "best" colormap.
	           1 - Force POW to setup a new private pseudocolor colormap 
                       (very safe)
                   2 - Force POW to use truecolor mode (very safe, but 
                       looks bad on low color displays and runs slower than
                       pseudocolor).  Note: this will cause powSetupColormap
                       to look for a truecolor visual; if it can't find one,
                       it will allow the main Tk code to pick a visual,
                       but POW will still use "truecolor mode" (i.e. the
                       Tk photo widget) to display images.
                   3 - Force use of the screen default colormap. This should
                       be reasonably safe now, but often won't be what you
                       want.
                       
 
	options - a string of extra options to hand to the toplevel creation
                  command, if you need them.
	
	See comments under powInit for more details.


powInit ?XColormapWindow? ?container? ?powGUI? - creates the .pow toplevel 
	window, all the user interface buttons and the .pow.pow
        canvas.  The second optional argument is the pathname of a 
	container window for POW if you want to embed POW in your own
        toplevel (only works for Tcl/Tk8.0 and later versions). 
	The first optional argument is the name of a window in your
	application and tells POW to use the same X colormap as that
        window;  this will allow your user to reliably see both POW
        and your application in the proper colors at the same time.
        Note, if you give an argument to powInit, that window should 
	have a pseudocolor visual with at least 60 free read-write 
	colorcells (call powSetupColormap first) or POW will disable 
        pseudocolor images.  The third argument indicates wether you 
        want POW to wrap its main canvas in an enduser GUI. Unless
        you're embedding POW in a specialized application, you'll
        want to leave this at the default of 1; a value of 0 removes
        the GUI.

	If you call 'powInit none' (or with no argument) pow will handle 
	its own colormap needs, but if it creates a private colormap, you 
	will see serious flashing between your application's windows and 
	the POW window.

	Usually, the window you specify for powInit would be the toplevel
        window for your application and you should use powSetupColormap
        to avoid excessive flashing and Xlib induced crashes.  Make sure 
	you create any other toplevels with the same colormap. Unfortunately,
        Tk has a stupid default behavior for picking the visual of a 
        new toplevel when it's colormap is specified, so it's recommended
        that you use powToplevel to create all your toplevels (sorry folks,
        this one's not my fault). Ok, since this is probably confusing, 
  	here's an example.

	Suppose (for argument) your application uses 10 colors (for 
	backgrounds highlights, etc) and your application's main window
	is '.mytop'.  And you want the background of your application to
        be pink and you want it to be 100 pixels wide.  
	When you create .mytop instead of calling 'toplevel', instead do:

	powSetupColormap .mytop 10 0 "-background pink -width 100"
         
        Invoke POW with:

	powInit .mytop

        If you create any other toplevel windows, be sure to create
	them with:

        powToplevel .mydialogbox .mytop

	If you need to pass other options to "toplevel", put them 
        all in one string like:

        powToplevel .mydialogbox .mytop "-class \"My Extra Window\" -bg blue"

powToplevel topwin refwin ?option_string? -
	This is a replacement for the Tk toplevel command.  The Tk toplevel
        command with a "-colormap" argument but no "-visual" argument 
        *doesn't* use the visual of the given colormap to create the new 
        window; instead it uses the screen default visual and then dies
        if they're not compatible.  Why? Who knows? 

  topwin  The name of the toplevel you want to create.

  refwin  The window whose colormap you want to use.

  option_string  Any other options you want to pass to the "toplevel" command.
          This needs to be a single string.

        If you don't want to call powToplevel, doing this yourself is simple.
        Here's the code for the powToplevel proc:

proc powToplevel {topwin refwin {options ""}} {
#this implements what *should* be default behavior.  Apparently the evil
#of Xlib colormap handling is contagious.

    eval "toplevel $topwin -colormap $refwin -visual \"[winfo visual $refwin] [winfo depth $refwin]\" $options"

}
       


powCreateData data_name data_pointer data_type length ?copy? -
           This "constructs" a PowData object.  The other ways
           to create PowData at present are with the powCreateVectorEN
           or the powCreateDataFromList commands, see below.

  data_pointer  This argument will probably be the return value from either:
                $fitsfile load image
                   or
                $fitsfile load column
                See fitsTcl documentation for details.  Or you can write your
                own TCL command to make data.  Just have it return a void
                pointer formatted with:
                sprintf(interp->result,rstring,"%p",(void *)dataptr);

  data_type     This is one of the strings (or an integer):
                  "BYTE"     or  0  or   8                   1 byte
                  "SHORTINT" or  1  or  16                   2 bytes
                  "INT"      or  2  or  32                   4 bytes
                  "REAL" or "FLOAT" or 3 or -32              4 bytes
                  "DOUBLE"   or  4  or -64                   8 bytes

                Note: 8 byte integers are not supported at this time

     
  copy          If copy is a positive integer, POW makes its own copy of the 
                data array and uses that, freeing it when the object gets
                destroyed.  If copy is zero, POW uses the supplied
                data_pointer directly (no copy), but does not try to free
                it when destroyed.  If copy is negative, POW takes ownership
                of the data_pointer, using it directly and freeing it when
                the object gets destroyed.  In this last case, the
                data_pointer *must* have been allocated using TCL's
                ckalloc() function (always true for data from fitsTcl). 
                The default value is 0.


powCloneData new_data_name old_data_name ?offset? ?length? ?copy?
        This creates a new PowData object from an existing PowData object.
        !!Use this function with caution unless you are specifying 
        a copy flag > 0 or you could wind up with POW Data objects that
        point to invalid areas of memory if you destroy one of the 
        partners of the clone but not the other!! 
       
        Returns the length of the new POW Data object.

  offset    Specifies an offset to the starting point of the data
            in memory. Default is 0.

  length    How much of the old data do you want to use?  If you specify
            "NULL" the new data will have the same endpoint as the
            old data.  If you specify a length that ends beyond the end 
            of the previous data, the length will be adjusted to match
            the endpoint of the old data. Default is "NULL".

  copy      If copy is a positive integer, POW makes a new copy of the 
            old data array and uses that, freeing it when the object gets
            destroyed.  If copy is zero, POW uses the old data pointer
            (plus offset) directly (no copy), and does not try to free
            the memory when the new data object is destroyed.  If copy is 
            negative, POW will flag the new_data_name as the "owner" of
            the data array so destroying the old_data_name will not
            free the associated memory, but destroying the new_data_name
            will.  If you specify copy < 0 and offset != 0, powCloneData
            will return an error.  The default value of copy is 0.

powCreateDataFromList data_name list_o_data ?stringflag? -
	This creates a PowData object using the contents of a TCL list.
        The data object will be of type DOUBLE unless stringflag is
        is Yes.  String data should only be used as the "z" vector
        of a PowCurve object, in which case, the specified string will
        be plotted at the position given by the corresponding x and y
        values.

powRegisterData powdata_pointer
        If you have an application that creates it's own PowData objects (like
        the LHEA orbit library or the internal routines in TAKO), you must
        "register" them in the main PowData hash table in order to use
        them in plotting functions.  Naturally, if the PowData objects
        aren't properly or fully created, you could run into trouble.
        The pointer is a string created the same way as described above for 
        the data_pointer argument to powCreateData, except that it should
        be a pointer to a PowData structure rather than to a simple array.

powCreateVector vector_name data_name offset length units - 
           Creates a PowVector. If length is "NULL" uses the length
           of the Data.

powCreateVectorEN vector_name data_name length start increment units -
           Creates a vector and the data to go with it.  This is nice
           for generating test data among other things.  You *can*
           make a PowImage using the data this generates, by the way.
           (EN stands for Ex Nihilo)

powCreateImage image_name data_name xoffset yoffset width height xorigin \
xinc yorigin yinc xunits yunits zunits - 
           Creates a PowImage.  The xorigin and xinc arguments are the origin
           and pixel size in the units specified in the xunits and yunits 
           arguments.

powCreateCurve curve_name x_vector x_error y_vector y_error ?z_vector z_error?
         - Creates a PowCurve (displayable).  All but one of the component
           vector arguments can be the string "NULL" and POW will deal with 
           it in a hopefully sensible default manner. The length of the 
           curve will be the length of the first non-null vector (I might
           change this to be length of the shortest vector present).
           I'm also thinking of allowing scalar errors indicated by an 
           "=" sign in the argument (but this isn't done yet).

	   POW curves are now implemented with a new canvas item type.
	   For a curve named ACURVE displayed on a graph named BGRAPH,
           the powCurve item has a tag "ACURVEBGRAPH".  powCurve supports
           most of the options available for the Tk native "line" type.
           So to change the fill color of ACURVE to blue and make it a dashed
           line (5 pixel dashes) do:

           .pow.pow itemconfigure ACURVEBGRAPH -fill blue -dash 5

           The only use of z_vector so far is if the z_vector is
           created from STRING type data (e.g. using powCreateDataFromList),
           then the strings will be printed at the positions given by the
           corresponding x and y elements.


powCreateGraph graph_name curves images xunits yunits xlabel\
         ylabel ?xdimdisp ydimdisp xmin ymin xmax ymax?	 -
	 This is the main one that actually draws on the .pow.pow canvas. 
	 See discussion of powStartNewRow below to see how POW decides 
	 where to place incoming graphs.  Some details (hopefully the
	 rest is self-explanatory):

  curves, images - these are Tcl "lists" of PowImages and PowCurves to plot
  
  xunits, yunits - These are the physical units associated with an axis
         and will be printed next to the label.

  xlabel, ylabel - An optional label for each axis.  The y-axis label will
         be printed horizontally at the top of the y-axis since the Tk 
         canvas does not allow rotated text at this time.
  
  xdimdisp, ydimdisp - the "maximum size" for the display of the graph in
          screen pixels. The graph will be shrunk or expanded from its
          "natural" size to fit into an area of the canvas of this requested
          size.  If "NULL" is passed, a default value will be used.

  xmin ymin xmax ymax - the bounding region for the displayed area of a 
          graph.  These are in the units of each respective axis.  Parts
          of images or curves falling outside this box will not be plotted.
          Each of these arguments can be a list if more than one y or x axis is
          present.

powGraphOptions graph_name option value ?option value option value ...? -
	This function was added to allow easy customization of several
        (more every day :) additional options that would have been too 
        unweildy to add to the already too long powCreateGraph call.
        Specify as many option value pairs as you like.  Boolean values
        should have values of Yes/No if one wants POW's menus to properly
        reflect the new values.  In addition to all of the arguments to
        PowCreateGraph, current options are:
	
	bgcolor - A background color for the whole graph
	
	xmargin - The amount of space around a graph (in pixels by default)
	ymargin - This will only affect subsequent operations on the graph
                  (chain alignments, replottings, etc.), it doesn't move
                  the graph immediately.

        handletext - Change the text that normally says:
	           "Select/Move: graphname"
        handleanchor - Change the anchor point of the handletext. Default
                   is "sw".
        handleposition - Change where on the graph's bounding box the 
                   handle is anchored to.  Choices are:
	           t - midpoint of top
                   l - midpoint of left side
                   b - midpoint of bottom
                   r - midpoint of right side
                   Combine to get corners.  Default is "tl".

        xNumTicks   - An integer number used to indicate how many ticks to
                      place on the X axis.  3-6 are reasonable values.
        yNumTicks   - An integer number used to indicate how many ticks to
                      place on the Y axis.  3-6 are reasonable values.
	xTickLength - 4 element list indicating how long to draw the x
                      tick marks on each of the 4 sides of the graph.  Order
                      is {left right top bottom}.  Negative values cause
                      tickmarks to be drawn inside the graph box.
	yTickLength - Same for y tick marks.
	xLabelTicks - 4 element boolean list indicating whether the x tick
                      marks should be labeled along each side of the graph.
                      Order is {left right top bottom}.
	yLabelTicks - Same for y tick labels.
        xTickScal   - Scaling method for the X tick marks.  Valid values
                      are "linear", "wcs" (for celestial coordinates/right
                      ascension), or "log" (for logarithmic scaling).  Tick
                      marks and labels will be drawn accordingly.  WCS scaling
                      occurs only if WCS information exists for the graph.
                      Logarithmic scaling *does not* affect the drawing of
                      curves (ie, curve data are assumed to be in logarithmic
                      format).
        yTickScal   - Same for y ticks.  WCS scaling assumes declination
                      values for the y axis, though.
        GridLines   - A boolean value indicating whether to draw grid lines
                      connecting the graph's tick marks
        GridColor   - The color of the grid lines
        GridDash    - Dash value of the grid lines.  Formats are:
                        " "    - Solid line
                        "10"   - 10 pixel dashes and spaces
                        "15 5" - 15 pixel dashes, 5 pixel spaces
                        "15 10 5 10" - Dash-dot
                        etc.
        useSixties  - A boolean value indicating whether to attempt to use
                      base 60 tick marks (works only with WCS data).

powSetCurveOptions graph curve ?option value option value ...? -
        This function allows one to set the display parameters for a curve
        in the indicated graph.  If this function is not called *prior* to
        creating the graph, a curve will be assigned default values.  When
        called after the graph is created (and curve plotted), this function
        will update the appearance of the curve in both the main graph and,
        if it is the current graph, the scopebox.  The allowed options and
        values (boolean values should be Yes/No) are:

           Option Name    Value Type    Option Meaning
             pDisp     -->  boolean  -->  Display Points?
             pShape    -->  string   -->  Point shape (Cross, Diamond, Box,
                                             Octagon, Triangle, "Inv. Triangle")
             pSizeErr  -->  boolean  -->  Draw point the size of errorbars?
             pSize     -->  integer  -->  Size of point
             pFill     -->  boolean  -->  Fill in point, if an outline
             pColor    -->  color    -->  Color of points (any color name
                                             or #RRGGBB value)
         	       	    	     	  
             lDisp     -->  boolean  -->  Display line?
             lStyle    -->  dash     -->  Dash style of line (" " is solid, 
                                             "20" is 20-pixel dashes,
                                             "15 10 4 10" is Dash-dot, etc)
             lWidth    -->  integer  -->  Width of line
             lStep     -->  boolean  -->  Draw line as histogram?
             lBoxFill  -->  boolean  -->  Fill histogram boxes?
             lColor    -->  color    -->  Color of line (any color name
                                             or #RRGGBB value)

        If no option/value pairs are given, this function will return all the
        defined options.  If the curve has been drawn already, all the options
        will be defined.

powSetImageOptions graph image ?option value option value ...? -
        This function allows one to set the display parameters for an image
        in the indicated graph.  If this function is not called *prior* to
        creating the graph, an image will be assigned default values.  When
        called after the graph is created (and image plotted), this function
        will update the appearance of the image in both the main graph and,
        if it is the current graph, the scopebox.  It will also update a
        colorbar (or if changing a colorbar option, the original image).
        The allowed options and values (boolean values should be Yes/No) are:

           Option Name    Value Type    Option Meaning
             colormap  -->  string   -->  Which colormap to use
             invert    -->  boolean  -->  Invert colormap?
             scale     -->  string   -->  Scaling law to use to create the
                                             colormap (linear, sqrt, log)

        If no option/value pairs are given, this function will return all the
        defined options.  If the image has been drawn already, all the options
        will be defined.


"Destructors"

powDestroyX  Xname  - Destroys the named POW Object.  "X" can be:
                      Graph, Curve, Image, Vector, or Data.  Be careful,
                      don't destroy a low-level object (e.g. data) before
                      destroying a high-level one that depends on it (e.g.
                      Graph or Curve); the destructors don't (yet anyway)
                      search through all objects to handle these dependencies,
                      it's up to you to keep track of them if you need to.
                      The POWData destructor *will* free the associated 
                      memory if the Data object was created with the 
                      copy flag set.


"Methods" 

powPlotCurves graph curves ?canvas?- adds the list of Curves to an existing
                                     Graph on the Canvas (default .pow.pow)

powAddCurves graph curves - adds the list of Curves to an existing Graph,
                            updating the scope box as necessary

powPlotImages graph images - adds the list of Images to an existing Graph

powMagGraph graph xMagstep yMagstep - resize a Graph to the given X and Y
              magsteps (magstep = 1 is the "natural" size of the graph).
              Magsteps can be any real value and X and Y may be different.

powStretchGraph graph xFactor yFactor - shrink or grow a Graph by the given
                 X and Y factors.

powStretchGraphToSize graph xDim yDim - Set the size of the Graph to the
                 given X and Y dimensions (in pixels).

powStartNewRow - POW displays incoming graphs are placed to the right
                 of all existing  material in the current "row".
	         A "row" is defined by an (invisible) line on the graph.
                 Initially this boundary line is 10 pixels from the
                 top of the canvas.  powStartNewRow moves this line to
                 just below all material currently displayed on the
                 canvas.  To make a 3x2  "grid" of graphs do:

	         %powCreateGraph graph1 ...
	         %powCreateGraph graph2 ...
	         %powCreateGraph graph3 ...
                 %powStartNewRow	
	         %powCreateGraph graph4 ...
	         %powCreateGraph graph5	 ...
	         %powCreateGraph graph6	 ...
                  
                 If the end-user moves or resizes something during
                 this process, you won't get a strict rectangular
                 grid, but new graphs will not land on top of existing
                 ones.


Note:  %x and %y return cursor positions in X coordinates, to turn
       these into canvas coordinates, use '.pow.pow canvasx %x' etc.


General Interface Concepts

The general way for a developer to get back info from
his users would be to bind the left mouse button on the .pow.pow
canvas to whatever you want it to do (the only things on the canvas
that are currently bound to the left mouse button are the "purple"
handles, so this should be safe).  Once you've got a coordinate (or
set of coordinates) use '.pow.pow canvasx' and 'powCanvasToGraph graph
X' to find out what physical coordinates your user is interested in.
powWhereAmI can tell you which graph they appear to be inside of if
you need to know that easily.

If you set the global variable powClickCallback, <ButtonPress-1>, 
<Double-Button-1>, <ButtonPress-2>, or <ButtonPress-3> events on the
main POW canvas will fire your callback with the arguments "graphname
x y binding" where: 

graphname - is the graph the user clicked inside of, if they click outside of
            all graphs, nothing happens
x and y - are the graph (i.e. "physical") coordinates of the point they 
          clicked.
binding - is the X event which fired the callback currently the only strings
          returned are "B1", "B2", and "B1D" (for double clicking button 1)
          but if you'd like to see more bindings,  let me know ("B3" is 
	  currently in use for Region of Interest zooming).

If you set the global variable powPreScrollCallback or powPostScrollCallback,
when the user manipulates a scrollbar on the main .pow.pow canvas,
your callback will be fired with the same arguments as would be
recieved by the function specified in a '-command' argument to the
scrollbar creation command.  See the Tk scrollbar documentation 
for details.  The "Pre" form will fire your callback *before* the
.pow.pow canvas is scrolled and the "Post" form will fire *after*.
Combinations of the two should hopefully allow any custom behaviors
you want.

POW has general canvas and/or image bindings for changing the
colortable of an image and for dragging out a Region of Interest
(ROI).  By default, these are bound to B1 and B3 respectively (on 2
button mice under Windows these are the two available buttons).  If
you need to move these bindings to other buttons (to make way for your
application's own behavior) you can set $powLutButton or $powROIButton
to a different number after loading libpow.so but before calling
powInit.  You can also disable either function entirely by setting 
the corresponding variable to "0" or "NULL". For example, to move
colortable "diddling" to button 2 and disable ROI dragging do:

load libpow.so
set powLutButton "2"
set powROIButton "0"
powInit .someWindow


powGraphToCanvas graph x y ?canvas? -  takes physical coordinates
             and returns a two element list giving the corresponding position
	     on the specified canvas (.pow.pow by default).

powCanvasToGraph graph x y ?canvas? - takes a canvas coordinate 
             and returns the corresponding physical coordinates.
             Optional argument specifies the canvas (.pow.pow by default). 

powWhereAmI x y - takes an (x,y) pair of canvas coordinates and returns
             which graph (or subgraph) they are inside of. If they are outside
             of all graphs, returns "NULL".

powFindCurvesMinMax curves X|Y|Z - takes a list of curves and an axis 
            (X,Y, or Z) and returns the minimum and maximum values.


Provided Interface Routines

There will be more of these as I get feedback on what people need/want.

powDragRange X|Y tag color callback - This will set up a binding on the
left mouse button so that the user can click and drag a range in either
Y or X for the *selected graph*.  He will see a line joining the current
cursor position and the start position.  When he releases the LMB, all
of the graph points that fall in the selected range will be tagged
with the "tag" argument and will appear with the chosen "color".  The
"callback" routine will be called with arguments graphname, X0 and X1 
(or Y0 and Y1), specifying the edges of the user selected range in 
*graph* (i.e. physical) coordinates.  To remove a  previous selection,
just execute the Tk commands: 
".pow.pow itemconfigure $tag -fill black; .pow.pow delete $tag" 

This could be used to implement an "undo" feature.
powDragRange will also select the congruent range on all graphs with axes
linked to the chosen axis in the current graph.

powDragRect tag color callback -  This works the same as powDragRange, but
the user chooses a rectangular region of the selected graph.  And the
callback routine recieves 5 arguments (graphname X0 Y0 X1 Y1). Also, 
powDragRect ignores linked axes because it's not clear what "should"
happen to the unlinked axis. If someone wants to make a case for a
different (or selectable) behavior here, feel free.

Linked Axes

POW allows you to "link" any number of axes on different graphs together.
The resulting set of linked axes is called a "chain".  Each axis can only
be a member of one chain.  Linking an axis from one chain to an axis in 
another chain has the effect of merging the two chains.  Zooming on a
region of interest on one graph will affect the linked axis on any other
graph.  There are several utility routines.  Also, the GUI allows the
user to view links as light pink lines connecting linked axes.

powLinkAxes graph1 axis1 graph2 axis2 - The axis can be specified with a
            capital 'X' or 'Y'.

powBreakLink graph axis - removes the specified axis from its chain.

powAlignChain graph axis orientation ?gap? - orientation can be H 
	(for horizontal) or V (for vertical).  This routine will move
	all graphs belonging to the same chain as the specified graph 
	so that they are aligned on the canvas.  I.e.  it "stacks" the
	graphs up in a column or lines them up in a row on the users screen.
	The optional "gap" argument determines how much blank space (in 
	pixels to leave between graphs).



"Useful Stuff that should be safe to access"

The name of the pow canvas is ".pow.pow"

The tag for the axis box for a graph is:
${graphname}box
When multi-axes are done, it will be:
$graphname$xunits${yunits}box

Everything belonging to a graph is tagged with the graph name.





Do bugs still exist.  You bet!  Still too many to make a list yet, really; 
you'll know 'em when you see 'em.  Known bugs in the latest release are
listed on the "fv known bugs list" web page: 

        http://heasarc.gsfc.nasa.gov/ftools/fv/fv_bugs.html


Some info on the FitsTcl functions:


I checked in the new fitstcl with the function you need to load a column
 in a table into memory.

Usage : FitsObj load column $colName $nulValue
	where  	colName - column name
	 	nulValue - the default Null value you want to set

it returns "$address $dataType $numElements"
	where 	(1) data can be recovered by "sscanf(address, "%p", &databuff)
			with void *databuff
	        (2) dataType 0 - byte
			     1 - int
	 		     2 - long
		             3 - float
	 		     4 - double
	       	(3) numElement : size of the array

Thanks

Jianjun



C Interface:

All of the functions do the same thing as their TCL counterparts.  I'll
list the definitions below.  The parallels should be obvious.  The one
thing you will need is an event handler (i.e., when you call Pow, your
program has to stop and let the user play with his or her graph).  To 
do this you call an Event Handler.  When the user activates the "Close Pow"
button, control returns to your program.  Eventually you'll be able
to fork off the Event Handler etc., but for now, this is it.

Only the "Constructors" are available from C, for now.  All of the "Methods"
are written in TCL, so rather than creating Oroburos code with C calls
TCL calls C calls ..., if you want to use any of them, just call

Tcl_VarEval(proc,argument,argument,...,NULL);  - Note: all arguments
                                                 are STRINGS ! 

(see Ousterhout for details). 


Event Handlers

void PowHandleEvents( )  Your program stops, when the user closes POW
                         your program begins again.

void PowWishHandleEvents( ) Your program stops, until the user closes the POW
                            GUI she can type in TCL commands at a wish
                            prompt.  Useful for debugging and probably
                            in production code as well. When the user closes
                            POW, your program begins again.

"Constructors"

All of the POW functions have a status argument rather than just returning 
the status.  Yes I know it's awkward, but it makes FORTRAN happier, of course
noone's actually calling it from FORTRAN, but it was in the requirements....


void PowInit(char *powSetupColormapArgs, char *powInitArgs, int *status)  - 
      Call this before calling any other POW functions.  PowInit first calls
      the general POW initialization routine (in the TCL version, this gets
      called when you load libpow.so).  Then it calls powSetupColormap if
      you've specified anything in the powSetupColormapArgs argument.  Then
      it calls the TCL proc powInit with any powInitArgs you've specified.
      See above for descriptions of how powSetupColormap and powInit work.
	Example:  To force truecolor when you have no additional windows
                  to create and your application will be using no more than
                  10 non-POW colors do:

        PowInit(".dummy 10 2",".dummy ",&status);

        Tcl_VarEval(interp,"wm withdraw .dummy",(char *)NULL);



void PowCreateData(char *data_name, void *data_array, int *data_type,
		   int *length, int *copy, int *status) 


void PowCreateVector(char *vector_name, char *data_name, int *offset,
		     int *length, char *units, int *status) 

void PowCreateVectorEN(char *vector_name, char *data_name, 
			     int *length, double *start, double *increment, 
			     char *units, int *status) 

void PowCreateImage(char *image_name,char *data_name, int *xoffset, 
		    int *yoffset, int *width, int *height, double *xorigin, 
		    double *xinc, double *yorigin, double *yinc,char *xunits,
		    char *yunits, char *zunits, int *status)

void PowCreateCurve(char *curve_name, char *x_vector, char *x_error,
		    char *y_vector, char *y_error, char *z_vector, 
		    char *z_error, int *status)

void PowCreateGraph(char *graph_name, char *curves, char *images,
		    char *xunits, char *yunits, char *xlabel, char *ylabel,
		    int *xdimdisp, int *ydimdisp, double *xmin_in, 
		    double *ymin_in, double *xmax_in, double *ymax_in, 
		    int *status)
    fv5.5/tcltk/pow/POWplot0000755000220700000360000000077713224715127013754 0ustar birbylhea#!/bin/sh # # (if [ "x$POW" = x ] ; then \ POW=$FTOOLS; \ export POW; fi; \ POW_LIBRARY=$POW/lib/pow ;\ export POW_LIBRARY ;\ unset TCL_LIBRARY; unset TK_LIBRARY; unset TCLLIBPATH ;\ unset ITCL_LIBRARY; unset ITK_LIBRARY; \ LD_LIBRARY_PATH=$POW/lib:$LD_LIBRARY_PATH ;\ export LD_LIBRARY_PATH ;\ if [ "$POW_DISPLAY" != "" ] ; then \ $POW/bin/tclsh $POW_LIBRARY/POWplotClient.tcl -- $1 $2 $3 $4 $5 $6 $7 $8 $9; else $POW/bin/wish $POW_LIBRARY/POWplot.tcl -- $1 $2 $3 $4 $5 $6 $7 $8 $9; fi; \ exit) fv5.5/tcltk/pow/POWplot.tcl0000644000220700000360000006532313224715127014530 0ustar birbylheaproc _getDataForAxis { filehandle axis_ axisExpression_ whichRows_ } { if { $axisExpression_ == "RowNumber" } { set axisExpression_ "#ROW" set dataType 41 set nelem [range count $whichRows_ $_numRows] set dim 1 } else { if { [catch {set axis_info [$filehandle info expr $axisExpression_]} err] } { error "Cannot plot expression for $axis_.\n\n$err" } set dataType [lindex $axis_info 0] set nelem [lindex $axis_info 1] set dim [lindex $axis_info 2] if { $dataType!=41 && $dataType!=82 } { error "Cannot plot expression type for $axis_.\ Expression must evaluate to INT or REAL" } if { $nelem == -1 } { # Scalar constants could be applied to either nRows or nElems # so just return a solitary value and expand later as needed set whichRows_ 1 } elseif { $nelem < -1 } { # Treat vector constants as a regular vector column set nelem [expr -$nelem] } } set dataInfoForPOW [$filehandle load expr -rows $whichRows_ $axisExpression_ NULL] set dataPtr [lindex $dataInfoForPOW 0] set dataType [lindex $dataInfoForPOW 1] set numElements [lindex $dataInfoForPOW 2] return [list $dataPtr $dataType $numElements $nelem $dim] } proc powDebugDataPrint { title string } { puts "$title" set k 0 for {set i 0} {$i < [string length $string]} {incr i 80} { set currentStr [string range $string $i [expr $i + 79]] puts "<$currentStr>" incr k } puts "count: $k" } proc assembleWcsLabel { filehandle img flag {selection "DEFAULT"} } { global powWCSLabel set target $selection if { $selection == " " || $selection == "DEFAULT" } { set target "DEFAULT" set selection "" } set powWCSLabel(xunit,$img,$target) "" set powWCSLabel(yunit,$img,$target) "" set x_label "" set y_label "" set x_unit "pixels" set y_unit "pixels" if { $flag == "image" } { set powWCSLabel(xlabel,$img,$target) "" set powWCSLabel(ylabel,$img,$target) "" if { ![catch {set tmp [getKeyword $filehandle CTYPE1$selection]}] } { set v [lindex [lindex $tmp 0] 1] set x_label [string trim $v {' }] set powWCSLabel(xlabel,$img,$target) $x_label } if { ![catch {set tmp [getKeyword $filehandle TTYPE1$selection]}] } { set v [lindex [lindex $tmp 0] 1] set x_label [string trim $v {' }] set powWCSLabel(xlabel,$img,$target) $x_label } if { ![catch {set tmp [getKeyword $filehandle CTYPE2$selection]}] } { set v [lindex [lindex $tmp 0] 1] set y_label [string trim $v {' }] set powWCSLabel(ylabel,$img,$target) $y_label } if { ![catch {set tmp [getKeyword $filehandle TTYPE2$selection]}] } { set v [lindex [lindex $tmp 0] 1] set y_label [string trim $v {' }] set powWCSLabel(ylabel,$img,$target) $y_label } if { ![catch {set tmp [getKeyword $filehandle CUNIT1$selection]}] } { set v [lindex [lindex $tmp 0] 1] set x_unit [string trim $v {' }] set powWCSLabel(xunit,$img,$target) $x_unit } if { ![catch {set tmp [getKeyword $filehandle TUNIT1$selection]}] } { set v [lindex [lindex $tmp 0] 1] set x_unit [string trim $v {' }] set powWCSLabel(xunit,$img,$target) $x_unit } if { ![catch {set tmp [getKeyword $filehandle CUNIT2$selection]}] } { set v [lindex [lindex $tmp 0] 1] set y_unit [string trim $v {' }] set powWCSLabel(yunit,$img,$target) $y_unit } if { ![catch {set tmp [getKeyword $filehandle TUNIT2$selection]}] } { set v [lindex [lindex $tmp 0] 1] set y_unit [string trim $v {' }] set powWCSLabel(yunit,$img,$target) $y_unit } } else { set i 0 set findUnit 0 while (1) { incr i if { ![catch {set tmp [getKeyword $filehandle CTYPE${i}$selection]}] } { set v [lindex [lindex $tmp 0] 1] set label [string trim $v {' }] if { $label == $powWCSLabel(xlabel,$img,$target) } { set powWCSLabel(xunit,$img,$target) "counts" if { ![catch { set tmp [getKeyword $filehandle CUNIT${i}$selection]}] } { set v [lindex [lindex $tmp 0] 1] set x_unit [string trim $v {' }] set powWCSLabel(xunit,$img,$target) $x_unit } incr findUnit } elseif { $label == $powWCSLabel(ylabel,$img,$target) } { set powWCSLabel(yunit,$img,$target) "counts" if { ![catch { set tmp [getKeyword $filehandle CUNIT${i}$selection]}] } { set v [lindex [lindex $tmp 0] 1] set y_unit [string trim $v {' }] set powWCSLabel(yunit,$img,$target) $y_unit } incr findUnit } if { $findUnit >= 2 } break } elseif { ![catch {set tmp [getKeyword $filehandle TTYPE${i}$selection]}] } { set v [lindex [lindex $tmp 0] 1] set label [string trim $v {' }] if { $label == $powWCSLabel(xlabel,$img,$target) } { set powWCSLabel(xunit,$img,$target) "counts" if { ![catch { set tmp [getKeyword $filehandle TUNIT${i}$selection]}] } { set v [lindex [lindex $tmp 0] 1] set x_unit [string trim $v {' }] set powWCSLabel(xunit,$img,$target) $x_unit } incr findUnit } elseif { $label == $powWCSLabel(ylabel,$img,$target) } { set powWCSLabel(yunit,$img,$target) "counts" if { ![catch { set tmp [getKeyword $filehandle TUNIT${i}$selection]}] } { set v [lindex [lindex $tmp 0] 1] set y_unit [string trim $v {' }] set powWCSLabel(yunit,$img,$target) $y_unit } incr findUnit } if { $findUnit >= 2 } break } else { break } } if { $findUnit < 2 } { puts "not enough information to plot" exit } } set z_label "counts" if { ![catch {set tmp [getKeyword $filehandle BUNIT$selection]}] } { set v [lindex [lindex $tmp 0] 1] set z_label [string trim $v {' }] } set powWCSLabel(zlabel,$img,$target) $z_label } proc getWcs {{dest {}} {RAColNum_ {}} {DecColNum_ {}} } { global filehandle if { $RAColNum_ == "" || $DecColNum_ == "" } { if { [catch {set wcs [$filehandle get wcs -m $dest]}] } { return "" } else { return $wcs } } else { set wcs [$filehandle get wcs -m $dest $RAColNum_ $DecColNum_] return $wcs } } proc rotationSend { str img } { global powHeaderWcsKeyWord powWCSInfo powWCSToken powWCS set rotationRate 80 set i 0 while { 1 } { set currentStr [string range $str $i [expr $i + [expr $rotationRate - 1]]] incr i $rotationRate if { [string trim $currentStr] == "" } { if { $i > [string length $str] } break continue } ::powCmds::wcsHeader $img $rotationRate $currentStr continue } } proc getHeaderKeyWord { str img } { global powHeaderWcsKeyWord powWCSInfo powWCSToken powWCS if [info exists powHeaderWcsKeyWord($img,DEFAULT)] { foreach letter [list a b c d e f g h i j k l m n o p q r s t u v w x y z] { if [info exists powHeaderWcsKeyWord($img,$letter)] { unset powHeaderWcsKeyWord($img,$letter) } } if [info exists powHeaderWcsKeyWord($img,NONE)] { unset powHeaderWcsKeyWord($img,NONE) } if [info exists powHeaderWcsKeyWord($img,END)] { unset powHeaderWcsKeyWord($img,END) } if [info exists powHeaderWcsKeyWord($img,DEFAULT)] { unset powHeaderWcsKeyWord($img,DEFAULT) } unset powHeaderWcsKeyWord } set i 0 set numCard 0 set numCoord 0 set numCardInCoord 0 set powWCSToken($img) { DEFAULT } while { 1 } { set currentStr [string range $str $i [expr $i + 79]] incr i 80 if { [string trim $currentStr] == "" } { if { $i > [string length $str] } break continue } set currentStrToken [split $currentStr "="] set header [string trim [lindex $currentStrToken 0]] incr numCard if { [llength $currentStrToken] == 2 } { switch -regexp -- $header { {CTYPE[0-9][A-Z]?} - {CUNIT[0-9][A-Z]?} - {CRVAL[0-9][A-Z]?} - {CRPIX[0-9][A-Z]?} - {CD[0-9][_][0-9][A-Z]?} - {CDELT[0-9][A-Z]?} - {CROTA[0-9][A-Z]?} - {TTYPE[0-9][A-Z]?} - {TUNIT[0-9][A-Z]?} - {TCTYP[0-9][A-Z]?} - {TCUNI[0-9][A-Z]?} - {TCRVL[0-9][A-Z]?} - {TCRPX[0-9][A-Z]?} - {TCDLT[0-9][A-Z]?} - {TCD[0-9][A-Z]?} - {TCROT[0-9][A-Z]?} - {OFFSET[0-9][A-Z]?} { incr numCardInCoord set lastChar [string toupper [string range $header end end]] regsub {[A-Z]} $lastChar {} testChar if { $testChar == "" } { set headerLength [string length [lindex $currentStrToken 0]] set newHeader [string range $header 0 [expr [string length $header] - 2]] set newStr [format "%-${headerLength}s=%s" $newHeader \ [lindex $currentStrToken 1]] if { ![info exists powHeaderWcsKeyWord] || \ ![info exists powHeaderWcsKeyWord($img,$lastChar)] } { incr numCoord set powHeaderWcsKeyWord($img,$lastChar) $newStr set powWCSInfo($img,$lastChar) [getWcs $lastChar] lappend powWCSToken($img) $lastChar } else { set powHeaderWcsKeyWord($img,$lastChar) \ [format "%s%s" $powHeaderWcsKeyWord($img,$lastChar) $newStr] } } else { if { ![info exists powHeaderWcsKeyWord] || \ ![info exists powHeaderWcsKeyWord($img,DEFAULT)] } { incr numCoord set powHeaderWcsKeyWord($img,DEFAULT) $currentStr } else { set powHeaderWcsKeyWord($img,DEFAULT) \ [format "%s%s" $powHeaderWcsKeyWord($img,DEFAULT) $currentStr] } } } default { if { ![info exists powHeaderWcsKeyWord] || \ ![info exists powHeaderWcsKeyWord($img,NONE)] } { set powHeaderWcsKeyWord($img,NONE) $currentStr } else { set powHeaderWcsKeyWord($img,NONE) \ [format "%s%s" $powHeaderWcsKeyWord($img,NONE) $currentStr] } } } } else { switch -glob -- $header { "END*" { set powHeaderWcsKeyWord($img,END) $currentStr } default { if { ![info exists powHeaderWcsKeyWord] || \ ![info exists powHeaderWcsKeyWord($img,NONE)] } { set powHeaderWcsKeyWord($img,NONE) $currentStr } else { set powHeaderWcsKeyWord($img,NONE) \ [format "%s%s" $powHeaderWcsKeyWord($img,NONE) $currentStr] } } } } if { $i > [string length $str] } break } if { $numCoord > 0 } { set numCardPerCoord [expr $numCardInCoord / $numCoord] return [list $numCard $numCard] } else { return [list 0 $numCard] } } proc assembleWcsHeader { img {selection "DEFAULT"} } { global powHeaderWcsKeyWord # regular header if { $selection == "NOWCS" } { return [format "%s%s" $powHeaderWcsKeyWord($img,NONE) \ $powHeaderWcsKeyWord($img,END)] } else { return [format "%s%s%s" $powHeaderWcsKeyWord($img,NONE) \ $powHeaderWcsKeyWord($img,$selection) \ $powHeaderWcsKeyWord($img,END)] } } proc getKeyword {filehandle keyword} { # get $keyword # _isOpen $filehandle get keyword ^$keyword\$ } set helpMsg "Usage: POWplot ?-cmap code? ?-display client? ?fitsimage? code: 0 Chose the best colormap 1 Force to install private pseudo colormap 2 Force to use truecolor colormap (if don't have it will crash!) 3 Force to use screen default colormap client: XPA entry point of form IP_Address:portNumber, pointing to a remote POW session to which plot commands should be sent" global g_backupDir tcl_platform global powFitsHeaderCnt powFitsHeader global powHeaderWcsKeyWord powWCSInfo powWCSToken powWCS global powWCSName powWCSList powWCSLabel global filehandle if { $tcl_platform(platform) == "windows" } { set fvTmp "fv_tmp" } elseif { $tcl_platform(platform) == "macintosh" } { set fvTmp "fv_temp_folder" } else { set fvTmp ".fvtmp" } set g_backupDir $env(HOME)/$fvTmp if ![file exists $g_backupDir] { file mkdir $g_backupDir file attributes $g_backupDir -permissions 00775 } set ppFitsDataType(8) 0 set ppFitsDataType(16) 1 set ppFitsDataType(32) 2 set ppFitsDataType(-32) 3 set ppFitsDataType(-64) 4 set instPos [lsearch $argv "-cmap"] set colorCode 0 # if install colormap if { $instPos != -1} { if { [catch {set colorCode [lindex $argv [expr $instPos+1]]}] == 1} { puts $helpMsg exit } if { ($colorCode != 0) && ($colorCode != 1) && ($colorCode != 2) \ && ($colorCode != 3) } { puts $helpMsg exit } set argv [lreplace $argv $instPos [expr $instPos+1]] incr argc -2 } wm withdraw . update idletask set plotFlag [lsearch $argv "-plot"] if { $plotFlag >= 0 } { set argv [lreplace $argv $plotFlag $plotFlag] incr argc set plotFlag true } else { set plotFlag false } # # Load libraries # set POWLIB "$env(POW_LIBRARY)/.." set env(POW_HELPDIR) $env(POW_LIBRARY) package require Itcl package require Itk package require Iwidgets load [glob $POWLIB/libfitstcl.{s\[ol\]*,dylib}] load [glob $POWLIB/libpow.{s\[ol\]*,dylib}] # Look for client/server flag set instPos [lsearch $argv "-display"] if { $instPos != -1 } { set client [lindex $argv [expr $instPos+1]] set argv [lreplace $argv $instPos [expr $instPos+1]] incr argc -2 ::powCmds::remote $client } else { # None specified, so ask POW for default value set client [::powCmds::remote] } if ![info exists g_titleFont] { if { $tcl_platform(platform) == "windows" } { set isWin 1 set isMac 0 font create g_titleFont -family Arial -size -12 font create g_notebookTitleFont -family Arial -size -14 } elseif { $tcl_platform(platform) == "macintosh" } { set isWin 0 set isMac 1 font create g_titleFont -family system -size -12 font create g_notebookTitleFont -family system -size -14 } else { set isWin 0 set isMac 0 font create g_titleFont -family Helvetica -size -12 -weight bold font create g_notebookTitleFont -family Helvetica -size -14 -weight bold } font create g_entryFont -family Courier -size -12 set g_charPix [font measure g_entryFont m] } set globalBgColor #cccccc set globalFgColor black set activeBgColor #eeeeee set activeFgColor black set checkBBgColor #ff3366 option add *Background $globalBgColor option add *Foreground $globalFgColor option add *HighlightBackground $globalBgColor option add *activeForeground $activeFgColor option add *activeBackground $activeBgColor option add *selectForeground $activeFgColor option add *selectBackground $activeBgColor option add *selectColor $checkBBgColor ::powCmds::init 30 $colorCode if { $plotFlag == true } { if { $argc < 5 } { tk_messageBox -icon error -type ok \ -message "usage: POWplot -plot ??" exit } set filename [lindex $argv 0] set extension [lindex $argv 1] set xColumn_ [lindex $argv 2] set yColumn_ [lindex $argv 3] set range "" if { $argc == 7 } { set token [split [lindex $argv 6] "-"] if { $token != 2 } { tk_messageBox -icon error -type ok \ -message "Range specified in format:\n\nstart-end" exit } set range [lindex $argv 6] } regsub -all {[^a-zA-Z0-9.]} [file tail $filename] "_" gname set filehandle [fits open $filename 0] # find extension while (1) { set errorFlag [ catch { $filehandle move +1 } err ] if { $errorFlag } { break } else { set currentHDU [split [$filehandle get keyword EXTNAME] " "] set checkExt [string tolower [string trim [lindex $currentHDU 1] "{'}"]] if { $checkExt == [string tolower $extension] } { break } } } set wcsinfo [getWcs] if { [lindex $wcsinfo 4] != "none" } { set x_label [lindex [lindex $wcsinfo 3] 0] set y_label [lindex [lindex $wcsinfo 3] 1] } set x_unit "counts" set y_unit "counts" set _numRows [$filehandle info nrows] if { $range == "" } { set range [format "1-%s" $_numRows] } set graphName ${gname}_plot set curveName ${gname}_curve set result [$filehandle get header2str] set cntList($graphName) [getHeaderKeyWord [lindex $result 0] $graphName] set powFitsHeaderCnt($graphName) [lindex $cntList($graphName) 1] set powFitsHeaderCnt($curveName) [lindex $cntList($graphName) 1] set powWCSName($graphName) 0 set powWCSName(${graphName}scope) 0 set powWCSName($curveName) 0 set powWCSName(${curveName}scope) 0 if { [lindex $cntList($graphName) 0] > 0 } { set powFitsHeader($graphName) [lindex $result 0] set powFitsHeader($curveName) [lindex $result 0] } else { set powFitsHeader($graphName) "" set powFitsHeader($curveName) "" } set currentStr $powFitsHeader($graphName) ::powCmds::wcs $graphName $wcsinfo ::powCmds::wcsHeader $graphName 0 NONE start set idx 0 set headerLen [string length $currentStr] if { $idx + $headerLen <= 3000 } { ::powCmds::wcsHeader $graphName $headerLen $currentStr continue } else { rotationSend [lindex $result 0] $graphName } ::powCmds::wcsHeader $graphName 0 NONE done ::powCmds::wcsHeaderCnt $graphName $powFitsHeaderCnt($graphName) set currentStr $powFitsHeader($curveName) ::powCmds::wcs $curveName $wcsinfo ::powCmds::wcsHeader $curveName 0 NONE start set idx 0 set headerLen [string length $currentStr] if { $idx + $headerLen <= 3000 } { ::powCmds::wcsHeader $curveName $headerLen $currentStr continue } else { rotationSend [lindex $result 0] $curveName } ::powCmds::wcsHeader $curveName 0 NONE done ::powCmds::wcsHeaderCnt $curveName $powFitsHeaderCnt($curveName) if ![info exists powWCSList($graphName)] { set powWCSList($graphName) {} lappend powWCSList($graphName) 1 lappend powWCSList($graphName) DEFAULT } foreach name [lindex $powWCSList($graphName) 1] { # plot is against columns input set powWCSLabel(xlabel,$graphName,$name) $xColumn_ set powWCSLabel(ylabel,$graphName,$name) $yColumn_ assembleWcsLabel $filehandle $graphName "plot" $name ::powCmds::wcsLabel $graphName "xlabel" $name $powWCSLabel(xlabel,$graphName,$name) ::powCmds::wcsLabel $graphName "ylabel" $name $powWCSLabel(ylabel,$graphName,$name) ::powCmds::wcsLabel $graphName "xunit" $name $powWCSLabel(xunit,$graphName,$name) ::powCmds::wcsLabel $graphName "yunit" $name $powWCSLabel(yunit,$graphName,$name) ::powCmds::wcsLabel $graphName "zlabel" $name $powWCSLabel(zlabel,$graphName,$name) ::powCmds::wcsLabel $curveName "xlabel" $name $powWCSLabel(xlabel,$graphName,$name) ::powCmds::wcsLabel $curveName "ylabel" $name $powWCSLabel(ylabel,$graphName,$name) ::powCmds::wcsLabel $curveName "xunit" $name $powWCSLabel(xunit,$graphName,$name) ::powCmds::wcsLabel $curveName "yunit" $name $powWCSLabel(yunit,$graphName,$name) ::powCmds::wcsLabel $curveName "zlabel" $name $powWCSLabel(zlabel,$graphName,$name) } set x_unit $powWCSLabel(xunit,$graphName,DEFAULT) set y_unit $powWCSLabel(yunit,$graphName,DEFAULT) set powWCSList(${graphName}scope) $powWCSList($graphName) set powWCSList(${curveName}scope) $powWCSList($graphName) # value set wcsliststr "[lindex $powWCSList($graphName) 0]" foreach name [lindex $powWCSList($graphName) 1] { set wcsliststr [format "%s|%s" $wcsliststr $name] } ::powCmds::wcsSetList $graphName $wcsliststr ::powCmds::wcsSetList $curveName $wcsliststr set data [_getDataForAxis $filehandle "x" $xColumn_ $range] set xcol_data [ptr2lst [lindex $data 0] [lindex $data 1] [lindex $data 2]] set data [_getDataForAxis $filehandle "y" $yColumn_ $range] set ycol_data [ptr2lst [lindex $data 0] [lindex $data 1] [lindex $data 2]] #::powCmds::create data xdataName $xcol_data #::powCmds::create data ydataName $ycol_data set sendBlockSize 200 ::powCmds::create data xdataName NONE Start if { [llength $xcol_data] <= $sendBlockSize } { ::powCmds::create data xdataName $xcol_data continue } else { while { [llength $xcol_data] > 0 } { set currentBatch [lrange $xcol_data 0 [expr $sendBlockSize - 1]] set xcol_data [lreplace $xcol_data 0 [expr $sendBlockSize - 1]] ::powCmds::create data xdataName $currentBatch continue } } ::powCmds::create data xdataName NONE Done ::powCmds::create data ydataName NONE Start if { [llength $ycol_data] <= $sendBlockSize } { ::powCmds::create data ydataName $ycol_data continue } else { while { [llength $ycol_data] > 0 } { set currentBatch [lrange $ycol_data 0 [expr $sendBlockSize - 1]] set ycol_data [lreplace $ycol_data 0 [expr $sendBlockSize - 1]] ::powCmds::create data ydataName $currentBatch continue } } ::powCmds::create data ydataName NONE Done ::powCmds::create curve $curveName xdataName ydataName ::powCmds::create graph $graphName $curveName NULL ::powCmds::size 300 300 ::powCmds::graph -name $graphName \ xlabel $xColumn_ \ ylabel $yColumn_ \ xunits $x_unit \ yunits $y_unit ::powCmds::curve -name $curveName pDisp No lDisp Yes ::powCmds::select graph $graphName $filehandle close } else { foreach filename $argv { regsub -all {[^a-zA-Z0-9.]} [file tail $filename] "_" gname set filehandle [fits open $filename 0] set imghandle [$filehandle load image] set dims [$filehandle info imgdim] set n1 [lindex $dims 0] if { [llength $dims]==1 } { set n2 1 } else { set n2 [lindex $dims 1] } set data_type [lindex [lindex [$filehandle get keyword BITPIX] 0] 1] set data_type $ppFitsDataType($data_type) if { ([catch {$filehandle get keyword BZERO}] == 0) || ([catch {$filehandle get keyword BSCALE}] == 0) } { set data_type 4 } # powCreateData ${gname}_data $imghandle $data_type [expr $n1 * $n2] 0 set lstData [list $imghandle $data_type [list $n1 $n2] ] ::powCmds::array $lstData ${gname}_data PTR $tcl_platform(byteOrder) # Try to get WCS (or scaling) information set x0 1 set y0 1 set xinc 1 set yinc 1 set x_label "" set y_label "" set x_unit "pixels" set y_unit "pixels" set z_unit "counts" set wcsinfo [getWcs] if { [lindex $wcsinfo 4] != "none" } { set x_label [lindex [lindex $wcsinfo 3] 0] set y_label [lindex [lindex $wcsinfo 3] 1] set x_unit "deg" set y_unit "deg" } set result [$filehandle get header2str] set cntList(${gname}_img) [getHeaderKeyWord [lindex $result 0] ${gname}_img] set powFitsHeaderCnt(${gname}_img) [lindex $cntList(${gname}_img) 1] set graphName ${gname}_img set powWCSName($graphName) 0 set powWCSName(${graphName}scope) 0 if { [lindex $cntList($graphName) 0] > 0 } { set powFitsHeader($graphName) [lindex $result 0] } else { set powFitsHeader($graphName) "" } set currentStr $powFitsHeader($graphName) ::powCmds::wcs $graphName $wcsinfo ::powCmds::wcsHeader $graphName 0 NONE start set idx 0 set headerLen [string length $currentStr] if { $idx + $headerLen <= 3000 } { ::powCmds::wcsHeader $graphName $headerLen $currentStr continue } else { rotationSend [lindex $result 0] $graphName } ::powCmds::wcsHeader $graphName 0 NONE done ::powCmds::wcsHeaderCnt $graphName $powFitsHeaderCnt($graphName) ::powCmds::create image $graphName \ ${gname}_data $n1 $n2 if [info exists powWCSList($graphName)] { foreach name [lindex $powWCSList($graphName) 1] { assembleWcsLabel $filehandle $graphName "image" $name if { $name == " " } { set name "DEFAULT" } ::powCmds::wcsLabel $graphName "xlabel" $name $powWCSLabel(xlabel,$graphName,$name) ::powCmds::wcsLabel $graphName "ylabel" $name $powWCSLabel(ylabel,$graphName,$name) ::powCmds::wcsLabel $graphName "xunit" $name $powWCSLabel(xunit,$graphName,$name) ::powCmds::wcsLabel $graphName "yunit" $name $powWCSLabel(yunit,$graphName,$name) ::powCmds::wcsLabel $graphName "zlabel" $name $powWCSLabel(zlabel,$graphName,$name) } } else { set powWCSList($graphName) {} lappend powWCSList($graphName) 1 lappend powWCSList($graphName) {DEFAULT} } set powWCSList(${graphName}scope) $powWCSList($graphName) # value set wcsliststr "[lindex $powWCSList($graphName) 0]" foreach name [lindex $powWCSList($graphName) 1] { set wcsliststr [format "%s|%s" $wcsliststr $name] } ::powCmds::wcsSetList $graphName $wcsliststr ::powCmds::graph -name $graphName \ xlabel $x_label \ ylabel $y_label \ xunits $x_unit \ yunits $y_unit ::powCmds::create graph $graphName NULL $graphName $filehandle close } } bind . <> { exit } if { $client != "" } { exit } fv5.5/tcltk/pow/PowCanvCurve.c0000644000220700000360000021674613224715127015215 0ustar birbylhea/* * powCanvCurve.c -- derived from * tkCanvLine.c -- * * This file implements powCurve items for canvas widgets. * * Copyright (c) 1991-1994 The Regents of the University of California. * Copyright (c) 1994-1995 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * */ #include "tkInt.h" #include "tkPort.h" #include "tkCanvas.h" #include "pow.h" void outDebugStr(char *title, char *str); /* * Information used for parsing configuration specs. If you change any * of the default strings, be sure to change the corresponding default * values in CreatePowCurve. */ static Tk_CustomOption stateOption = { (Tk_OptionParseProc *) TkStateParseProc, TkStatePrintProc, (ClientData) 2 }; static Tk_CustomOption tagsOption = { (Tk_OptionParseProc *) Tk_CanvasTagsParseProc, Tk_CanvasTagsPrintProc, (ClientData) NULL }; static Tk_CustomOption dashOption = { (Tk_OptionParseProc *) TkCanvasDashParseProc, TkCanvasDashPrintProc, (ClientData) NULL }; static Tk_CustomOption offsetOption = { (Tk_OptionParseProc *) TkOffsetParseProc, TkOffsetPrintProc, (ClientData) (TK_OFFSET_RELATIVE|TK_OFFSET_INDEX) }; static Tk_CustomOption pixelOption = { (Tk_OptionParseProc *) TkPixelParseProc, TkPixelPrintProc, (ClientData) NULL }; static Tk_ConfigSpec configSpecs[] = { {TK_CONFIG_CUSTOM, "-activedash", (char *) NULL, (char *) NULL, (char *) NULL, Tk_Offset(PowCurveItem, lOutline.activeDash), TK_CONFIG_NULL_OK, &dashOption}, {TK_CONFIG_COLOR, "-activefill", (char *) NULL, (char *) NULL, (char *) NULL, Tk_Offset(PowCurveItem, lOutline.activeColor), TK_CONFIG_NULL_OK}, {TK_CONFIG_BITMAP, "-activestipple", (char *) NULL, (char *) NULL, (char *) NULL, Tk_Offset(PowCurveItem, lOutline.activeStipple), TK_CONFIG_NULL_OK}, {TK_CONFIG_CUSTOM, "-activewidth", (char *) NULL, (char *) NULL, "0.0", Tk_Offset(PowCurveItem, lOutline.activeWidth), TK_CONFIG_DONT_SET_DEFAULT, &pixelOption}, {TK_CONFIG_CAP_STYLE, "-capstyle", (char *) NULL, (char *) NULL, "butt", Tk_Offset(PowCurveItem, capStyle), TK_CONFIG_DONT_SET_DEFAULT}, {TK_CONFIG_STRING, "-pointtype", (char *) NULL, (char *) NULL, "Cross", Tk_Offset(PowCurveItem, pointType), 0}, {TK_CONFIG_PIXELS, "-pointsize", (char *) NULL, (char *) NULL, "3", Tk_Offset(PowCurveItem, pointSize), 0}, {TK_CONFIG_BOOLEAN, "-pointdisplay", (char *) NULL, (char *) NULL, "1", Tk_Offset(PowCurveItem, pointDisp), 0}, {TK_CONFIG_BOOLEAN, "-pointfill", (char *) NULL, (char *) NULL, "0", Tk_Offset(PowCurveItem, pointFill), 0}, {TK_CONFIG_BOOLEAN, "-pointerror", (char *) NULL, (char *) NULL, "0", Tk_Offset(PowCurveItem, pointError), 0}, {TK_CONFIG_BOOLEAN, "-linedisplay", (char *) NULL, (char *) NULL, "0", Tk_Offset(PowCurveItem, lineDisp), 0}, {TK_CONFIG_BOOLEAN, "-stairstep", (char *) NULL, (char *) NULL, "0", Tk_Offset(PowCurveItem, stairStep), 0}, {TK_CONFIG_BOOLEAN, "-boxfill", (char *) NULL, (char *) NULL, "0", Tk_Offset(PowCurveItem, boxFill), 0}, {TK_CONFIG_BOOLEAN, "-curvetopoint", (char *) NULL, (char *) NULL, "0", Tk_Offset(PowCurveItem, curveToPoint), 0}, {TK_CONFIG_BOOLEAN, "-hidden", (char *) NULL, (char *) NULL, "0", Tk_Offset(PowCurveItem, hidden), 0}, {TK_CONFIG_COLOR, "-lfill", (char *) NULL, (char *) NULL, "Black", Tk_Offset(PowCurveItem, lOutline.color), TK_CONFIG_NULL_OK}, {TK_CONFIG_COLOR, "-pfill", (char *) NULL, (char *) NULL, "Black", Tk_Offset(PowCurveItem, pOutline.color), TK_CONFIG_NULL_OK}, {TK_CONFIG_BOOLEAN, "-logx", (char *) NULL, (char *) NULL, "0", Tk_Offset(PowCurveItem, logX), 0}, {TK_CONFIG_BOOLEAN, "-logy", (char *) NULL, (char *) NULL, "0", Tk_Offset(PowCurveItem, logY), 0}, {TK_CONFIG_INT, "-LOD", (char *) NULL, (char *) NULL, "0", Tk_Offset(PowCurveItem, LOD), 0}, {TK_CONFIG_CUSTOM, "-dash", (char *) NULL, (char *) NULL, (char *) NULL, Tk_Offset(PowCurveItem, lOutline.dash), TK_CONFIG_NULL_OK, &dashOption}, {TK_CONFIG_PIXELS, "-dashoffset", (char *) NULL, (char *) NULL, "0", Tk_Offset(PowCurveItem, lOutline.offset), TK_CONFIG_DONT_SET_DEFAULT}, {TK_CONFIG_CUSTOM, "-disableddash", (char *) NULL, (char *) NULL, (char *) NULL, Tk_Offset(PowCurveItem, lOutline.disabledDash), TK_CONFIG_NULL_OK, &dashOption}, {TK_CONFIG_COLOR, "-disabledfill", (char *) NULL, (char *) NULL, (char *) NULL, Tk_Offset(PowCurveItem, lOutline.disabledColor), TK_CONFIG_NULL_OK}, {TK_CONFIG_BITMAP, "-disabledstipple", (char *) NULL, (char *) NULL, (char *) NULL, Tk_Offset(PowCurveItem, lOutline.disabledStipple), TK_CONFIG_NULL_OK}, {TK_CONFIG_CUSTOM, "-disabledwidth", (char *) NULL, (char *) NULL, "0.0", Tk_Offset(PowCurveItem, lOutline.disabledWidth), TK_CONFIG_DONT_SET_DEFAULT, &pixelOption}, {TK_CONFIG_JOIN_STYLE, "-joinstyle", (char *) NULL, (char *) NULL, "round", Tk_Offset(PowCurveItem, joinStyle), TK_CONFIG_DONT_SET_DEFAULT}, {TK_CONFIG_CUSTOM, "-offset", (char *) NULL, (char *) NULL, "0,0", Tk_Offset(PowCurveItem, lOutline.tsoffset), TK_CONFIG_DONT_SET_DEFAULT, &offsetOption}, {TK_CONFIG_CUSTOM, "-state", (char *) NULL, (char *) NULL, (char *) NULL, Tk_Offset(Tk_Item, state), TK_CONFIG_NULL_OK, &stateOption}, {TK_CONFIG_BITMAP, "-stipple", (char *) NULL, (char *) NULL, (char *) NULL, Tk_Offset(PowCurveItem, lOutline.stipple), TK_CONFIG_NULL_OK}, {TK_CONFIG_CUSTOM, "-tags", (char *) NULL, (char *) NULL, (char *) NULL, 0, TK_CONFIG_NULL_OK, &tagsOption}, {TK_CONFIG_CUSTOM, "-width", (char *) NULL, (char *) NULL, "1.0", Tk_Offset(PowCurveItem, lOutline.width), TK_CONFIG_DONT_SET_DEFAULT, &pixelOption}, {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL, (char *) NULL, 0, 0} }; /* * The structures below defines the powCurve item type by means * of procedures that can be invoked by generic item code. */ Tk_ItemType tkPowCurveType = { "powCurve", /* name */ sizeof(PowCurveItem), /* itemSize */ CreatePowCurve, /* createProc */ configSpecs, /* configSpecs */ ConfigurePowCurve, /* configureProc */ PowCurveCoords, /* coordProc */ DeletePowCurve, /* deleteProc */ DisplayPowCurve, /* displayProc */ TK_CONFIG_OBJS, /* flags */ PowCurveToPoint, /* pointProc */ PowCurveToArea, /* areaProc */ PowCurveToPostscript, /* postscriptProc */ ScalePowCurve, /* scaleProc */ TranslatePowCurve, /* translateProc */ GetPowCurveIndex, /* indexProc */ (Tk_ItemCursorProc *) NULL, /* icursorProc */ (Tk_ItemSelectionProc *) NULL, /* selectionProc */ PowCurveInsert, /* insertProc */ PowCurveDeleteCoords, /* dTextProc */ (Tk_ItemType *) NULL /* nextPtr */ }; /* *-------------------------------------------------------------- * * CreatePowCurve -- * * This procedure is invoked to create a new powCurve item in * a canvas. * * Results: * A standard Tcl return value. If an error occurred in * creating the item, then an error message is left in * the interp's result; in this case itemPtr is left uninitialized, * so it can be safely freed by the caller. * * Side effects: * A new powCurve item is created. * *-------------------------------------------------------------- */ int CreatePowCurve(interp, canvas, itemPtr, objc, objv) Tcl_Interp *interp; /* Interpreter for error reporting. */ Tk_Canvas canvas; /* Canvas to hold new item. */ Tk_Item *itemPtr; /* Record to hold new item; header * has been initialized by caller. */ int objc; /* Number of arguments in objv. */ Tcl_Obj *CONST objv[]; /* Arguments describing powCurve. */ { PowCurveItem *powCurvePtr = (PowCurveItem *) itemPtr; char *crv, *grph; /* * Carry out initialization that is needed to set defaults and to * allow proper cleanup after errors during the the remainder of * this procedure. */ Tk_CreateOutline(&(powCurvePtr->lOutline)); Tk_CreateOutline(&(powCurvePtr->pOutline)); powCurvePtr->canvas = canvas; powCurvePtr->pointType = NULL; powCurvePtr->curveToPoint = 0; powCurvePtr->capStyle = CapButt; powCurvePtr->joinStyle = JoinRound; if (objc < 2) { Tcl_SetResult(interp, "Usage: canvas create powCurve curve_name graph_name ?options?", TCL_STATIC); goto error; } crv = Tcl_GetStringFromObj( objv[0], NULL ); grph = Tcl_GetStringFromObj( objv[1], NULL ); if( (powCurvePtr->curveObjectPtr = PowFindCurve(crv)) == NULL ) { Tcl_SetResult(interp,"Couldn't find curve: ", TCL_STATIC ); Tcl_AppendResult(interp,crv,(char*)NULL); goto error; } if( (powCurvePtr->graphObjectPtr = PowFindGraph(grph)) == NULL ) { Tcl_SetResult(interp,"Couldn't find graph: ", TCL_STATIC ); Tcl_AppendResult(interp,grph,(char*)NULL); goto error; } powCurvePtr->pCoordPtr = NULL; powCurvePtr->lCoordPtr = NULL; if (ConfigurePowCurve(interp, canvas, itemPtr, objc-2, objv+2, 0) != TCL_OK) { goto error; } if (PowCurveCoords(interp, canvas, itemPtr, objc, objv) == TCL_OK) { return TCL_OK; } error: DeletePowCurve(canvas, itemPtr, Tk_Display(Tk_CanvasTkwin(canvas))); return TCL_ERROR; } /* *-------------------------------------------------------------- * * PowCurveCoords -- * * This procedure is invoked to process the "coords" widget * command on powCurves. See the user documentation for details * on what it does. * * Results: * Returns TCL_OK or TCL_ERROR, and sets the interp's result. * * Side effects: * The coordinates for the given item may be changed. * *-------------------------------------------------------------- */ int PowCurveCoords(interp, canvas, itemPtr, objc, objv) /* This routine calculates a list of canvas coordinates for * the points in the PowCurve object, these are then used to * display/scale/etc the item. */ Tcl_Interp *interp; /* Used for error reporting. */ Tk_Canvas canvas; /* Canvas containing item. */ Tk_Item *itemPtr; /* Item whose coordinates are to be * read or modified. */ int objc; /* Number of coordinates supplied in * argv. */ Tcl_Obj *CONST objv[]; /* Array of coordinates: x1, y1, * x2, y2, ... */ { PowCurveItem *powCurvePtr = (PowCurveItem *) itemPtr; double *pCoordPtr, *lCoordPtr; /*From the old PowProcessCurve command */ char **bboxptr; double x0 , x1, y0, y1; double rx0 , rx1, ry0, ry1, ry, rx; int n, xoff, yoff, xeoff, yeoff; PowCurve *curve_ptr; PowVector *x_vector, *y_vector, *x_error, *y_error, *z_vector; PowData *x_vect, *y_vect, *x_err, *y_err, *z_vect; PowGraph *graph; double xmagstep, ymagstep, oldx, oldy, modx, mody; double x,y,xe[5],ye[5],xp,yp,histX,histY,pX[12],pY[12]; int len; char *idxStr; const char *graphType; int zoomed; int xCount, yCount; int coordSel; double WCScdeltX, WCScdeltY; double p1; double q1; int nPts; int dflag=0,pflag=0,lflag=0,eflag,pType=0,pSize=0,logX=0,logY=0; int lasti; char *graphName; char *tagstring; Tcl_FreeProc *freeProcPtr; int pts_per_pt, allocPts, usedPts; int i,seg; int LOD=0; double nsum, rx_LOD, rxsum, rysum, rx2sum, ry2sum, sigmax, sigmay; double LODthresh=0.0, rxm, rym; int LOD_summing, LOD_summed=0; char xstring[30]=""; char ystring[30]=""; static struct { char *Name; int nLines; struct { double x, y; } lines[16]; } pointShapes[] = { { "Cross", 5, { /* These 99s should be DBL_MAX, but */ /* Borland C++ (Windoze) complains */ { 1, 0}, {-1, 0}, {99.0, 99.0}, { 0, 1}, { 0, -1} } }, { "Diamond", 5, { { 1, 0}, { 0, 1}, {-1, 0}, { 0, -1}, { 1, 0} } }, { "Box", 5, { { 1, 1}, {-1, 1}, {-1, -1}, { 1, -1}, { 1, 1} } }, { "Octagon", 9, { { 1.000, 0.000}, { 0.707, 0.707}, { 0.000, 1.000}, {-0.707, 0.707}, {-1.000, 0.000}, {-0.707, -0.707}, { 0.000, -1.000}, { 0.707, -0.707}, { 1.000, 0.000} } }, { "Triangle", 4, { { 1, 1}, { 0, -1}, {-1, 1}, { 1, 1}, } }, { "Inv. Triangle", 4, { { 1, -1}, { 0, 1}, {-1, -1}, { 1, -1}, } }, { "Dot", 1, { { 0.0, 0.0} } }, { "", 0 } }; /* objc should be 0*/ lasti = 0; x_vect = NULL; y_vect = NULL; z_vect = NULL; x_err = NULL; y_err = NULL; x_vector = NULL; y_vector = NULL; x_error = NULL; y_error = NULL; z_vector = NULL; tagstring = Tk_CanvasTagsPrintProc((ClientData) NULL, Tk_CanvasTkwin(canvas), (char *)itemPtr, 0, &freeProcPtr); curve_ptr = powCurvePtr->curveObjectPtr; if ((curve_ptr->x_vector)!= NULL ) { x_vect = (curve_ptr->x_vector)->dataptr; x_vector = curve_ptr->x_vector; } if ((curve_ptr->x_error)!= NULL) { x_err = (curve_ptr->x_error)->dataptr; x_error = curve_ptr->x_error; } if ((curve_ptr->y_vector)!= NULL){ y_vect = (curve_ptr->y_vector)->dataptr; y_vector = curve_ptr->y_vector; } if ((curve_ptr->y_error)!= NULL) { y_err = (curve_ptr->y_error)->dataptr; y_error = curve_ptr->y_error; } if ((curve_ptr->z_vector)!= NULL){ z_vect = (curve_ptr->z_vector)->dataptr; z_vector = curve_ptr->z_vector; } xoff = 0; yoff = 0; xeoff = 0; yeoff = 0; if (x_vector != NULL) xoff = x_vector->offset; if (y_vector != NULL) yoff = y_vector->offset; if (x_error != NULL) xeoff = x_error->offset; if (y_error != NULL) yeoff = y_error->offset; /* get the canvas coordinates for the axes box */ Tcl_VarEval( interp, Tk_PathName(Tk_CanvasTkwin(canvas)), " coords ", powCurvePtr->graphObjectPtr->graph_name,"box", (char *) NULL); Tcl_SplitList(interp,Tcl_GetStringResult(interp),&n,&bboxptr); /* (x0,y0) -- lower left */ /* (x1,y1) -- upper right */ Tcl_GetDouble(interp,bboxptr[0],&x0); Tcl_GetDouble(interp,bboxptr[3],&y0); Tcl_GetDouble(interp,bboxptr[2],&x1); Tcl_GetDouble(interp,bboxptr[1],&y1); len = strlen(powCurvePtr->graphObjectPtr->graph_name)+15; idxStr = (char *) ckalloc( len*sizeof(char) ); sprintf(idxStr, "%s,%s", "graphType", powCurvePtr->graphObjectPtr->graph_name); graphType = Tcl_GetVar2(interp,"powPlotParam",idxStr,TCL_GLOBAL_ONLY); ckfree(idxStr); len = strlen(powCurvePtr->graphObjectPtr->graph_name)+15; idxStr = (char *) ckalloc( len*sizeof(char) ); sprintf(idxStr, "%s,%s", "zoomed", powCurvePtr->graphObjectPtr->graph_name); zoomed = atoi(Tcl_GetVar2(interp,"powPlotParam",idxStr,TCL_GLOBAL_ONLY)); ckfree(idxStr); xCount = atoi(Tcl_GetVar2(interp,"xCount",powCurvePtr->graphObjectPtr->graph_name,TCL_GLOBAL_ONLY)); yCount = atoi(Tcl_GetVar2(interp,"yCount",powCurvePtr->graphObjectPtr->graph_name,TCL_GLOBAL_ONLY)); graph = powCurvePtr->graphObjectPtr; graphName = powCurvePtr->graphObjectPtr->graph_name; strcpy(curve_ptr->WCS.graphName, graphName); coordSel = atoi(Tcl_GetVar2(interp,"powWCSName",graphName,TCL_GLOBAL_ONLY)); /* Chai 06/29/2007: We are not actually fliping the coordinates on the canvas. If tk allows this, then there is no need to do the following. What the logic below is to trick pow to think that the point on the canvas has been flipped. The xCount and yCount indicate if the graph has been flipped before. So if X has been previously flipped, the next flipping occurs on Y, the logic inside ..Count % 2 will make sure the information on previous flip still exists. */ /* Chai 06/29/2007: At this point, graph already know if it has been flipped. xleft/xright ybot/ytop value(s) has already been swapped and x0, y0, x1, y1 have all been taken care of. */ rx0 = graph->xleft; ry0 = graph->ybot; rx1 = graph->xright; ry1 = graph->ytop; ckfree((void *)bboxptr); xmagstep = graph->xmagstep; ymagstep = graph->ymagstep; logX = powCurvePtr->logX; logY = powCurvePtr->logY; LOD = powCurvePtr->LOD; lflag = powCurvePtr->lineDisp; pflag = powCurvePtr->pointDisp; eflag = (x_err || y_err); /* Identify the point shape, if points plotted */ pType = 0; if( pflag ) { while( pointShapes[pType].Name[0] ) { if (!strcmp(powCurvePtr->pointType,pointShapes[pType].Name)) break; pType++; } if( !pointShapes[pType].Name[0] ) pType = 0; pSize = powCurvePtr->pointSize; if( powCurvePtr->pointError && eflag ) { eflag = pSize = 0; /* Don't draw errorbars... just the points */ } } /* Allocate enough space to hold every point although some may not be visible on the graph */ if( pflag || eflag || LOD) { pts_per_pt = 0; if( pflag ) pts_per_pt += pointShapes[pType].nLines + 1; if( eflag || LOD) { if( graph->WCS.type[0] ) pts_per_pt += 8; else pts_per_pt += 6; } allocPts = curve_ptr->length * pts_per_pt * 2; pCoordPtr = (double *) ckalloc(sizeof(double) * allocPts); if( !pCoordPtr ) { Tcl_SetResult(interp, "Unable to allocate memory for curve", TCL_VOLATILE); return TCL_ERROR; } } else { pCoordPtr = (double *) NULL; } powCurvePtr->pCoordPtr = pCoordPtr; /* Be more conservative in allocating memory for line coords. */ /* Can range from 0 to 2 x/y pairs/pt, depending on clipping frequency. */ /* Assume an average of 1.5 pairs per point, then realloc as needed. */ /* Another factor of 2 will enter if drawing stair step style (histo). */ if( lflag ) { allocPts = curve_ptr->length * 3 + 30; if( powCurvePtr->stairStep ) { allocPts += allocPts; if( powCurvePtr->boxFill ) allocPts += allocPts; } lCoordPtr = (double *) ckalloc(sizeof(double) * allocPts); if( !lCoordPtr ) { Tcl_SetResult(interp, "Unable to allocate memory for curve", TCL_VOLATILE); return TCL_ERROR; } } else { lCoordPtr = NULL; } powCurvePtr->lCoordPtr = lCoordPtr; /*Keep track of wether we're really doing LOD summing during any given */ /*iteration so we can ignore LOD processing if we aren't */ LOD_summing = 0; /*This should make sure the first point always gets plotted */ rx_LOD = DBL_MAX; nsum = rxsum = rx2sum = rysum = ry2sum = 0; dflag = 0; oldx = oldy = pX[0] = pY[0] = DBL_MAX; /* if Level of Detail averaging is chosen, set the threshold for binning */ if (LOD) { LODthresh = fabs(rx1 - rx0)/ (double) LOD; } if ( graph->WCS.type[0] != '\0' && strcmp(graphType, "binary") == 0 && (xCount % 2 != 0 || yCount % 2 != 0) ) { curve_ptr->WCS.haveWCSinfo = 0; graph->WCS.haveWCSinfo = 0; } for (i=0;ilength;i++) { if (x_vect != NULL) { rx = PowExtractDatum(x_vect,i+xoff); } else rx = i + 1; if (y_vect != NULL) { ry = PowExtractDatum(y_vect,i+yoff); } else ry = i + 1; if (LOD) { if (rx < rx0 || rx > rx1 || ry < ry0 || ry > ry1 /*ignore points off graph*/) { /* LOD may be accumulating, but this point is NULL or off the graph */ /* so don't do anything with it*/ continue; } if (fabs(rx - rx_LOD) < LODthresh) { /* we haven't reached the edge of the LOD bin yet, keep acumulating */ rxsum += rx; rysum += ry; rx2sum += rx*rx; ry2sum += ry*ry; nsum++; LOD_summing = 1; LOD_summed = 0; continue; } else if (LOD_summing) { /* we've reached current LOD, calculate mean value and continue */ rxsum += rx; rysum += ry; rx2sum += rx*rx; ry2sum += ry*ry; nsum++; rx_LOD = rx; rxm = rxsum/nsum; rym = rysum/nsum; sigmax = sqrt(rx2sum/nsum - rxm*rxm); sigmay = sqrt(ry2sum/nsum - rym*rym); rxsum = 0; rx2sum = 0; rysum = 0; ry2sum = 0; nsum = 0; rx = rxm; ry = rym; LOD_summing = 0; LOD_summed = 1; } else { /* just a normal point and we haven't done any LOD. Reset "mark" */ /* for LOD averaging */ rx_LOD = rx; LOD_summed = 0; } } if( logX && rx<=0.0 ) rx = DBL_MAX; if( logY && ry<=0.0 ) ry = DBL_MAX; if( rx==DBL_MAX || ry==DBL_MAX ) { x = y = DBL_MAX; } else { /* Shouldn't need to do this if( curve_ptr->WCS.type[0] ) { rx--; ry--; } */ if ( graph->WCS.type[0] != '\0' && strcmp(graphType, "binary") == 0 && (xCount % 2 != 0 || yCount % 2 != 0) ) { if (xCount % 2 != 0) { WCScdeltX = graph->WCS.wcs[coordSel].cdelt[0]; graph->WCS.wcs[coordSel].cdelt[0] *= -1.0f; } if ( yCount % 2 != 0) { WCScdeltY = graph->WCS.wcs[coordSel].cdelt[1]; graph->WCS.wcs[coordSel].cdelt[1] *= -1.0f; } } if( PowPixToPos( (logX ? log10(rx): rx), (logY ? log10(ry): ry), &curve_ptr->WCS, &x, &y) != TCL_OK ) return TCL_ERROR; if( PowPosToPix( x, y, &graph->WCS, &x, &y) != TCL_OK ) return TCL_ERROR; if ( graph->WCS.type[0] != '\0' && strcmp(graphType, "binary") == 0 && (xCount % 2 != 0 || yCount % 2 != 0) ) { if (xCount % 2 != 0) { graph->WCS.wcs[coordSel].cdelt[0] = WCScdeltX; } if ( yCount % 2 != 0) { graph->WCS.wcs[coordSel].cdelt[1] = WCScdeltY; } } if ( graph->WCS.type[0] == '\0' && strcmp(graphType, "binary") == 0 && xCount % 2 != 0 ) { /* at this point, in graph and curve WCS, the right x is the original left x. */ x = x0 + (-1.0 * x) * xmagstep; } else { x = x0 + x * xmagstep; } if ( graph->WCS.type[0] == '\0' && strcmp(graphType, "binary") == 0 && yCount % 2 != 0 ) { y = y0 - (-1.0 * y) * ymagstep; } else { y = y0 - y * ymagstep; } } /***************************************************************/ /* If we have string data for "z" create the canvas text */ /***************************************************************/ if (z_vect != NULL && z_vect->data_type == STRING_DATA && (x >= x0 && x <= x1) && (y <= y0 && y >= y1) ) { sprintf(xstring," %lf ",x); sprintf(ystring," %lf ",y); Tcl_VarEval( interp, Tk_PathName(Tk_CanvasTkwin(canvas)), " create text ",xstring,ystring," -text ", ((char **)(z_vect->data_array))[i], " -tags {",tagstring,"}", (char *) NULL); } /*************************************************************/ /* DRAW THE POINT AND ERRORBARS FOR THIS POINT */ /*************************************************************/ if (pflag && (x >= x0 && x <= x1) && (y <= y0 && y >= y1) ) { /* Load xe/ye[0] with real error value... fill in [1-4] with vector offset in each of 4 directions */ if( x_err || y_err || LOD_summed) { if (x_err != NULL) { *xe = PowExtractDatum(x_err,i+xeoff); } else { *xe = 0.0; } if (LOD_summed) { *xe = sigmax; } if (y_err != NULL) { *ye = PowExtractDatum(y_err,i+yeoff); } else { *ye = 0.0; } if (LOD_summed) { *ye = sigmay; } if( *xe || *ye ) { if( graph->WCS.type[0] ) { /* In non rectilinear coordinates... must do all 4 sides */ PowPixToPos( rx+xe[0], ry , &curve_ptr->WCS, xe+1, ye+1 ); PowPixToPos( rx , ry+ye[0], &curve_ptr->WCS, xe+2, ye+2 ); PowPixToPos( rx-xe[0], ry , &curve_ptr->WCS, xe+3, ye+3 ); PowPixToPos( rx , ry-ye[0], &curve_ptr->WCS, xe+4, ye+4 ); for( seg=1; seg<5; seg++ ) { PowPosToPix(xe[seg], ye[seg], &graph->WCS, xe+seg, ye+seg ); xe[seg] = x0 + xe[seg] * xmagstep - x; ye[seg] = y0 - ye[seg] * ymagstep - y; } } else if( logX || logY ) { #define LOG10(x) ( (x)>0.0 ? log10(x) : -300 ) PowPixToPos( (logX ? LOG10(rx+xe[0]): rx+xe[0]), (logY ? LOG10(ry+ye[0]): ry+ye[0]), &curve_ptr->WCS, xe+1, ye+2 ); PowPixToPos( (logX ? LOG10(rx-xe[0]): rx-xe[0]), (logY ? LOG10(ry-ye[0]): ry-ye[0]), &curve_ptr->WCS, xe+3, ye+4 ); PowPosToPix(xe[1], ye[2], &graph->WCS, xe+1, ye+2 ); PowPosToPix(xe[3], ye[4], &graph->WCS, xe+3, ye+4 ); xe[1] = x0 + xe[1] * xmagstep - x; ye[2] = y0 - ye[2] * ymagstep - y; xe[3] = x0 + xe[3] * xmagstep - x; ye[4] = y0 - ye[4] * ymagstep - y; ye[1] = xe[2] = ye[3] = xe[4] = 0.0; } else { /* In rectilinear coords... do one corner and copy */ PowPixToPos( rx+xe[0], ry+ye[0], &curve_ptr->WCS, xe+1, ye+1 ); PowPosToPix( xe[1], ye[1], &graph->WCS, xe+1, ye+1 ); xe[3] = - (xe[1] = x0 + xe[1] * xmagstep - x); ye[4] = - (ye[2] = y0 - ye[1] * ymagstep - y); ye[1] = xe[2] = ye[3] = xe[4] = 0.0; } } } #define CLIP(x,min,max) ( (x)<(min) ? (min) : ( (x)>(max) ? (max) : (x) ) ) if( eflag || LOD_summed ) { /* Draw error bars */ if( graph->WCS.type[0] ) { if( *xe ) { *(pCoordPtr++) = CLIP(x + xe[1],x0,x1); *(pCoordPtr++) = CLIP(y + ye[1],y1,y0); *(pCoordPtr++) = x; *(pCoordPtr++) = y; *(pCoordPtr++) = CLIP(x + xe[3],x0,x1); *(pCoordPtr++) = CLIP(y + ye[3],y1,y0); *(pCoordPtr++) = DBL_MAX; *(pCoordPtr++) = DBL_MAX; } if( *ye ) { *(pCoordPtr++) = CLIP(x + xe[2],x0,x1); *(pCoordPtr++) = CLIP(y + ye[2],y1,y0); *(pCoordPtr++) = x; *(pCoordPtr++) = y; *(pCoordPtr++) = CLIP(x + xe[4],x0,x1); *(pCoordPtr++) = CLIP(y + ye[4],y1,y0); *(pCoordPtr++) = DBL_MAX; *(pCoordPtr++) = DBL_MAX; } } else { if( *xe ) { *(pCoordPtr++) = CLIP(x + xe[1],x0,x1); *(pCoordPtr++) = y; *(pCoordPtr++) = CLIP(x + xe[3],x0,x1); *(pCoordPtr++) = y; *(pCoordPtr++) = DBL_MAX; *(pCoordPtr++) = DBL_MAX; } if( *ye ) { *(pCoordPtr++) = x; *(pCoordPtr++) = CLIP(y + ye[2],y1,y0); *(pCoordPtr++) = x; *(pCoordPtr++) = CLIP(y + ye[4],y1,y0); *(pCoordPtr++) = DBL_MAX; *(pCoordPtr++) = DBL_MAX; } } } /* Draw the shape */ if( powCurvePtr->pointError && pSize==0 ) { xp = 0.5*(xe[1]-xe[3]); yp = 0.5*(ye[2]-ye[4]); } else { xp = yp = pSize; } for( seg=0; seg< pointShapes[pType].nLines; seg++ ) { if( pointShapes[pType].lines[seg].x==99.0 ) { *(pCoordPtr++) = DBL_MAX; *(pCoordPtr++) = DBL_MAX; } else { p1 = x + xp * pointShapes[pType].lines[seg].x; q1 = y + yp * pointShapes[pType].lines[seg].y; *(pCoordPtr++) = CLIP(p1,x0,x1); *(pCoordPtr++) = CLIP(q1,y1,y0); } } *(pCoordPtr++) = DBL_MAX; *(pCoordPtr++) = DBL_MAX; } /*************************************************************/ /* DRAW THE LINE AND ERRORBARS FOR THIS POINT */ /*************************************************************/ if( lflag ) { /* Check lCoordPtr length */ usedPts = (lCoordPtr - powCurvePtr->lCoordPtr); if( allocPts - usedPts < 30 ) { printf( "Must realloc lCoordPtr: used=%d alloc=%d\n", usedPts, allocPts ); allocPts += (curve_ptr->length>>2) + 30; lCoordPtr = (double *)ckrealloc( (char*)powCurvePtr->lCoordPtr, sizeof(double) * allocPts ); if( lCoordPtr ) { powCurvePtr->lCoordPtr = lCoordPtr; lCoordPtr += usedPts; } else { /* Memory error!!! */ printf("Couldn't allocate enough memory for PowCurve coords\n"); ckfree( (char*)powCurvePtr->lCoordPtr ); powCurvePtr->lCoordPtr = NULL; powCurvePtr->numLines = 0; return TCL_ERROR; } } if( powCurvePtr->stairStep ) { if( powCurvePtr->boxFill ) { if( pX[0]==DBL_MAX || pY[0]==DBL_MAX ) { nPts = 0; /* Setup to draw inital box on next pass */ PowPixToPos( 0.0, 0.0, &curve_ptr->WCS, pX+1, pY+1 ); PowPosToPix( pX[1], pY[1], &graph->WCS, pX+1, &histY ); histY = y0 - histY * ymagstep; if( histY>y0 ) histY=y0; if( histYx1 ? x1 : pX[1]) ); pY[1] = histY; pX[2] = pX[1]; pY[2] = ( pY[0]>y0 ? y0 : (pY[0]x1 ? x1 : histX) ); pY[3] = pY[2]; pX[4] = pX[3]; pY[4] = histY; pX[5] = DBL_MAX; pY[5] = DBL_MAX; if( pX[1]!=pX[3] && pY[1]!=pY[2] ) { for( nPts=1; nPts<=5; nPts++ ) { *(lCoordPtr++) = pX[nPts]; *(lCoordPtr++) = pY[nPts]; } } if( i==curve_ptr->length-1 && x!=DBL_MAX ) { histX = x + x - histX; pX[1] = pX[4]; pY[1] = pY[4]; pX[2] = pX[1]; pY[2] = ( y>y0 ? y0 : (yx1 ? x1 : histX) ); pY[3] = pY[2]; pX[4] = pX[3]; pY[4] = histY; pX[5] = DBL_MAX; pY[5] = DBL_MAX; if( pX[1]!=pX[3] && pY[1]!=pY[2] ) { for( nPts=1; nPts<=5; nPts++ ) { *(lCoordPtr++) = pX[nPts]; *(lCoordPtr++) = pY[nPts]; } } } nPts = -1; } } else if( pX[0]==DBL_MAX || pY[0]==DBL_MAX ) { nPts = 0; /* Setup to draw inital box on next pass */ PowPixToPos( 0.0, 0.0, &curve_ptr->WCS, pX+1, pY+1 ); PowPosToPix( pX[1], pY[1], &graph->WCS, pX+1, &histY ); histY = y0 - histY * ymagstep; } else if( x==DBL_MAX || y==DBL_MAX ) { nPts = 3; /* This point terminates histogram. Close box. */ pX[1] = pX[0]+pX[0]-histX; pY[1] = pY[0]; pX[2] = pX[1]; pY[2] = histY; pX[3] = DBL_MAX; pY[3] = DBL_MAX; } else { histX = 0.5*(pX[0]+x); if( nPts==0 ) { /* Initial box needs to be drawn */ nPts = 2; pX[1] = pX[0] - histX + pX[0]; pY[1] = histY; pX[2] = pX[1]; pY[2] = pY[0]; } else nPts = 0; nPts++; pX[nPts] = histX; pY[nPts] = pY[0]; nPts++; pX[nPts] = histX; pY[nPts] = y; if( i==curve_ptr->length-1 && x!=DBL_MAX ) { histX = x + x - histX; nPts++; pX[nPts] = histX; pY[nPts] = y; nPts++; pX[nPts] = histX; pY[nPts] = histY; } } } else { nPts = 1; pX[1] = x; pY[1] = y; } pX[0] = x; pY[0] = y; for( n=1; n<=nPts; n++ ) { x = pX[n]; y = pY[n]; if( x==DBL_MAX || y==DBL_MAX ) { if( dflag ) { /* Terminate line segment. Go to next point */ dflag = 0; if( powCurvePtr->stairStep && oldx!=DBL_MAX ) { *(lCoordPtr++) = oldx; *(lCoordPtr++) = oldy; } *(lCoordPtr++) = DBL_MAX; *(lCoordPtr++) = DBL_MAX; } } else if( (x >= x0 && x <= x1) && (y <= y0 && y >= y1) ) { if( !dflag && oldx!=DBL_MAX) { /* Last point off graph... Find entrance point */ if( oldxx1 ) { oldy += (y-oldy)/(x-oldx)*(x1-oldx); oldx = x1; } if( oldy>y0 ) { oldx += (x-oldx)/(y-oldy)*(y0-oldy); oldy = y0; } else if( oldyx1 ) { mody += (mody-oldy)/(modx-oldx)*(x1-modx); modx = x1; } if( mody>y0 ) { modx += (modx-oldx)/(mody-oldy)*(y0-mody); mody = y0; } else if( modyx1 && x>x1) || (oldyy0 && y>y0) ) ) { if( oldxx1 ) { oldy += (y-oldy)/(x-oldx)*(x1-oldx); oldx = x1; } if( oldy>y0 ) { oldx += (x-oldx)/(y-oldy)*(y0-oldy); oldy = y0; } else if( oldy=x0 && oldx<=x1) && (oldy<=y0 && oldy>=y1) ) { modx = x; mody = y; if( modxx1 ) { mody += (mody-oldy)/(modx-oldx)*(x1-modx); modx = x1; } if( mody>y0 ) { modx += (modx-oldx)/(mody-oldy)*(y0-mody); mody = y0; } else if( modynumPoints = (int)((pCoordPtr - powCurvePtr->pCoordPtr)/2.0); if( powCurvePtr->numPoints==0 ) { ckfree( (char*)powCurvePtr->pCoordPtr ); powCurvePtr->pCoordPtr=NULL; } powCurvePtr->numLines = (int)((lCoordPtr - powCurvePtr->lCoordPtr)/2.0); if( powCurvePtr->numLines==0 ) { ckfree( (char*)powCurvePtr->lCoordPtr ); powCurvePtr->lCoordPtr=NULL; } ComputePowCurveBbox(canvas,powCurvePtr); return TCL_OK; } /* *-------------------------------------------------------------- * * ConfigurePowCurve -- * * This procedure is invoked to configure various aspects * of a powCurve item such as its background color. * * Results: * A standard Tcl result code. If an error occurs, then * an error message is left in the interp's result. * * Side effects: * Configuration information, such as colors and stipple * patterns, may be set for itemPtr. * *-------------------------------------------------------------- */ int ConfigurePowCurve(interp, canvas, itemPtr, objc, objv, flags) Tcl_Interp *interp; /* Used for error reporting. */ Tk_Canvas canvas; /* Canvas containing itemPtr. */ Tk_Item *itemPtr; /* PowCurve item to reconfigure. */ int objc; /* Number of elements in argv. */ Tcl_Obj *CONST objv[]; /* Arguments describing things to configure. */ int flags; /* Flags to pass to Tk_ConfigureWidget. */ { PowCurveItem *powCurvePtr = (PowCurveItem *) itemPtr; XGCValues gcValues; GC newGC; unsigned long mask; Tk_Window tkwin; Tk_State state; XColor *color; tkwin = Tk_CanvasTkwin(canvas); if (Tk_ConfigureWidget(interp, tkwin, configSpecs, objc, (const char**)objv, (char *) powCurvePtr, flags|TK_CONFIG_OBJS) != TCL_OK) { return TCL_ERROR; } newGC = powCurvePtr->pOutline.gc; color = powCurvePtr->pOutline.color; powCurvePtr->pOutline = powCurvePtr->lOutline; powCurvePtr->pOutline.gc = newGC; powCurvePtr->pOutline.dash.number=0; powCurvePtr->pOutline.width=1; powCurvePtr->pOutline.color=color; /* * A few of the options require additional processing, such as * graphics contexts. */ state = itemPtr->state; if(state == TK_STATE_NULL) { state = ((TkCanvas *)canvas)->canvas_state; } if (powCurvePtr->lOutline.activeWidth > powCurvePtr->lOutline.width || powCurvePtr->lOutline.activeDash.number > 0 || powCurvePtr->lOutline.activeColor != NULL || powCurvePtr->lOutline.activeStipple != None) { itemPtr->redraw_flags |= TK_ITEM_STATE_DEPENDANT; } else { itemPtr->redraw_flags &= ~TK_ITEM_STATE_DEPENDANT; } mask = Tk_ConfigOutlineGC(&gcValues, canvas, itemPtr, &(powCurvePtr->lOutline)); if (mask) { gcValues.cap_style = powCurvePtr->capStyle; mask |= GCCapStyle; gcValues.join_style = powCurvePtr->joinStyle; mask |= GCJoinStyle; newGC = Tk_GetGC(tkwin, mask, &gcValues); gcValues.line_width = 0; } else { newGC = None; } if (powCurvePtr->lOutline.gc != None) { Tk_FreeGC(Tk_Display(tkwin), powCurvePtr->lOutline.gc); } powCurvePtr->lOutline.gc = newGC; mask = Tk_ConfigOutlineGC(&gcValues, canvas, itemPtr, &(powCurvePtr->pOutline)); if (mask) { gcValues.cap_style = powCurvePtr->capStyle; mask |= GCCapStyle; gcValues.join_style = powCurvePtr->joinStyle; mask |= GCJoinStyle; newGC = Tk_GetGC(tkwin, mask, &gcValues); gcValues.line_width = 0; } else { newGC = None; } if (powCurvePtr->pOutline.gc != None) { Tk_FreeGC(Tk_Display(tkwin), powCurvePtr->pOutline.gc); } powCurvePtr->pOutline.gc = newGC; if ((state==TK_STATE_HIDDEN)) { ComputePowCurveBbox(canvas, powCurvePtr); return TCL_OK; } ComputePowCurveBbox(canvas, powCurvePtr); return TCL_OK; } /* *-------------------------------------------------------------- * * DeletePowCurve -- * * This procedure is called to clean up the data structure * associated with a powCurve item. * * Results: * None. * * Side effects: * Resources associated with itemPtr are released. * *-------------------------------------------------------------- */ void DeletePowCurve(canvas, itemPtr, display) Tk_Canvas canvas; /* Info about overall canvas widget. */ Tk_Item *itemPtr; /* Item that is being deleted. */ Display *display; /* Display containing window for * canvas. */ { PowCurveItem *powCurvePtr = (PowCurveItem *) itemPtr; Tk_DeleteOutline(display, &(powCurvePtr->lOutline)); if (powCurvePtr->pOutline.gc != None) { Tk_FreeGC(display, powCurvePtr->pOutline.gc); } if( powCurvePtr->pCoordPtr ) ckfree( (char*)powCurvePtr->pCoordPtr ); if( powCurvePtr->lCoordPtr ) ckfree( (char*)powCurvePtr->lCoordPtr ); } /* *-------------------------------------------------------------- * * ComputePowCurveBbox -- * * This procedure is invoked to compute the bounding box of * all the pixels that may be drawn as part of a powCurve. * * Results: * None. * * Side effects: * The fields x1, y1, x2, and y2 are updated in the header * for itemPtr. * *-------------------------------------------------------------- */ void ComputePowCurveBbox(canvas, powCurvePtr) Tk_Canvas canvas; /* Canvas that contains item. */ PowCurveItem *powCurvePtr; /* Item whose bbox is to be * recomputed. */ { double *coordPtr; int i, intWidth; double width; Tk_State state = powCurvePtr->header.state; Tk_TSOffset *tsoffset; if(state == TK_STATE_NULL) { state = ((TkCanvas *)canvas)->canvas_state; } if (state==TK_STATE_HIDDEN || !(powCurvePtr->pCoordPtr || powCurvePtr->lCoordPtr) ) { powCurvePtr->header.x1 = -1; powCurvePtr->header.x2 = -1; powCurvePtr->header.y1 = -1; powCurvePtr->header.y2 = -1; return; } width = powCurvePtr->lOutline.width; if (((TkCanvas *)canvas)->currentItemPtr == (Tk_Item *)powCurvePtr) { if (powCurvePtr->lOutline.activeWidth>width) { width = powCurvePtr->lOutline.activeWidth; } } else if (state==TK_STATE_DISABLED) { if (powCurvePtr->lOutline.disabledWidth>0) { width = powCurvePtr->lOutline.disabledWidth; } } if( powCurvePtr->pCoordPtr ) { powCurvePtr->header.x1 = powCurvePtr->header.x2 = (int) powCurvePtr->pCoordPtr[0]; powCurvePtr->header.y1 = powCurvePtr->header.y2 = (int) powCurvePtr->pCoordPtr[1]; } else { powCurvePtr->header.x1 = powCurvePtr->header.x2 = (int) powCurvePtr->lCoordPtr[0]; powCurvePtr->header.y1 = powCurvePtr->header.y2 = (int) powCurvePtr->lCoordPtr[1]; } /* * Compute the bounding box of all the points in the powCurve, * then expand in all directions by the powCurve's width to take * care of butting or rounded corners and projecting or * rounded caps. This expansion is an overestimate (worst-case * is square root of two over two) but it's simple. Don't do * anything special for curves. This causes an additional * overestimate in the bounding box, but is faster. */ for (i = 0, coordPtr = powCurvePtr->pCoordPtr; i < powCurvePtr->numPoints; i++, coordPtr += 2) { if( *coordPtr!=DBL_MAX ) TkIncludePoint((Tk_Item *) powCurvePtr, coordPtr); } for (i = 0, coordPtr = powCurvePtr->lCoordPtr; i < powCurvePtr->numLines; i++, coordPtr += 2) { if( *coordPtr!=DBL_MAX ) TkIncludePoint((Tk_Item *) powCurvePtr, coordPtr); } width = powCurvePtr->lOutline.width; if (width < 1.0) { width = 1.0; } tsoffset = &powCurvePtr->lOutline.tsoffset; if (tsoffset->flags & TK_OFFSET_INDEX) { double *coordPtr; if( powCurvePtr->pCoordPtr ) { coordPtr = powCurvePtr->pCoordPtr + (tsoffset->flags & ~TK_OFFSET_INDEX); if (tsoffset->flags <= 0) { coordPtr = powCurvePtr->pCoordPtr; } if (tsoffset->flags > (powCurvePtr->numPoints * 2)) { coordPtr = powCurvePtr->pCoordPtr + (powCurvePtr->numPoints * 2); } } else { coordPtr = powCurvePtr->lCoordPtr + (tsoffset->flags & ~TK_OFFSET_INDEX); if (tsoffset->flags <= 0) { coordPtr = powCurvePtr->lCoordPtr; } if (tsoffset->flags > (powCurvePtr->numLines * 2)) { coordPtr = powCurvePtr->lCoordPtr + (powCurvePtr->numLines * 2); } } tsoffset->xoffset = (int)(coordPtr[0]); tsoffset->yoffset = (int)(coordPtr[1]); } else { if (tsoffset->flags & TK_OFFSET_LEFT) { tsoffset->xoffset = powCurvePtr->header.x1; } else if (tsoffset->flags & TK_OFFSET_CENTER) { tsoffset->xoffset = (powCurvePtr->header.x1 + powCurvePtr->header.x2)/2; } else if (tsoffset->flags & TK_OFFSET_RIGHT) { tsoffset->xoffset = powCurvePtr->header.x2; } if (tsoffset->flags & TK_OFFSET_TOP) { tsoffset->yoffset = powCurvePtr->header.y1; } else if (tsoffset->flags & TK_OFFSET_MIDDLE) { tsoffset->yoffset = (powCurvePtr->header.y1 + powCurvePtr->header.y2)/2; } else if (tsoffset->flags & TK_OFFSET_BOTTOM) { tsoffset->yoffset = powCurvePtr->header.y2; } } intWidth = (int) (width + 0.5); powCurvePtr->header.x1 -= intWidth; powCurvePtr->header.x2 += intWidth; powCurvePtr->header.y1 -= intWidth; powCurvePtr->header.y2 += intWidth; if (powCurvePtr->curveObjectPtr->length==1) { return; } /* * Add one more pixel of fudge factor just to be safe (e.g. * X may round differently than we do). */ powCurvePtr->header.x1 -= 1; powCurvePtr->header.x2 += 1; powCurvePtr->header.y1 -= 1; powCurvePtr->header.y2 += 1; } /* *-------------------------------------------------------------- * * DisplayPowCurve -- * * This procedure is invoked to draw a powCurve item in a given * drawable. * * Results: * None. * * Side effects: * ItemPtr is drawn in drawable using the transformation * information in canvas. * *-------------------------------------------------------------- */ void DisplayPowCurve(canvas, itemPtr, display, drawable, x_reg, y_reg, width_reg, height_reg) Tk_Canvas canvas; /* Canvas that contains item. */ Tk_Item *itemPtr; /* Item to be displayed. */ Display *display; /* Display on which to draw item. */ Drawable drawable; /* Pixmap or window in which to draw * item. */ int x_reg, y_reg, width_reg, height_reg ;/* Describes region of canvas that * must be redisplayed (not used). */ { PowCurveItem *powCurvePtr = (PowCurveItem *) itemPtr; XPoint staticPoints[100]; XPoint *pointPtr; XPoint *linePtr; XRectangle tmpRect; double *coordPtr, *dPtr; int i, j, numPoints, numLines; struct { double x1,y1,x2,y2; } clipbox, bbox; int clipped; Tk_State state = itemPtr->state; Pixmap stipple = powCurvePtr->lOutline.stipple; if( powCurvePtr->hidden && (powCurvePtr->numPoints + powCurvePtr->numLines)>10000 ) return; if (drawable == None) { return; } if (powCurvePtr->lOutline.gc==None) { return; } /* printf("Draw...%s %3d %3d %3d %3d : %6d %6d\n", powCurvePtr->graphObjectPtr->graph_name, x_reg, y_reg, width_reg, height_reg, powCurvePtr->numPoints, powCurvePtr->numLines); */ clipbox.x1 = x_reg - 1; /* include a +-1 pixel border */ clipbox.y1 = y_reg - 1; clipbox.x2 = x_reg + width_reg + 1; clipbox.y2 = y_reg + height_reg + 1; tmpRect.width = tmpRect.height = 1; if(state == TK_STATE_NULL) { state = ((TkCanvas *)canvas)->canvas_state; } if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) { if (powCurvePtr->lOutline.activeStipple!=None) { stipple = powCurvePtr->lOutline.activeStipple; } } else if (state==TK_STATE_DISABLED) { if (powCurvePtr->lOutline.disabledStipple!=None) { stipple = powCurvePtr->lOutline.disabledStipple; } } /* * Build up an array of points in screen coordinates. Use a * static array unless the powCurve has an enormous number of points; * in this case, dynamically allocate an array. For smoothed powCurves, * generate the curve points on each redisplay. */ /* Use staticPoints for drawing the Points & Errorbars since each */ /* instance will be very short. But might allocate for lines */ pointPtr = staticPoints; numLines = powCurvePtr->numLines; if (numLines <= 100) { linePtr = staticPoints; } else { linePtr = (XPoint *) ckalloc((unsigned) (numLines * sizeof(XPoint))); } /* * Display powCurve. * If we're stippling, then modify the stipple offset * in the GC. Be sure to reset the offset when done, since the * GC is supposed to be read-only. */ /* Do Points/Errorbars first */ Tk_ChangeOutlineGC(canvas, itemPtr, &(powCurvePtr->pOutline)); clipped = 1; numPoints = 0; for (i = 0, coordPtr = powCurvePtr->pCoordPtr; i < powCurvePtr->numPoints; i++, coordPtr += 2) { if( *coordPtr != DBL_MAX ) { /* Test if this point is inside clipbox */ if( clipped ) { if( coordPtr[0]>=clipbox.x1 && coordPtr[0]<=clipbox.x2 && coordPtr[1]>=clipbox.y1 && coordPtr[1]<=clipbox.y2 ) { clipped = 0; } else if( numPoints==0 ) { bbox.x1 = bbox.x2 = coordPtr[0]; bbox.y1 = bbox.y2 = coordPtr[1]; } else { if( bbox.x1 > coordPtr[0] ) bbox.x1 = coordPtr[0]; else if( bbox.x2 < coordPtr[0] ) bbox.x2 = coordPtr[0]; if( bbox.y1 > coordPtr[1] ) bbox.y1 = coordPtr[1]; else if( bbox.y2 < coordPtr[1] ) bbox.y2 = coordPtr[1]; } } numPoints++; } if( numPoints && (*coordPtr==DBL_MAX || i==powCurvePtr->numPoints-1) ) { if( clipped ) { /* None of points inside clipbox. Does bbox intersect clip? */ if( !(bbox.x2 < clipbox.x1 || bbox.x1 > clipbox.x2 || bbox.y2 < clipbox.y1 || bbox.y1 > clipbox.y2) ) { clipped = 0; } } if( !clipped ) { dPtr = coordPtr - (numPoints+numPoints); if( *coordPtr!=DBL_MAX ) dPtr+=2; for( j=0; j < numPoints; j++, dPtr+=2 ) Tk_CanvasDrawableCoords( canvas, dPtr[0], dPtr[1], &pointPtr[j].x, &pointPtr[j].y ); if( numPoints>2 && powCurvePtr->pointFill ) XFillPolygon(display, drawable, (powCurvePtr->pOutline).gc, pointPtr, numPoints, Convex, CoordModeOrigin); else if( numPoints>1 ) XDrawLines(display, drawable, (powCurvePtr->pOutline).gc, pointPtr, numPoints, CoordModeOrigin); else { tmpRect.x = pointPtr->x; tmpRect.y = pointPtr->y; XFillRectangles( display, drawable, (powCurvePtr->pOutline).gc, &tmpRect, 1 ); } } numPoints = 0; clipped = 1; } } Tk_ResetOutlineGC(canvas, itemPtr, &(powCurvePtr->pOutline)); /* Now do the lines */ Tk_ChangeOutlineGC(canvas, itemPtr, &(powCurvePtr->lOutline)); clipped = 1; numPoints = 0; for (i = 0, coordPtr = powCurvePtr->lCoordPtr; i < powCurvePtr->numLines; i++, coordPtr += 2) { if( *coordPtr != DBL_MAX ) { /* Test if this point is inside clipbox */ if( clipped ) { if( coordPtr[0]>=clipbox.x1 && coordPtr[0]<=clipbox.x2 && coordPtr[1]>=clipbox.y1 && coordPtr[1]<=clipbox.y2 ) { clipped = 0; } else if( numPoints==0 ) { bbox.x1 = bbox.x2 = coordPtr[0]; bbox.y1 = bbox.y2 = coordPtr[1]; } else { if( bbox.x1 > coordPtr[0] ) bbox.x1 = coordPtr[0]; else if( bbox.x2 < coordPtr[0] ) bbox.x2 = coordPtr[0]; if( bbox.y1 > coordPtr[1] ) bbox.y1 = coordPtr[1]; else if( bbox.y2 < coordPtr[1] ) bbox.y2 = coordPtr[1]; } } numPoints++; } if( numPoints && (*coordPtr==DBL_MAX || i==powCurvePtr->numLines-1) ) { if( clipped ) { /* None of points inside clipbox. Does bbox intersect clip? */ if( !(bbox.x2 < clipbox.x1 || bbox.x1 > clipbox.x2 || bbox.y2 < clipbox.y1 || bbox.y1 > clipbox.y2) ) { clipped = 0; } } if( !clipped ) { dPtr = coordPtr - (numPoints+numPoints); if( *coordPtr!=DBL_MAX ) dPtr+=2; for( j=0; j < numPoints; j++, dPtr+=2 ) Tk_CanvasDrawableCoords( canvas, dPtr[0], dPtr[1], &linePtr[j].x, &linePtr[j].y ); if( powCurvePtr->stairStep && powCurvePtr->boxFill ) { if( linePtr[0].xlOutline).gc, &tmpRect, 1 ); } else { XDrawLines(display, drawable, (powCurvePtr->lOutline).gc, linePtr, numPoints, CoordModeOrigin); } } numPoints = 0; clipped = 1; } } Tk_ResetOutlineGC(canvas, itemPtr, &(powCurvePtr->lOutline)); if( linePtr!=staticPoints ) ckfree( (char*)linePtr ); } /* *-------------------------------------------------------------- * * PowCurveInsert -- * * Insert coords into a powCurve item at a given index. * * Results: * None. * * Side effects: * The coords in the given item is modified. * *-------------------------------------------------------------- */ void PowCurveInsert(canvas, itemPtr, beforeThis, string) Tk_Canvas canvas; /* Canvas containing text item. */ Tk_Item *itemPtr; /* PowCurve item to be modified. */ int beforeThis; /* Index before which new coordinates * are to be inserted. */ char *string; /* New coordinates to be inserted. */ { PowCurveItem *powCurvePtr = (PowCurveItem *) itemPtr; int length, argc, i; const char **argv = (const char **) NULL; double *new, *coordPtr; Tk_State state = itemPtr->state; if(state == TK_STATE_NULL) { state = ((TkCanvas *)canvas)->canvas_state; } if(!string || !*string) { return; } if ((Tcl_SplitList(((TkCanvas *)canvas)->interp, string, &argc, &argv) != TCL_OK) || argv == NULL || !argc || argc&1) { Tcl_ResetResult(((TkCanvas *)canvas)->interp); if (argv != NULL) { ckfree((char *) argv); } return; } length = 2*powCurvePtr->numPoints; if (beforeThis < 0) { beforeThis = 0; } if (beforeThis > length) { beforeThis = length; } new = (double *) ckalloc((unsigned)(sizeof(double) * (length + argc))); for(i=0; ipCoordPtr[i]; } for(i=0; iinterp,argv[i], new+(i+beforeThis))!=TCL_OK) { Tcl_ResetResult(((TkCanvas *)canvas)->interp); ckfree((char *) new); ckfree((char *) argv); return; } } for(i=beforeThis; ipCoordPtr[i]; } if(powCurvePtr->pCoordPtr) ckfree((char *)powCurvePtr->pCoordPtr); ckfree((char *) argv); powCurvePtr->pCoordPtr = new; powCurvePtr->curveObjectPtr->length = (length + argc)/2; if ((length>3) && (state != TK_STATE_HIDDEN)) { /* * This is some optimizing code that will result that only the part * of the polygon that changed (and the objects that are overlapping * with that part) need to be redrawn. A special flag is set that * instructs the general canvas code not to redraw the whole * object. If this flag is not set, the canvas will do the redrawing, * otherwise I have to do it here. */ itemPtr->redraw_flags |= TK_ITEM_DONT_REDRAW; if (beforeThis>0) {beforeThis -= 2; argc+=2; } if ((beforeThis+argc)x1 = itemPtr->x2 = (int)(powCurvePtr->pCoordPtr[beforeThis]); itemPtr->y1 = itemPtr->y2 = (int)(powCurvePtr->pCoordPtr[beforeThis+1]); coordPtr = powCurvePtr->pCoordPtr+beforeThis+2; for(i=2; iredraw_flags & TK_ITEM_DONT_REDRAW) { double width; int intWidth; width = powCurvePtr->lOutline.width; if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) { if (powCurvePtr->lOutline.activeWidth>width) { width = powCurvePtr->lOutline.activeWidth; } } else if (state==TK_STATE_DISABLED) { if (powCurvePtr->lOutline.disabledWidth>0) { width = powCurvePtr->lOutline.disabledWidth; } } intWidth = (int) (width + 0.5); if (intWidth < 1) { intWidth = 1; } itemPtr->x1 -= intWidth; itemPtr->y1 -= intWidth; itemPtr->x2 += intWidth; itemPtr->y2 += intWidth; Tk_CanvasEventuallyRedraw(canvas, itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2); } ComputePowCurveBbox(canvas, powCurvePtr); } /* *-------------------------------------------------------------- * * PowCurveDeleteCoords -- * * Delete one or more coordinates from a powCurve item. * * Results: * None. * * Side effects: * Characters between "first" and "last", inclusive, get * deleted from itemPtr. * *-------------------------------------------------------------- */ void PowCurveDeleteCoords(canvas, itemPtr, first, last) Tk_Canvas canvas; /* Canvas containing itemPtr. */ Tk_Item *itemPtr; /* Item in which to delete characters. */ int first; /* Index of first character to delete. */ int last; /* Index of last character to delete. */ { PowCurveItem *powCurvePtr = (PowCurveItem *) itemPtr; int count, i, first1, last1; int length = 2*powCurvePtr->numPoints; double *coordPtr; Tk_State state = itemPtr->state; if(state == TK_STATE_NULL) { state = ((TkCanvas *)canvas)->canvas_state; } first &= -2; last &= -2; if (first < 0) { first = 0; } if (last >= length) { last = length-2; } if (first > last) { return; } first1 = first; last1 = last; if(first1>0) first1 -= 2; if(last1= length-2)) { /* * This is some optimizing code that will result that only the part * of the powCurve that changed (and the objects that are overlapping * with that part) need to be redrawn. A special flag is set that * instructs the general canvas code not to redraw the whole * object. If this flag is set, the redrawing has to be done here, * otherwise the general Canvas code will take care of it. */ itemPtr->redraw_flags |= TK_ITEM_DONT_REDRAW; itemPtr->x1 = itemPtr->x2 = (int)(powCurvePtr->pCoordPtr[first1]); itemPtr->y1 = itemPtr->y2 = (int)(powCurvePtr->pCoordPtr[first1+1]); coordPtr = powCurvePtr->pCoordPtr+first1+2; for(i=first1+2; i<=last1; i+=2) { TkIncludePoint(itemPtr, coordPtr); coordPtr+=2; } } count = last + 2 - first; for(i=last+2; ipCoordPtr[i-count] = powCurvePtr->pCoordPtr[i]; } powCurvePtr->curveObjectPtr->length -= count/2; if(itemPtr->redraw_flags & TK_ITEM_DONT_REDRAW) { double width; int intWidth; width = powCurvePtr->lOutline.width; if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) { if (powCurvePtr->lOutline.activeWidth>width) { width = powCurvePtr->lOutline.activeWidth; } } else if (state==TK_STATE_DISABLED) { if (powCurvePtr->lOutline.disabledWidth>0) { width = powCurvePtr->lOutline.disabledWidth; } } intWidth = (int) (width + 0.5); if (intWidth < 1) { intWidth = 1; } itemPtr->x1 -= intWidth; itemPtr->y1 -= intWidth; itemPtr->x2 += intWidth; itemPtr->y2 += intWidth; Tk_CanvasEventuallyRedraw(canvas, itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2); } ComputePowCurveBbox(canvas, powCurvePtr); } /* *-------------------------------------------------------------- * * PowCurveToPoint -- * * Computes the distance from a given point to a given * powCurve, in canvas units. * * Results: * The return value is 0 if the point whose x and y coordinates * are pointPtr[0] and pointPtr[1] is inside the powCurve. If the * point isn't inside the powCurve then the return value is the * distance from the point to the powCurve. * * Side effects: * None. * *-------------------------------------------------------------- */ /* ARGSUSED */ double PowCurveToPoint(canvas, itemPtr, pointPtr) Tk_Canvas canvas; /* Canvas containing item. */ Tk_Item *itemPtr; /* Item to check against point. */ double *pointPtr; /* Pointer to x and y coordinates. */ { double width; Tk_State state = itemPtr->state; PowCurveItem *powCurvePtr = (PowCurveItem *) itemPtr; double *powCurveLines; double bestDist; int numLines; bestDist = 1.0e36; if (!powCurvePtr->curveToPoint) return bestDist; if(state == TK_STATE_NULL) { state = ((TkCanvas *)canvas)->canvas_state; } width = powCurvePtr->lOutline.width; if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) { if (powCurvePtr->lOutline.activeWidth>width) { width = powCurvePtr->lOutline.activeWidth; } } else if (state==TK_STATE_DISABLED) { if (powCurvePtr->lOutline.disabledWidth>0) { width = powCurvePtr->lOutline.disabledWidth; } } numLines = powCurvePtr->numLines; powCurveLines = powCurvePtr->lCoordPtr; if (!numLines || itemPtr->state==TK_STATE_HIDDEN) { return bestDist; } else if (numLines == 1) { bestDist = hypot(powCurveLines[0] - pointPtr[0], powCurveLines[1] - pointPtr[1]) - width/2.0; if (bestDist < 0) bestDist = 0; return bestDist; } /* Deleted a lot of code not needed by PowCanvCurve... for now */ return bestDist; } /* *-------------------------------------------------------------- * * PowCurveToArea -- * * This procedure is called to determine whether an item * lies entirely inside, entirely outside, or overlapping * a given rectangular area. * * Results: * -1 is returned if the item is entirely outside the * area, 0 if it overlaps, and 1 if it is entirely * inside the given area. * * Side effects: * None. * *-------------------------------------------------------------- */ /* ARGSUSED */ int PowCurveToArea(canvas, itemPtr, rectPtr) Tk_Canvas canvas; /* Canvas containing item. */ Tk_Item *itemPtr; /* Item to check against powCurve. */ double *rectPtr; { PowCurveItem *powCurvePtr = (PowCurveItem *) itemPtr; int result; double radius, width; Tk_State state = itemPtr->state; if(state == TK_STATE_NULL) { state = ((TkCanvas *)canvas)->canvas_state; } width = powCurvePtr->lOutline.width; if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) { if (powCurvePtr->lOutline.activeWidth>width) { width = powCurvePtr->lOutline.activeWidth; } } else if (state==TK_STATE_DISABLED) { if (powCurvePtr->lOutline.disabledWidth>0) { width = powCurvePtr->lOutline.disabledWidth; } } radius = (width+1.0)/2.0; /* Delete some code not needed by PowCanvCurve... for now */ result = -1; return result; } /* *-------------------------------------------------------------- * * ScalePowCurve -- * * This procedure is invoked to rescale a powCurve item. * * Results: * None. * * Side effects: * The powCurve referred to by itemPtr is rescaled so that the * following transformation is applied to all point * coordinates: * x' = originX + scaleX*(x-originX) * y' = originY + scaleY*(y-originY) * *-------------------------------------------------------------- */ void ScalePowCurve(canvas, itemPtr, originX, originY, scaleX, scaleY) Tk_Canvas canvas; /* Canvas containing powCurve. */ Tk_Item *itemPtr; /* PowCurve to be scaled. */ double originX, originY; /* Origin about which to scale rect. */ double scaleX; /* Amount to scale in X direction. */ double scaleY; /* Amount to scale in Y direction. */ { PowCurveItem *powCurvePtr = (PowCurveItem *) itemPtr; double *coordPtr; int i; for (i = 0, coordPtr = powCurvePtr->pCoordPtr; i < powCurvePtr->numPoints; i++, coordPtr += 2) { if( *coordPtr!=DBL_MAX ) { coordPtr[0] = originX + scaleX*(*coordPtr - originX); coordPtr[1] = originY + scaleY*(coordPtr[1] - originY); } } for (i = 0, coordPtr = powCurvePtr->lCoordPtr; i < powCurvePtr->numLines; i++, coordPtr += 2) { if( *coordPtr!=DBL_MAX ) { coordPtr[0] = originX + scaleX*(*coordPtr - originX); coordPtr[1] = originY + scaleY*(coordPtr[1] - originY); } } ComputePowCurveBbox(canvas, powCurvePtr); } /* *-------------------------------------------------------------- * * GetPowCurveIndex -- * * Parse an index into a powCurve item and return either its value * or an error. * * Results: * A standard Tcl result. If all went well, then *indexPtr is * filled in with the index (into itemPtr) corresponding to * string. Otherwise an error message is left in * the interp's result. * * Side effects: * None. * *-------------------------------------------------------------- */ int GetPowCurveIndex(interp, canvas, itemPtr, string, indexPtr) Tcl_Interp *interp; /* Used for error reporting. */ Tk_Canvas canvas; /* Canvas containing item. */ Tk_Item *itemPtr; /* Item for which the index is being * specified. */ char *string; /* Specification of a particular coord * in itemPtr's powCurve. */ int *indexPtr; /* Where to store converted index. */ { /* Function not supported */ /* * Some of the paths here leave messages in the interp's result, * so we have to clear it out before storing our own message. */ Tcl_SetResult(interp, (char *) NULL, TCL_STATIC); Tcl_AppendResult(interp, "bad index \"", string, "\"", (char *) NULL); return TCL_ERROR; } /* *-------------------------------------------------------------- * * TranslatePowCurve -- * * This procedure is called to move a powCurve by a given amount. * * Results: * None. * * Side effects: * The position of the powCurve is offset by (xDelta, yDelta), and * the bounding box is updated in the generic part of the item * structure. * *-------------------------------------------------------------- */ void TranslatePowCurve(canvas, itemPtr, deltaX, deltaY) Tk_Canvas canvas; /* Canvas containing item. */ Tk_Item *itemPtr; /* Item that is being moved. */ double deltaX, deltaY; /* Amount by which item is to be * moved. */ { PowCurveItem *powCurvePtr = (PowCurveItem *) itemPtr; double *coordPtr; int i; for (i = 0, coordPtr = powCurvePtr->pCoordPtr; i < powCurvePtr->numPoints; i++, coordPtr += 2) { if( *coordPtr!=DBL_MAX ) { coordPtr[0] += deltaX; coordPtr[1] += deltaY; } } for (i = 0, coordPtr = powCurvePtr->lCoordPtr; i < powCurvePtr->numLines; i++, coordPtr += 2) { if( *coordPtr!=DBL_MAX ) { coordPtr[0] += deltaX; coordPtr[1] += deltaY; } } ComputePowCurveBbox(canvas, powCurvePtr); } /* *-------------------------------------------------------------- * * PowCurveToPostscript -- * * This procedure is called to generate Postscript for * powCurve items. * * Results: * The return value is a standard Tcl result. If an error * occurs in generating Postscript then an error message is * left in the interp's result, replacing whatever used * to be there. If no error occurs, then Postscript for the * item is appended to the result. * * Side effects: * None. * *-------------------------------------------------------------- */ int PowCurveToPostscript(interp, canvas, itemPtr, prepass) Tcl_Interp *interp; /* Leave Postscript or error message * here. */ Tk_Canvas canvas; /* Information about overall canvas. */ Tk_Item *itemPtr; /* Item for which Postscript is * wanted. */ int prepass; /* 1 means this is a prepass to * collect font information; 0 means * final Postscript is being created. */ { PowCurveItem *powCurvePtr = (PowCurveItem *) itemPtr; char buffer[200]; char *style; double width; XColor *lcolor, *pcolor; Pixmap stipple; Tk_State state = itemPtr->state; if(state == TK_STATE_NULL) { state = ((TkCanvas *)canvas)->canvas_state; } width = powCurvePtr->lOutline.width; lcolor = powCurvePtr->lOutline.color; pcolor = powCurvePtr->pOutline.color; stipple = powCurvePtr->lOutline.stipple; if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) { if (powCurvePtr->lOutline.activeWidth>width) { width = powCurvePtr->lOutline.activeWidth; } if (powCurvePtr->lOutline.activeColor!=NULL) { lcolor = powCurvePtr->lOutline.activeColor; pcolor = powCurvePtr->pOutline.activeColor; } if (powCurvePtr->lOutline.activeStipple!=None) { stipple = powCurvePtr->lOutline.activeStipple; } } else if (state==TK_STATE_DISABLED) { if (powCurvePtr->lOutline.disabledWidth>0) { width = powCurvePtr->lOutline.disabledWidth; } if (powCurvePtr->lOutline.disabledColor!=NULL) { lcolor = powCurvePtr->lOutline.disabledColor; pcolor = powCurvePtr->pOutline.disabledColor; } if (powCurvePtr->lOutline.disabledStipple!=None) { stipple = powCurvePtr->lOutline.disabledStipple; } } if (lcolor == NULL || ( (powCurvePtr->numPoints<1 || powCurvePtr->pCoordPtr==NULL) && (powCurvePtr->numLines<1 || powCurvePtr->lCoordPtr==NULL) ) ) { return TCL_OK; } if (powCurvePtr->numPoints==1) { sprintf(buffer, "%.15g %.15g translate %.15g %.15g", powCurvePtr->pCoordPtr[0], Tk_CanvasPsY(canvas, powCurvePtr->pCoordPtr[1]), width/2.0, width/2.0); Tcl_AppendResult(interp, "matrix currentmatrix\n",buffer, " scale 1 0 moveto 0 0 1 0 360 arc\nsetmatrix\n", (char *) NULL); if (Tk_CanvasPsColor(interp, canvas, pcolor) != TCL_OK) { return TCL_ERROR; } if (stipple != None) { Tcl_AppendResult(interp, "clip ", (char *) NULL); if (Tk_CanvasPsStipple(interp, canvas, stipple) != TCL_OK) { return TCL_ERROR; } } else { Tcl_AppendResult(interp, "fill\n", (char *) NULL); } } if (powCurvePtr->numLines==1) { sprintf(buffer, "%.15g %.15g translate %.15g %.15g", powCurvePtr->lCoordPtr[0], Tk_CanvasPsY(canvas, powCurvePtr->lCoordPtr[1]), width/2.0, width/2.0); Tcl_AppendResult(interp, "matrix currentmatrix\n",buffer, " scale 1 0 moveto 0 0 1 0 360 arc\nsetmatrix\n", (char *) NULL); if (Tk_CanvasPsColor(interp, canvas, lcolor) != TCL_OK) { return TCL_ERROR; } if (stipple != None) { Tcl_AppendResult(interp, "clip ", (char *) NULL); if (Tk_CanvasPsStipple(interp, canvas, stipple) != TCL_OK) { return TCL_ERROR; } } else { Tcl_AppendResult(interp, "fill\n", (char *) NULL); } } if( powCurvePtr->numPoints<=1 && powCurvePtr->numLines<=1 ) return TCL_OK; /* * Set powCurve-drawing parameters */ style = "0 setlinecap\n"; if (powCurvePtr->capStyle == CapRound) { style = "1 setlinecap\n"; } else if (powCurvePtr->capStyle == CapProjecting) { style = "2 setlinecap\n"; } Tcl_AppendResult(interp, style, (char *) NULL); style = "0 setlinejoin\n"; if (powCurvePtr->joinStyle == JoinRound) { style = "1 setlinejoin\n"; } else if (powCurvePtr->joinStyle == JoinBevel) { style = "2 setlinejoin\n"; } Tcl_AppendResult(interp, style, (char *) NULL); /* * Generate a path for the powCurve's center-line (do this differently * for straight powCurves and smoothed powCurves). */ { TkCanvas *cnvs = (TkCanvas*)canvas; double *coordPtr; char buffer[200]; int nPts, i; if (Tk_CanvasPsColor(interp, canvas, pcolor) != TCL_OK) { return TCL_ERROR; } coordPtr = powCurvePtr->pCoordPtr; nPts = 0; for ( i=0, coordPtr=powCurvePtr->pCoordPtr; i < powCurvePtr->numPoints; i++, coordPtr += 2) { if( *coordPtr!=DBL_MAX ) { if( nPts ) { sprintf(buffer, "%.15g %.15g lineto\n", coordPtr[0], Tk_PostscriptY(coordPtr[1], cnvs->psInfo)); } else { sprintf(buffer, "%.15g %.15g moveto\n", coordPtr[0], Tk_PostscriptY(coordPtr[1], cnvs->psInfo)); } Tcl_AppendResult(interp, buffer, (char *) NULL); nPts++; } if( nPts && (*coordPtr==DBL_MAX || i == powCurvePtr->numPoints-1) ) { /* * Stroke out the point/error bar. */ if( nPts>2 && powCurvePtr->pointFill ) { if (stipple != None) { Tcl_AppendResult(interp, "clip ", (char *) NULL); if (Tk_CanvasPsStipple(interp, canvas, stipple) != TCL_OK) { return TCL_ERROR; } } else { Tcl_AppendResult(interp, "fill\n", (char *) NULL); } } else if ( nPts==1 ) { if( *coordPtr!=DBL_MAX ) nPts=0; sprintf(buffer, "%.15g %.15g 0.5 0.0 360.0 arc fill\n", coordPtr[-2*nPts], Tk_PostscriptY(coordPtr[-2*nPts+1], cnvs->psInfo)); Tcl_AppendResult(interp, buffer, (char *) NULL); } else if (Tk_CanvasPsOutline( canvas, itemPtr, &(powCurvePtr->pOutline) ) != TCL_OK) { return TCL_ERROR; } nPts = 0; } } if (Tk_CanvasPsColor(interp, canvas, lcolor) != TCL_OK) { return TCL_ERROR; } coordPtr = powCurvePtr->lCoordPtr; nPts = 0; for ( i=0, coordPtr=powCurvePtr->lCoordPtr; i < powCurvePtr->numLines; i++, coordPtr += 2) { if( *coordPtr!=DBL_MAX ) { if( nPts ) { sprintf(buffer, "%.15g %.15g lineto\n", coordPtr[0], Tk_PostscriptY(coordPtr[1], cnvs->psInfo)); } else { sprintf(buffer, "%.15g %.15g moveto\n", coordPtr[0], Tk_PostscriptY(coordPtr[1], cnvs->psInfo)); } Tcl_AppendResult(interp, buffer, (char *) NULL); nPts++; } if( nPts && (*coordPtr==DBL_MAX || i == powCurvePtr->numLines-1) ) { /* * Stroke out the powCurve. */ if ( powCurvePtr->stairStep && powCurvePtr->boxFill ) { Tcl_AppendResult(interp, "fill\n", (char *) NULL); } else { if (Tk_CanvasPsOutline(canvas, itemPtr, &(powCurvePtr->lOutline)) != TCL_OK) { return TCL_ERROR; } } nPts = 0; } } } return TCL_OK; } void outDebugStr(char *title, char *str) { char *p; char currstr[90]; p = str; fprintf(stdout, "Title: <%s>\n", title); fflush(stdout); while (1) { if ( strlen(p) <= 0 ) break; strncpy(currstr, p, 80); currstr[80] = '\0'; fprintf(stdout, "currstr: <%s>\n", currstr); fflush(stdout); p += 80; } } fv5.5/tcltk/pow/PowCmdsClass.tcl0000644000220700000360000001333313224715127015520 0ustar birbylheaproc gPowCmdsClass { args } { return [uplevel #0 PowCmdsClass #auto $args] } itcl::class PowCmdsClass { constructor {} {} destructor {} public { method helpPage { args } method binFactorTool { args } method regionTool { args } method getRegion { args } method getXRange { args } method regions { args } method regionName { args } method setRegionFormat { args } method xrangeTool { args } method xranges { args } method xrangeName { args } method add { objType objName } method array { dchan dName {bitpix "LIST"} {byteOrder ""} } method axes { xscale yscale } method bounds { args } method calculate { newData args } method colormap { args } method close { args } method create { objType objNam args } method contour { args } method cursor { } method curve { args } method delete { args } method draw { args } method graph { args } method init { ncolors colorMode } method position { args } method refresh { args } method remote { args } method remove { args } method scope { {dx ""} {dy ""} } method select { obj name } method size { args } method version { } method wcs { obj wcs } method wcsHeader { gn strlen {str} flag } method wcsHeaderCnt { gn cnt } method wcsLabel { gn label name value } method wcsSetList { gn {list} } } } itcl::body PowCmdsClass::destructor {} { } itcl::body PowCmdsClass::helpPage { args } { return [eval ::powCmds::helpPage $args] } itcl::body PowCmdsClass::setRegionFormat { args } { return [eval ::powCmds::setRegionFormat $args] } itcl::body PowCmdsClass::regionName { args } { return [eval ::powCmds::regionName $args] } itcl::body PowCmdsClass::regions { args } { return [eval ::powCmds::regions $args] } itcl::body PowCmdsClass::getRegion { args } { return [eval ::powCmds::getRegion $args] } itcl::body PowCmdsClass::getXRange { args } { return [eval ::powCmds::getXRange $args] } itcl::body PowCmdsClass::binFactorTool { args } { return [eval ::powCmds::binFactorTool $args] } itcl::body PowCmdsClass::regionTool { args } { return [eval ::powCmds::regionTool $args] } itcl::body PowCmdsClass::xrangeName { args } { return [eval ::powCmds::xrangeName $args] } itcl::body PowCmdsClass::xranges { args } { return [eval ::powCmds::xranges $args] } itcl::body PowCmdsClass::xrangeTool { args } { return [eval ::powCmds::xrangeTool $args] } itcl::body PowCmdsClass::add { objType objName } { return [eval ::powCmds::add $objType $objName] } itcl::body PowCmdsClass::array { dchan dName {bitpix "LIST"} {byteOrder ""} } { return [eval ::powCmds::array $dchan $dName $bitpix $byteOrder ] } itcl::body PowCmdsClass::axes { xscale yscale } { return [eval ::powCmds::axes $xcale $ycale] } itcl::body PowCmdsClass::bounds { args } { return [eval ::powCmds::bounds $args] } itcl::body PowCmdsClass::calculate { newData args } { return [eval ::powCmds::calculate $newData $args] } itcl::body PowCmdsClass::colormap { args } { return [eval ::powCmds::colormap $args] } itcl::body PowCmdsClass::close { args } { return [eval ::powCmds::close $args] } itcl::body PowCmdsClass::create { objType objName {args} } { return [eval ::powCmds::create $objType $objName $args] } itcl::body PowCmdsClass::contour { args } { return [eval ::powCmds::contour $args] } itcl::body PowCmdsClass::cursor { } { return [eval ::powCmds::cursor] } itcl::body PowCmdsClass::curve { args } { return [eval ::powCmds::curve $args] } itcl::body PowCmdsClass::delete { args } { return [eval ::powCmds::delete $args] } itcl::body PowCmdsClass::draw { args } { return [eval ::powCmds::draw $args] } itcl::body PowCmdsClass::graph { args } { set errorFlag [ catch { set returnValue [eval ::powCmds::graph $args] eval ::powCmds::scope 0 } err ] if { $errorFlag } { return $err } return $returnValue } itcl::body PowCmdsClass::init { ncolors colorMode } { return [eval ::powCmds::init $ncolors $colorMode] } itcl::body PowCmdsClass::position { args } { return [eval ::powCmds::position $args] } itcl::body PowCmdsClass::refresh { args } { return [eval ::powCmds::refresh $args] } itcl::body PowCmdsClass::remote { args } { return [eval ::powCmds::remote $args] } itcl::body PowCmdsClass::remove { args } { return [eval ::powCmds::remove $args] } itcl::body PowCmdsClass::scope { {dx ""} {dy ""} } { return [eval ::powCmds::scope $dx $dy] } itcl::body PowCmdsClass::select { obj name } { return [eval ::powCmds::select $obj $name] } itcl::body PowCmdsClass::size { args } { return [eval ::powCmds::size $args] } itcl::body PowCmdsClass::version { } { return [eval ::powCmds::version] } itcl::body PowCmdsClass::wcs { obj {wcs} } { set wcsList {} lappend wcsList $wcs return [eval ::powCmds::wcs $obj $wcsList] } itcl::body PowCmdsClass::wcsHeader { gn strlen {str} flag } { return [eval ::powCmds::wcsHeader $gn $strlen [list $str] $flag ] } itcl::body PowCmdsClass::wcsHeaderCnt { gn cnt } { return [eval ::powCmds::wcsHeaderCnt $gn $cnt] } itcl::body PowCmdsClass::wcsLabel { gn label name value } { return [eval ::powCmds::wcsLabel $gn $label $name $value] } itcl::body PowCmdsClass::wcsSetList { gn list } { return [eval ::powCmds::wcsSetList $gn $list] } fv5.5/tcltk/pow/PowColormap.c0000644000220700000360000005713113224715127015064 0ustar birbylhea#include "pow.h" extern XColor lut_colorcell_defs[256]; extern PictColorTable *PowColorTable; int PowSetupColormap(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[] ) { /* This routine creates a toplevel window with a colormap for that window which has the specified number of cells free in addition to those needed by POW. If force_cmap is non-zero: 0 - Default behavior. Choose the "best" pseudocolor map with enough colorcells available. 1 - Force a new private pseudocolor colormap. 2 - Force truecolor mode. Note, the *images* are truecolor, the visual associated with the POW colormap may be anything, "toplevel -visual best" is used to choose the visual. 3 - Force screen default colormap (WARNING: this may crash application if the default colormap is pseudocolor, or not if you're lucky, or VISU may barf at image startup, you getting the idea that I don't recommend this option; if it's truecolor, this should work as well as option 2 does. ) Returns toplevel path name. All of an application's windows should then use the colormap of this toplevel. */ #if !(defined(__WIN32__) || defined(macintosh)) Tk_Window dotwin; Tk_Window tkwin; Screen *screen; Display *disp; Colormap cmap; int i; XColor *colors; int colormap_size; int screenIndex; unsigned long *pixels; unsigned long *plane_masks; XVisualInfo *visual_info; int ncolors; Status status; Bool tfGotColors; /* True if we got colors from X */ int powCells; #endif char *toplevel; char *options; int free_cells; int force_cmap; if (argc == 2 && (!strcmp(argv[1],"none") || !strcmp(argv[1],"NULL"))) { /* do nothing */ return TCL_OK; } if (argc > 5 || argc < 3 ) { Tcl_SetResult(interp, "usage: powSetupColormap toplevel_name free_cells ?force_cmap? ?options_list?", TCL_VOLATILE); return TCL_ERROR; } toplevel = ckalloc(strlen(argv[1])+5); strcpy(toplevel,argv[1]); Tcl_GetInt(interp,argv[2],&free_cells); if (argc >= 4) { Tcl_GetInt(interp,argv[3],&force_cmap); } else { force_cmap = 0; } if (argc == 5) { options = ckalloc(strlen(argv[4])+1); strcpy(options,argv[4]); } else { options = ckalloc(1); *options = '\0'; } #if defined(__WIN32__) || defined(macintosh) /*In WIN32/mac, just create the toplevel. Pseudocolor mode isn't supported in WIN32/mac because the necessary Xlib calls are missing.*/ Tcl_SetVar(interp,"powPseudoImages","0",TCL_GLOBAL_ONLY); return Tcl_VarEval(interp, "toplevel ",toplevel, " -visual default ",options,(char *)NULL); /* return Tcl_VarEval(interp, "toplevel ",toplevel, " -visual best ",options,(char *)NULL); */ #else if (force_cmap == 2) { Tcl_SetVar(interp,"powPseudoImages","0",TCL_GLOBAL_ONLY); return Tcl_VarEval(interp, "toplevel ",toplevel, " -visual default ",options,(char *)NULL); /* return Tcl_VarEval(interp, "toplevel ",toplevel, " -visual best ",options,(char *)NULL); */ } /* find out some things about the screen*/ dotwin = Tk_NameToWindow(interp,".",Tk_MainWindow(interp)); screen=Tk_Screen(dotwin); disp = Tk_Display(dotwin); screenIndex=DefaultScreen(disp); if (force_cmap == 3) { /*Force default visual. */ return Tcl_VarEval(interp, "toplevel ",toplevel," -visual default ", options,(char *)NULL); /* We want to know if the default visual is pseudocolor. Finding this out in Xlib is stupidly complicated, so we'll let Tk do it for us */ Tcl_Eval(interp,"string match \"pseudocolor\" [winfo screenvisual .]"); if (Tcl_GetStringResult(interp) != "1") { Tcl_SetVar(interp,"powPseudoImages","0",TCL_GLOBAL_ONLY); } return TCL_OK; } visual_info = get_visual(disp); if (visual_info == NULL) { /* Is this really an error??? (void)fprintf (stderr,"powSetupColormap: toplevel created with non-pseudocolor visual. \n"); */ Tcl_SetVar(interp,"powPseudoImages","0",TCL_GLOBAL_ONLY); return Tcl_VarEval(interp, "toplevel ",toplevel," -visual default ", options,(char *)NULL); /* return Tcl_VarEval(interp, "toplevel ",toplevel," -visual best ", options,(char *)NULL); */ } plane_masks = (unsigned long *) ckalloc(MAXPLANES*sizeof(unsigned long)); pixels = (unsigned long *) ckalloc(MAX_COLORS*sizeof(unsigned long)); if (plane_masks == NULL || pixels == NULL) { (void)fprintf(stderr, "\n Unable to allocate storage for PowSetupColormap\n"); return TCL_ERROR; } tfGotColors = False; /* Will be set True when we succeed */ if (force_cmap != 1) { /* Try default Colormap first */ cmap = DefaultColormap(disp, screenIndex); ncolors = 212; /* why not 256, I don't know, but since we have to match whatever VISU does and I don't want to mess with that.... */ while (ncolors > 10) { status = XAllocColorCells(disp,cmap,True,plane_masks,0,pixels,ncolors); if (status != 0) { tfGotColors = True; /* Success. Break out of the while loop */ break; } ncolors -= 10; /* Failure. Decrement request and try again */ } /* End of while loop */ } Tcl_GetInt(interp,Tcl_GetVar(interp,"powMinColorcells",TCL_GLOBAL_ONLY), &powCells); if(force_cmap != 1 && ncolors >= powCells + free_cells) { /* enough colors , use default map */ /* First free the colors we got */ XFreeColors (disp, cmap, pixels, ncolors, 0); ckfree((void*)plane_masks); plane_masks = NULL; ckfree((void*)pixels); pixels = NULL; return Tcl_VarEval(interp, "toplevel ",toplevel, options,(char *)NULL); } else { /* not enough colors */ /* Free the colors we did get */ if(tfGotColors == True) { XFreeColors (disp, cmap, pixels, ncolors, 0); } tkwin = Tk_CreateWindowFromPath(interp,dotwin,".powCmap",NULL); if (tkwin == NULL) { (void)fprintf(stderr, "\n Couldn't create dummy window for PowSetupColormap\n"); return TCL_ERROR; } /* This prevents a seg-fault from occuring at a 'winfo class' command */ Tk_SetClass( tkwin, "PowCmapDmy" ); colormap_size = DisplayCells(disp,screenIndex); colors = (XColor*)ckalloc(colormap_size*sizeof(XColor)); for(i=0;ivisual , AllocNone); if (!cmap) { printf ("ERROR in PowSetupColormap: XCreateColormap returned %x\n", (unsigned int)cmap); return TCL_ERROR; } /* Not too sure of the purpose of all this... but it seems to be reserving part of the windows private colormap. Visu later grabs the necessary colors for the colormaps. So, for greater color range, need to reserve as little as possible here. That is what free_cells should be doing. (PDW 10/23/00) */ /* colormap_size = 212 - powCells - free_cells; */ colormap_size = free_cells; XAllocColorCells(disp,cmap,True,plane_masks,0,pixels,colormap_size); XStoreColors(disp,cmap,colors,colormap_size); ckfree((void*)plane_masks); plane_masks = NULL; ckfree((void*)pixels); pixels = NULL; ckfree((void*)colors); Tk_SetWindowColormap(tkwin,cmap); return Tcl_VarEval(interp, "toplevel ",toplevel, " -colormap .powCmap ",options,(char *)NULL); } #endif /* __WIN32__ || macintosh */ } int PowTestColormap(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[] ) { /* This routine returns the number of free colors in the colormap of the specified window */ #if defined(__WIN32__) || defined(macintosh) /* This routine does nothing in WIN32 or MacOS */ return TCL_OK; #else Tk_Window tkwin; Display *disp; Colormap cmap; unsigned long *pixels; unsigned long *plane_masks; char *window; int ncolors; Status status; Bool tfGotColors; /* True if we got colors from X */ if (argc != 2 ) { Tcl_SetResult(interp, "usage: powTestColormap window", TCL_VOLATILE); return TCL_ERROR; } window = ckalloc(strlen(argv[1])+1); strcpy(window,argv[1]); plane_masks = (unsigned long *) ckalloc(MAXPLANES*sizeof(unsigned long)); pixels = (unsigned long *) ckalloc(MAX_COLORS*sizeof(unsigned long)); if (plane_masks == NULL || pixels == NULL) { (void)fprintf(stderr, "\n Unable to allocate storage for PowTestColormap\n"); return TCL_ERROR; } /* find out some things about the screen*/ tkwin = Tk_NameToWindow(interp,window,Tk_MainWindow(interp)); disp = Tk_Display(tkwin); tfGotColors = False; cmap = Tk_Colormap(tkwin); ncolors = 256; while (ncolors > 0) { status = XAllocColorCells(disp,cmap,True,plane_masks,0,pixels,ncolors); if (status != 0) { tfGotColors = True; /* Success. Break out of the while loop */ break; } ncolors -= 1; /* Failure. Decrement request and try again */ } /* End of while loop */ /* First free the colors we got */ if (tfGotColors == True) { XFreeColors (disp, cmap, pixels, ncolors, 0); } ckfree((void*)plane_masks); plane_masks = NULL; ckfree((void*)pixels); pixels = NULL; sprintf(Tcl_GetStringResult(interp),"%i",ncolors); return TCL_OK; #endif /* __WIN32__ || macintosh */ } int PowSetupPhotoImages(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[] ) { int ncolors=256; int lut_start=0; int color_def; /*We're going to use the Colortable routines in VISU to setup our colortables and fake out the X stuff */ for (color_def=lut_start; color_defwidth; height = powImage->height; in_data = (powImage->dataptr)->data_array; data_type = (powImage->dataptr)->data_type; dithered_data_array = (unsigned char *)ckalloc(sizeof(char)*width*height); convert_block_to_byte(in_data,dithered_data_array,width*height,data_type, &disp_min, &disp_max); photo_image_array = (unsigned char *)ckalloc(3*sizeof(char)*width*height); inptr = dithered_data_array; outptr = photo_image_array; for (i=0; i> 8; *outptr++ = lut_colorcell_defs[col].green >> 8; *outptr++ = lut_colorcell_defs[col].blue >> 8; } } ckfree(dithered_data_array); photoBlock->pixelPtr = photo_image_array; return; } int PowGetHisto(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const argv[]) { /* usage: powGetHisto imageName */ PowImage *powImage; void *in_data; int data_type; int i; int histo1[MAX_LOOKUP], histo2[256], totalPix, level; double min, max; Tcl_Obj *list, *val; if(argc != 4) { Tcl_SetResult(interp, "usage: powGetHisto image min max", TCL_VOLATILE); return TCL_ERROR; } powImage = PowFindImage( Tcl_GetStringFromObj(argv[1], NULL) ); if( !powImage ) { Tcl_AppendResult( interp, "Unable to find image ", Tcl_GetStringFromObj(argv[1],NULL), (char*)NULL ); return TCL_ERROR; } Tcl_GetDoubleFromObj(interp, argv[2], &min); Tcl_GetDoubleFromObj(interp, argv[3], &max); totalPix = powImage->width * powImage->height; in_data = (powImage->dataptr)->data_array; data_type = (powImage->dataptr)->data_type; /* Calculate histogram */ convert_block_to_histo(in_data, totalPix, data_type, &min, &max, (unsigned int *) histo1); for( i=0; i<256; i++ ) histo2[i]=0; for( i=0; incolors, PowColorTable->lut_start, False, PowColorTable->red,PowColorTable->green,PowColorTable->blue, PowColorTable->intensity_lut, PowColorTable->red_lut,PowColorTable->green_lut, PowColorTable->blue_lut, interp, lut); } (*f)((Display*)NULL, (Colormap)0L, PowColorTable->ncolors, PowColorTable->lut_start, False, PowColorTable->red,PowColorTable->green,PowColorTable->blue, PowColorTable->intensity_lut, PowColorTable->red_lut,PowColorTable->green_lut, PowColorTable->blue_lut); return TCL_OK; } int PowPhotoCmapStretch( ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const argv[] ) { int cwid,clen; int x_lut[MAX_CLUT_LEN]; int y_lut[MAX_CLUT_LEN]; int i,j; int lut_size, nElem; int *p_lut; Tcl_Obj **lutElem; if( argc != 4 ) { Tcl_AppendResult(interp, "wrong # args: should be \"", Tcl_GetStringFromObj(argv[0],NULL), " cwid clen {x1 y1 x2 y2 ... }\"", (char *)NULL); return TCL_ERROR; } p_lut = PowColorTable->intensity_lut; lut_size = PowColorTable->ncolors; if( Tcl_GetIntFromObj(interp, argv[1], &cwid) != TCL_OK || Tcl_GetIntFromObj(interp, argv[2], &clen) != TCL_OK ) { Tcl_AppendResult(interp, "bad lookup table : should be \"", Tcl_GetStringFromObj(argv[0],NULL), " cwid clen {x1 y1 x2 y2 ... }\"", (char *) NULL); return TCL_ERROR; } if( Tcl_ListObjGetElements( interp, argv[3], &nElem, &lutElem ) != TCL_OK ) { Tcl_SetResult(interp,"Error reading LUT", TCL_VOLATILE); return TCL_ERROR; } if( nElem&0x1 ) { Tcl_SetResult(interp,"LUT must have an even number of elements", TCL_VOLATILE); return TCL_ERROR; } i = 0; j = 0; while( incolors, PowColorTable->lut_start, False, PowColorTable->red,PowColorTable->green,PowColorTable->blue, PowColorTable->intensity_lut, PowColorTable->red_lut,PowColorTable->green_lut, PowColorTable->blue_lut); return TCL_OK; } int PowImageScale( ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const argv[] ) { int x_lut[MAX_CLUT_LEN]; int y_lut[MAX_CLUT_LEN]; int i,j; int nElem; Tcl_Obj **lutElem, *values[2], *minmax; char *type; double scale, min, max; PowImage *powImage; void *in_data; unsigned int totalPix; int data_type; extern double lastLookupMin, lastLookupMax; if( argc < 2 ) { Tcl_AppendResult(interp, "wrong # args: should be \"", Tcl_GetStringFromObj(argv[0],NULL), " lut ?options ..?\"", (char *)NULL); return TCL_ERROR; } /* Reading a string LUT descriptor */ type = Tcl_GetStringFromObj( argv[1], NULL ); if( !strcmp(type, "linear") ) { for( i=0; iwidth) * (powImage->height); in_data = (powImage->dataptr)->data_array; data_type = (powImage->dataptr)->data_type; equalize_histo( in_data, data_type, totalPix, &min, &max ); lastLookupMin = min; lastLookupMax = max; values[0] = Tcl_NewDoubleObj( min ); values[1] = Tcl_NewDoubleObj( max ); minmax = Tcl_NewListObj( 2, values ); Tcl_SetObjResult( interp, minmax ); } else if( !strcmp(type, "model") ) { /* Reading a LUT array */ if( Tcl_ListObjGetElements( interp, argv[2], &nElem, &lutElem ) != TCL_OK ) { Tcl_AppendResult(interp, "Error reading LUT", (char*)NULL); return TCL_ERROR; } if( nElem<4 || nElem&0x1 ) { Tcl_SetResult(interp,"LUT must have an even number of elements >= 4", TCL_VOLATILE); return TCL_ERROR; } i = 0; j = 0; while( i=MAX_LOOKUP ) x_lut[i] = MAX_LOOKUP-1; if( y_lut[i]<0 ) y_lut[i] = 0; else if( y_lut[i]>255 ) y_lut[i] = 255; } build_lookup( x_lut, y_lut, j ); lastLookupMin = lastLookupMax = 0.0; } else { Tcl_SetResult(interp,"Unrecognized LUT type", TCL_VOLATILE); return TCL_ERROR; } return TCL_OK; } int PowReditherPhotoBlock (ClientData clientData, Tcl_Interp *interp, int argc, char *argv[] ) { PowImage *image_instance; Tk_PhotoHandle photo_handle; Tk_PhotoImageBlock photo_block; double min, max; if (argc != 4) { Tcl_SetResult(interp, "usage: powReditherPhotoBlock imageName min max", TCL_VOLATILE); return TCL_ERROR; } if ((photo_handle = Tk_FindPhoto(interp,argv[1])) == NULL) { Tcl_AppendResult(interp, "image \"", argv[1], "\" doesn't exist", (char *) NULL); return TCL_ERROR; } Tcl_GetDouble(interp, argv[2], &min); Tcl_GetDouble(interp, argv[3], &max); /* Tk_PhotoGetImage(photo_handle, &photo_block); */ image_instance = PowFindImage(argv[1]); PowDitherToPhoto(image_instance, &photo_block, min, max); photo_block.pixelSize = 3; photo_block.width = image_instance->width; photo_block.height = image_instance->height; photo_block.pitch = image_instance->width * 3; photo_block.offset[0] = 0; photo_block.offset[1] = 1; photo_block.offset[2] = 2; Tk_PhotoPutBlock(interp, photo_handle,&photo_block,0,0,image_instance->width,image_instance->height, TK_PHOTO_COMPOSITE_SET); ckfree(photo_block.pixelPtr); return TCL_OK; } fv5.5/tcltk/pow/PowCommands.c0000644000220700000360000025743013224715127015055 0ustar birbylhea#include #include "pow.h" /* on some system , e.g. linux, SUNs DBL_MAX is in float.h */ #ifndef DBL_MAX #include #endif #ifndef DBL_MIN #include #endif #ifdef macintosh #include #endif typedef struct { double x,y; } Point; extern int Pow_Allocated; extern PictColorTable *PowColorTable; int PowCleanUp(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]) { #if !(defined(__WIN32__) || defined(macintosh)) /* Tcl_HashEntry *entry_ptr; Tcl_HashSearch search; PowData *data_instance; */ unsigned long *pixels; int i,j; #endif /*free the data arrays that belong to POW */ /* Actually, we're going to comment this out for now. With the hide/show graph capability, we never really dispose of a graph until the parent exits. So we'd better not trash the data */ /* for (entry_ptr = Tcl_FirstHashEntry(&PowDataTable,&search); entry_ptr != NULL; entry_ptr = Tcl_NextHashEntry(&search)) { data_instance = (PowData *)Tcl_GetHashValue(entry_ptr); if (data_instance->copy ) { ckfree(data_instance->data_array); } } */ #if !(defined(__WIN32__) || defined(macintosh)) if (Pow_Allocated != 0) { /*free the colorcells we snarfed up */ pixels = (unsigned long *)ckalloc(PowColorTable->ncolors* sizeof(unsigned long)); if( pixels == NULL ) return 0; for(j=PowColorTable->lut_start,i=0;incolors;i++,j++) pixels[i] = j; /* free colors */ XFreeColors(PowColorTable->display,PowColorTable->colormap, pixels,PowColorTable->ncolors,0); ckfree((void*)pixels); Pow_Allocated = 0; } #endif /*__WIN32__ || macintosh */ return TCL_OK; } int PowListGraphs(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]) { Tcl_HashEntry *entry_ptr; Tcl_HashSearch search; if (argc == 2) { if (Tcl_FindHashEntry(&PowGraphTable, argv[1]) != NULL) { Tcl_SetResult(interp,"1",TCL_VOLATILE); } else { Tcl_SetResult(interp,"0",TCL_VOLATILE); } return TCL_OK; } for (entry_ptr = Tcl_FirstHashEntry(&PowGraphTable,&search); entry_ptr != NULL; entry_ptr = Tcl_NextHashEntry(&search)) { Tcl_AppendElement(interp, Tcl_GetHashKey(&PowGraphTable, entry_ptr)); } return TCL_OK; } int PowListCurves(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]) { Tcl_HashEntry *entry_ptr; Tcl_HashSearch search; if (argc == 2) { if (Tcl_FindHashEntry(&PowCurveTable, argv[1]) != NULL) { Tcl_SetResult(interp,"1",TCL_VOLATILE); } else { Tcl_SetResult(interp,"0",TCL_VOLATILE); } return TCL_OK; } for (entry_ptr = Tcl_FirstHashEntry(&PowCurveTable,&search); entry_ptr != NULL; entry_ptr = Tcl_NextHashEntry(&search)) { Tcl_AppendElement(interp, Tcl_GetHashKey(&PowCurveTable, entry_ptr)); } return TCL_OK; } int PowListImages(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]) { Tcl_HashEntry *entry_ptr; Tcl_HashSearch search; if (argc == 2) { if (Tcl_FindHashEntry(&PowImageTable, argv[1]) != NULL) { Tcl_SetResult(interp,"1",TCL_VOLATILE); } else { Tcl_SetResult(interp,"0",TCL_VOLATILE); } return TCL_OK; } for (entry_ptr = Tcl_FirstHashEntry(&PowImageTable,&search); entry_ptr != NULL; entry_ptr = Tcl_NextHashEntry(&search)) { Tcl_AppendElement(interp, Tcl_GetHashKey(&PowImageTable, entry_ptr)); } return TCL_OK; } int PowListVectors(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]) { Tcl_HashEntry *entry_ptr; Tcl_HashSearch search; if (argc == 2) { if (Tcl_FindHashEntry(&PowVectorTable, argv[1]) != NULL) { Tcl_SetResult(interp,"1",TCL_VOLATILE); } else { Tcl_SetResult(interp,"0",TCL_VOLATILE); } return TCL_OK; } for (entry_ptr = Tcl_FirstHashEntry(&PowVectorTable,&search); entry_ptr != NULL; entry_ptr = Tcl_NextHashEntry(&search)) { Tcl_AppendElement(interp, Tcl_GetHashKey(&PowVectorTable, entry_ptr)); } return TCL_OK; } int PowListData(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]) { Tcl_HashEntry *entry_ptr; Tcl_HashSearch search; if (argc == 2) { if (Tcl_FindHashEntry(&PowDataTable, argv[1]) != NULL) { Tcl_SetResult(interp,"1",TCL_VOLATILE); } else { Tcl_SetResult(interp,"0",TCL_VOLATILE); } return TCL_OK; } for (entry_ptr = Tcl_FirstHashEntry(&PowDataTable,&search); entry_ptr != NULL; entry_ptr = Tcl_NextHashEntry(&search)) { Tcl_AppendElement(interp, Tcl_GetHashKey(&PowDataTable, entry_ptr)); } return TCL_OK; } int PowProcessCurve(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]) { /* calculate the list of points for powPlotCurve */ const char **bboxptr; const char **rbboxptr; double x0 , x1, y0, y1; double rx0 , rx1, ry0, ry1, ry, rx; double t_rx0 , t_rx1, t_ry0, t_ry1; /* to avoid point lossage due to roundoff errors on points that are near axes */ int n, i, xoff, yoff, xeoff, yeoff; PowCurve *curve_ptr; PowVector *x_vector, *y_vector, *x_error, *y_error; PowData *x_vect, *y_vect, *x_err, *y_err; double xmagstep, ymagstep, xinc, yinc, oldx, oldy; char PlotCommand[1024]; double x,y,xe,ye; int p1,p2,p3; int q1,q2,q3; int dflag,pflag,lflag; int lasti; lasti = 0; x_vect = NULL; y_vect = NULL; x_err = NULL; y_err = NULL; x_vector = NULL; y_vector = NULL; x_error = NULL; y_error = NULL; if(argc < 10 ) { Tcl_SetResult(interp, "usage: powProcessCurve curve bbox rbbox xinc yinc magstep tags canvas", TCL_VOLATILE); return TCL_ERROR; } curve_ptr = PowFindCurve(argv[1]); if ((curve_ptr->x_vector)!= NULL ) { x_vect = (curve_ptr->x_vector)->dataptr;} if ((curve_ptr->x_error)!= NULL) {x_err = (curve_ptr->x_error)->dataptr;} if ((curve_ptr->y_vector)!= NULL){ y_vect = (curve_ptr->y_vector)->dataptr;} if ((curve_ptr->y_error)!= NULL) {y_err = (curve_ptr->y_error)->dataptr;} xoff = 0; yoff = 0; xeoff = 0; yeoff = 0; if (x_vector != NULL) xoff = x_vector->offset; if (y_vector != NULL) yoff = y_vector->offset; if (x_error != NULL) xeoff = x_error->offset; if (y_error != NULL) yeoff = y_error->offset; Tcl_SplitList(interp,argv[2],&n,&bboxptr); if(n != 4) { Tcl_SetResult(interp, "bbox malformed", TCL_VOLATILE); return TCL_ERROR; } /* (x0,y0) -- lower left */ /* (x1,y1) -- upper right */ Tcl_GetDouble(interp,bboxptr[0],&x0); Tcl_GetDouble(interp,bboxptr[3],&y0); Tcl_GetDouble(interp,bboxptr[2],&x1); Tcl_GetDouble(interp,bboxptr[1],&y1); /* ckfree((void *)bboxptr);*/ Tcl_SplitList(interp,argv[3],&n,&rbboxptr); if(n != 4) { Tcl_SetResult(interp, "rbbox malformed", TCL_VOLATILE); return TCL_ERROR; } /* (x0,y0) -- lower left */ /* (x1,y1) -- upper right */ Tcl_GetDouble(interp,rbboxptr[0],&rx0); Tcl_GetDouble(interp,rbboxptr[3],&ry0); Tcl_GetDouble(interp,rbboxptr[2],&rx1); Tcl_GetDouble(interp,rbboxptr[1],&ry1); /*ckfree(rbboxptr);*/ Tcl_GetDouble(interp,argv[4],&xinc); Tcl_GetDouble(interp,argv[5],&yinc); Tcl_GetDouble(interp,argv[6],&xmagstep); ymagstep = xmagstep; if (rx0 <= rx1) { t_rx0 = rx0 - 3.0 * xinc; t_rx1 = rx1 + 3.0 * xinc; } else { t_rx1 = rx1 - 3.0 * xinc; t_rx0 = rx0 + 3.0 * xinc; } if (ry0 <= ry1) { t_ry0 = ry0 - 3.0 * yinc; t_ry1 = ry1 + 3.0 * yinc; } else { t_ry1 = ry1 - 3.0 * yinc; t_ry0 = ry0 + 3.0 * yinc; } pflag = 0; lflag = 0; if (strstr(argv[8],"Points")) { pflag = 1;} if (strstr(argv[8],"Line")) { lflag = 1;} if((x_err == NULL && y_err == NULL) || lflag ) { /* just draw a bunch of line segments */ dflag = 0; if (x_vect != NULL) { rx = PowExtractDatum(x_vect,xoff); } else { rx = 1.0; } if (y_vect != NULL) { ry = PowExtractDatum(y_vect,yoff); } else { ry = 1.0; } if (rx != DBL_MAX) { oldx = (rx - rx0)*xmagstep/xinc + x0; } else { oldx = DBL_MAX; } if (ry != DBL_MAX) { oldy = y0 - (ry - ry0)*ymagstep/yinc; } else { oldy = DBL_MAX; } for (i=0;ilength;i++) { rx++; ry++; if (x_vect != NULL) { rx = PowExtractDatum(x_vect,i+xoff); } if ((rx >= t_rx0 && rx <= t_rx1) || (rx >= t_rx1 && rx <= t_rx0) ) { x = (rx - rx0)*xmagstep/xinc + x0; if (y_vect != NULL) { ry = PowExtractDatum(y_vect,i+yoff); } if ((ry >= t_ry0 && ry <= t_ry1) || (ry >= t_ry1 && ry <= t_ry0) ) { y = y0 - (ry - ry0)*ymagstep/yinc; if (pflag) { /* if drawing points, make a little 7 pixel cross */ p1 = (int)(x + 3); p2 = (int)(x - 3); p3 = (int)(x); q1 = (int)(y + 3); q2 = (int)(y - 3); q3 = (int)(y); sprintf(PlotCommand," %d %d %d %d ",p2,q3,p1,q3); Tcl_VarEval(interp,argv[9]," create line ",PlotCommand,"-tags {",argv[7],"} ", (char *) NULL); sprintf(PlotCommand," %d %d %d %d ",p3,q2,p3,q1); Tcl_VarEval(interp,argv[9]," create line ",PlotCommand,"-tags {",argv[7],"} ", (char *) NULL); } if (dflag && lflag) { /* don't draw lines from points off the graph */ sprintf(PlotCommand," %.0f %.0f %.0f %.0f ",oldx,oldy,x,y); Tcl_VarEval(interp,argv[9]," create line ",PlotCommand,"-tags {",argv[7],"}", (char *) NULL); } dflag = 1; oldx = x; oldy = y; /*update every 100 points */ if (i - lasti > 100) { Tcl_Eval(interp,"update idletasks"); lasti = i; } } else { /* don't draw lines from points off the graph */ dflag = 0; } } } } else { /* plot points */ rx = 0.0; ry = 0.0; for (i=0;ilength;i++) { rx++; ry++; if (x_vect != NULL) { rx = PowExtractDatum(x_vect,i+xoff); } if ((rx >= t_rx0 && rx <= t_rx1) || (rx >= t_rx1 && rx <= t_rx0) ) { x = (rx-rx0)*xmagstep/xinc + x0; if (x_err != NULL) { xe = PowExtractDatum(x_err,i+xeoff)*xmagstep/xinc ; } else { xe = 0.0; } if (y_vect != NULL) { ry = PowExtractDatum(y_vect,i+yoff); } if ((ry >= t_ry0 && ry <= t_ry1) || (ry >= t_ry1 && ry <= t_ry0) ) { y = y0 - (ry - ry0)*ymagstep/yinc; if (y_err != NULL) { ye = PowExtractDatum(y_err,i+yeoff)*ymagstep/yinc ; } else { ye = 0.0; } p1 = (int)(x + xe); p2 = (int)(x - xe); p3 = (int)(x); q1 = (int)(y + ye); q2 = (int)(y - ye); q3 = (int)(y); sprintf(PlotCommand," %d %d %d %d ",p2,q3,p1,q3); Tcl_VarEval(interp,argv[9]," create line ",PlotCommand,"-tags {",argv[7],"} ", (char *) NULL); sprintf(PlotCommand," %d %d %d %d ",p3,q2,p3,q1); Tcl_VarEval(interp,argv[9]," create line ",PlotCommand,"-tags {",argv[7],"} ", (char *) NULL); /*update every 100 points */ if (i - lasti > 100) { Tcl_Eval(interp,"update idletasks"); lasti = i; } } } } } return TCL_OK; } int PowSetGraphMagstep(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]) { int status = TCL_OK; PowGraph *graph_ptr; if(argc != 4) { Tcl_SetResult(interp, "usage: powSetGraphMagstep graphname newxmagstep newymagstep", TCL_VOLATILE); return TCL_ERROR; } graph_ptr = PowFindGraph(argv[1]); if (graph_ptr == (PowGraph *) NULL) { Tcl_SetResult(interp, "Couldn't find graph.", TCL_VOLATILE); return TCL_ERROR; } status = Tcl_GetDouble(interp,argv[2],&(graph_ptr->xmagstep)); if( status==TCL_OK ) status = Tcl_GetDouble(interp,argv[3],&(graph_ptr->ymagstep)); return status; } int PowGetImageOrigin(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]) { PowImage *image_ptr; char longStr[1024]; if(argc != 3) { Tcl_SetResult(interp, "wrong # args", TCL_VOLATILE); return TCL_ERROR; } image_ptr = PowFindImage(argv[1]); if (image_ptr == (PowImage *) NULL) { Tcl_SetResult(interp, "Couldn't find image.", TCL_VOLATILE); return TCL_ERROR; } switch (*argv[2]) { case 'X': sprintf(longStr,"%le", image_ptr->xorigin); Tcl_SetResult(interp, longStr, TCL_OK); break; case 'Y': sprintf(longStr,"%le", image_ptr->yorigin); Tcl_SetResult(interp, longStr, TCL_OK); break; default: Tcl_SetResult(interp, "No such image axis (must be X or Y)", TCL_VOLATILE); return TCL_ERROR; } return TCL_OK; } int PowGetImageOtherend(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]) { PowImage *image_ptr; char longStr[1024]; if(argc != 3) { Tcl_SetResult(interp, "wrong # args", TCL_VOLATILE); return TCL_ERROR; } image_ptr = PowFindImage(argv[1]); if (image_ptr == (PowImage *) NULL) { Tcl_SetResult(interp, "Couldn't find image.", TCL_VOLATILE); return TCL_ERROR; } switch (*argv[2]) { case 'X': sprintf(longStr,"%le", image_ptr->xotherend); Tcl_SetResult(interp, longStr, TCL_OK); break; case 'Y': sprintf(longStr,"%le", image_ptr->yotherend); Tcl_SetResult(interp, longStr, TCL_OK); break; default: Tcl_SetResult(interp, "No such image axis (must be X or Y)", TCL_VOLATILE); return TCL_ERROR; } return TCL_OK; } int PowGetImageUnits(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]) { PowImage *image_ptr; char longStr[1024]; if(argc != 3) { Tcl_SetResult(interp, "wrong # args", TCL_VOLATILE); return TCL_ERROR; } image_ptr = PowFindImage(argv[1]); if (image_ptr == (PowImage *) NULL) { Tcl_SetResult(interp, "Couldn't find image.", TCL_VOLATILE); return TCL_ERROR; } switch (*argv[2]) { case 'X': sprintf(longStr,"%s", image_ptr->xunits); Tcl_SetResult(interp, longStr, TCL_OK); break; case 'Y': sprintf(longStr,"%s", image_ptr->yunits); Tcl_SetResult(interp, longStr, TCL_OK); break; case 'Z': sprintf(longStr,"%s", image_ptr->zunits); Tcl_SetResult(interp, longStr, TCL_OK); break; default: Tcl_SetResult(interp, "No such image axis (must be X or Y or Z)", TCL_VOLATILE); return TCL_ERROR; } return TCL_OK; } int PowGetImageZ( ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const argv[] ) { char *imgName; PowImage *image_ptr; int x,y; double datum; #ifdef __WIN32__ __int64 datumL; #else long long datumL; #endif Tcl_Obj *res; char longStr[1024]; if(argc != 4) { Tcl_SetResult( interp, "usage: powGetImageZ image X Y", TCL_VOLATILE ); return TCL_ERROR; } imgName = Tcl_GetStringFromObj( argv[1], NULL ); image_ptr = PowFindImage( imgName ); if (image_ptr == (PowImage *) NULL) { Tcl_AppendResult(interp, "Couldn't find image: ",imgName, NULL); return TCL_ERROR; } Tcl_GetIntFromObj(interp,argv[2],&x); Tcl_GetIntFromObj(interp,argv[3],&y); datum = PowExtractDatum(image_ptr->dataptr,y * image_ptr->width + x); if ( image_ptr->dataptr->data_type == STRING_DATA ) { if ( datum >= DBL_MAX ) { datumL = PowExtractDatumLong(image_ptr->dataptr,y * image_ptr->width + x); if (datumL >= LONGLONG_MAX || datumL <= -1 * LONGLONG_MAX) { res = Tcl_NewStringObj( "NULL", -1 ); } else { #ifdef __WIN32__ sprintf(longStr, "%I64d", datumL); #else sprintf(longStr, "%lld", datumL); #endif res = Tcl_NewStringObj( longStr, -1 ); } } else { res = Tcl_NewDoubleObj( datum ); } } else { if (datum >= DBL_MAX || datum <= -1 * DBL_MAX) { res = Tcl_NewStringObj( "NULL", -1 ); } else { res = Tcl_NewDoubleObj( datum ); } } Tcl_SetObjResult( interp, res ); return TCL_OK; } int PowTestMacMemory( ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const argv[] ) { int enoughMemory = 1; #if !(defined(__WIN32__) || defined(macintosh)) int npixels; long dmy, appMem, appBlock, tmpBlock, tmpMem; #endif #ifdef macintosh /* This routine makes Mac-specific tests for the amount of memory left */ if(argc != 2) { Tcl_SetResult( interp, "usage: powTestMacMemory npixels", TCL_VOLATILE ); return TCL_ERROR; } Tcl_GetIntFromObj(interp,argv[1],&npixels); PurgeSpace( &appMem, &appBlock ); tmpBlock = TempMaxMem(&dmy); dmy = MaxBlockSys(); if( dmy>tmpBlock ) tmpBlock=dmy; tmpMem = FreeMemSys() + TempFreeMem(); dmy = tmpMem + tmpBlock; if ( appMem + tmpMem < 12*npixels + 2048000 || ( tmpBlock < 6*npixels && appBlock < 6*npixels ) ) { enoughMemory = 0; } #endif Tcl_SetObjResult( interp, Tcl_NewIntObj( enoughMemory ) ); return TCL_OK; } int PowPutZoomedBlock(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]) { /* calls the VISU routine Tk_PictPutZoomedBlock or Tk_PhotoPutZoomedBlock*/ /* this is a low level routine */ /* don't call it yourself, unless you're rewriting POW */ /* usage: powPutZoomedBlock imageName graphName x y width height zoomX zoomY */ /* Note, the x and y refer to the source, not the target block */ char imageName[1024] = "",graphName[1024] = "",dispImageName[1024] = ""; int xpix, ypix, width,height; double x,y; double zoomX, zoomY, Xoff, Yoff; Tk_PhotoHandle photo_handle, photo_disphandle; Tk_PhotoImageBlock photo_block; int pseudoImages; PowImage *image_instance; #if !(defined(__WIN32__) || defined(macintosh)) Tk_PictHandle pict_handle, pict_disphandle; Tk_PictImageBlock pict_block; #endif Tcl_GetInt(interp,Tcl_GetVar(interp,"powPseudoImages",TCL_GLOBAL_ONLY), &pseudoImages); if (argc != 9) { Tcl_SetResult(interp, "usage: powPutZoomedBlock imageName graphName x y width height zoomX zoomY\nYou probably shouldn't be seeing this.", TCL_VOLATILE); return TCL_ERROR; } strcpy(imageName,argv[1]); strcpy(graphName,argv[2]); Tcl_GetDouble(interp,argv[3],&x); Tcl_GetDouble(interp,argv[4],&y); Tcl_GetInt(interp,argv[5],&width); Tcl_GetInt(interp,argv[6],&height); Tcl_GetDouble(interp,argv[7],&zoomX); Tcl_GetDouble(interp,argv[8],&zoomY); if( pseudoImages ) { #if !(defined(__WIN32__) || defined(macintosh)) /* use Pict widget (Visu) */ if ((pict_handle = Tk_FindPict(imageName)) == NULL) { Tcl_AppendResult(interp, "image \"", imageName, "\" doesn't", " exist or is not a Pict image", (char *) NULL); return TCL_ERROR; } xpix = (int)(x+0.5); ypix = (int)(y+0.5); Xoff = (xpix-x+0.5) * zoomX; Yoff = (ypix-y+0.5) * zoomY; Tk_PictGetImage(pict_handle,&pict_block); pict_block.pixelPtr = pict_block.pixelPtr + ypix * pict_block.pitch * pict_block.pixelSize + xpix * pict_block.pixelSize; strcat(dispImageName,imageName); strcat(dispImageName,"disp"); strcat(dispImageName,graphName); if ((pict_disphandle = Tk_FindPict(dispImageName)) == NULL) { Tcl_AppendResult(interp, "image \"", imageName, "\" doesn't", "have a displayed instance on graph \"", graphName, "\"", (char *) NULL); return TCL_ERROR; } Tk_PictPutScaledBlock(pict_disphandle,&pict_block,0,0,width,height, zoomX, zoomY, Xoff, Yoff); return TCL_OK; #else Tcl_AppendResult(interp,"You should not see this",NULL); return TCL_ERROR; #endif /*__WIN32__ || macintosh*/ } else { /* use Photo widget */ if ((photo_handle = Tk_FindPhoto(interp,imageName)) == NULL) { Tcl_AppendResult(interp, "image \"", imageName, "\" doesn't exist", (char *) NULL); return TCL_ERROR; } Tk_PhotoGetImage(photo_handle,&photo_block); strcat(dispImageName,imageName); strcat(dispImageName,"disp"); strcat(dispImageName,graphName); if ((photo_disphandle = Tk_FindPhoto(interp,dispImageName)) == NULL) { Tcl_AppendResult(interp, "image \"", imageName, "\" doesn't", "have a displayed instance on graph \"", graphName, "\"", (char *) NULL); return TCL_ERROR; } image_instance = PowFindImage(imageName); xpix = (int)(x+0.5); Xoff = (xpix-x+0.5) * zoomX; y += (height-1)/zoomY; ypix = (int)(y+0.5); Yoff = ( (y+0.5) - ypix ) * zoomY + 1.0; if( Yoff>zoomY ) Yoff = zoomY; photo_block.pixelPtr = photo_block.pixelPtr + (image_instance->height - 1 - ypix) * photo_block.pitch + xpix * photo_block.pixelSize; Pow_PhotoPutScaledBlock(photo_disphandle,&photo_block,0,0,width,height, zoomX, zoomY, Xoff, Yoff ); return TCL_OK; } } int PowDestroyData_Tcl(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]) { /* usage: powDestroyData data_name*/ int status=0; if (argc != 2) { Tcl_SetResult(interp,"usage: powDestroyData data_name",TCL_VOLATILE); return TCL_ERROR; } PowDestroyData(argv[1],&status); if (status != 0) { /* Result already set to error message by PowDestroyData*/ return TCL_ERROR; } return TCL_OK; } int PowCloneData(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]) { /*usage: powCloneData new_data_name old_data_name ?offset? ?length? ?copy?*/ int data_type,length,status = 0; void *databuff; int copy, offset; PowData *old_data; if(argc < 3 || argc > 6) { Tcl_SetResult(interp, "usage: powCloneData new_data_name old_data_name ?offset? ?length? ?copy?", TCL_VOLATILE); return TCL_ERROR; } old_data = PowFindData(argv[2]); if (old_data == NULL) { Tcl_SetResult(interp,"Couldn't find data: ",TCL_VOLATILE); Tcl_AppendResult(interp,argv[2],(char *)NULL); return TCL_ERROR; } if (argc > 3) { Tcl_GetInt(interp,argv[3],&offset); } else { offset = 0; } if (argc <= 4 || strstr(argv[4],"NULL") != NULL ) { length = old_data->length; } else { Tcl_GetInt(interp,argv[4],&length); } /* don't allow the new data object to run off the end of the old */ if (length + offset > old_data->length) { length = old_data->length - offset; } if (argc > 5) { copy = Tcl_GetInt(interp,argv[5],©); } else { copy = 0; } if (copy < 0 && offset != 0) { Tcl_SetResult(interp,"Can't clone data with nonzero offset!",TCL_VOLATILE); return TCL_ERROR; } data_type = old_data->data_type; databuff = (void *)((char *)old_data->data_array + offset * pixelSizes[data_type]); PowCreateData(argv[1],databuff,&data_type,&length,©,&status); if(status != 0) { Tcl_SetResult(interp,"powCloneData failed",TCL_VOLATILE); return TCL_ERROR; } return TCL_OK; } int PowCreateDataFlip_Tcl(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]) { /* this is the TCL wrapper for the PowCreateDataFlip routine. */ /* the pointer to the data should be converted using sprintf(PTRFORMAT,pointer) */ int status = 0; char *direction; int height, width; if(argc < 3) { Tcl_SetResult(interp,"usage: powCreateDataFlip data_name direction height width",TCL_VOLATILE); return TCL_ERROR; } direction = argv[2]; Tcl_GetInt(interp,argv[3],&height); Tcl_GetInt(interp,argv[4],&width); PowCreateDataFlip(argv[1], direction, &height, &width, &status); if(status != 0) { Tcl_SetResult(interp, "Couldn't flip data.", TCL_VOLATILE); return TCL_ERROR; } return TCL_OK; } int PowCreateCurveFlip_Tcl(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]) { /* this is the TCL wrapper for the PowCreateCurveFlip routine. */ /* the pointer to the data should be converted using sprintf(PTRFORMAT,pointer) */ PowGraph *graph; int status = 0; char *direction; char *graphName; const char *canvas; double x, y; Point bbox_ll, bbox_ur; int i; char cmdLine[1024]; const char **list; if(argc < 3) { Tcl_SetResult(interp,"usage: powCreateCurveFlip data_name canvas direction",TCL_VOLATILE); return TCL_ERROR; } graphName = argv[1]; canvas = argv[2]; direction = argv[3]; graph = PowFindGraph(graphName); sprintf(cmdLine, "%s coords %sbox", canvas, graphName ); if ( Tcl_Eval(interp,cmdLine)!=TCL_OK ) { Tcl_SetResult(interp,"Couldn't get bounding box", TCL_VOLATILE); return TCL_ERROR; } strncpy(cmdLine,Tcl_GetStringResult(interp),256); Tcl_SplitList(interp,cmdLine,&i,&list); Tcl_GetDouble(interp,list[0],&(bbox_ll.x)); Tcl_GetDouble(interp,list[1],&(bbox_ur.y)); Tcl_GetDouble(interp,list[2],&(bbox_ur.x)); Tcl_GetDouble(interp,list[3],&(bbox_ll.y)); ckfree((char *) list); PowPixToPos(bbox_ll.x, bbox_ll.y, &graph->WCS, &x, &y); PowCreateCurveFlip(graphName, direction, &status); if(status != 0) { Tcl_SetResult(interp, "Couldn't flip Curve data.", TCL_VOLATILE); return TCL_ERROR; } return TCL_OK; } int PowCreateData_Tcl(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]) { /* usage: powCreateData data_name data_pointer data_type length ?copy? */ /* this is the TCL wrapper for the PowCreateData routine. */ /* the pointer to the data should be converted using sprintf(PTRFORMAT,pointer) */ int data_type,length,status = 0; void *databuff; int copy; if(argc < 5) { Tcl_SetResult(interp,"usage: powCreateData data_name data_pointer data_type length ?copy?",TCL_VOLATILE); return TCL_ERROR; } if(strstr(argv[3],"BYTE") != NULL){ data_type = BYTE_DATA; } else if (strstr(argv[3],"SHORTINT") != NULL) { data_type = SHORTINT_DATA ; } else if (strstr(argv[3],"INT") != NULL) { data_type = INT_DATA ; } else if (strstr(argv[3],"REAL") != NULL) { data_type = REAL_DATA ; } else if (strstr(argv[3],"FLOAT") != NULL) { data_type = REAL_DATA ; } else if (strstr(argv[3],"DOUBLE") != NULL) { data_type = DOUBLE_DATA; } else { Tcl_GetInt(interp,argv[3],&data_type); } Tcl_GetInt(interp,argv[4],&length); if (sscanf(argv[2],PTRFORMAT,&databuff) != 1) { Tcl_SetResult(interp, "Couldn't parse data address into an integer", TCL_VOLATILE); return TCL_ERROR; } if (argc == 6) { Tcl_GetInt(interp,argv[5],©); } else { copy = 0; } PowCreateData(argv[1],databuff,&data_type,&length,©,&status); if(status != 0) { Tcl_SetResult(interp, "Couldn't create data.", TCL_VOLATILE); return TCL_ERROR; } return TCL_OK; } int PowFindData_Tcl(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]) { /*This is a wrapper on PowFindData to see if image data exists */ PowData *powdatabuff; if (argc != 2) { Tcl_SetResult(interp,"usage: powFindData data_name",TCL_VOLATILE); return TCL_ERROR; } powdatabuff = PowFindData(argv[1]); if (powdatabuff == (PowData *)NULL ) { return TCL_ERROR; } return TCL_OK; } int PowRegisterData_Tcl(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]) { /*This is for people who create their PowData objects outside of pow */ /*(e.g. users of the LHEA orbit libraries) but then want to import them */ /*into POW. */ PowData *powdatabuff; int status=0; if(argc != 2) { Tcl_SetResult(interp,"usage: powRegisterData PowData_pointer",TCL_VOLATILE); return TCL_ERROR; } if (sscanf(argv[1],PTRFORMAT,&powdatabuff) != 1) { Tcl_SetResult(interp, "Couldn't parse powdata address into an integer", TCL_VOLATILE); return TCL_ERROR; } PowRegisterData(powdatabuff,&status); if (status != 0) { Tcl_SetResult(interp,"Couldn't register powdata.",TCL_VOLATILE); return TCL_ERROR; } return TCL_OK; } int PowDestroyImage_Tcl(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]) { /* usage: powDestroyImage image_name*/ int status=0; if (argc != 2) { Tcl_SetResult(interp,"usage: powDestroyImage image_name",TCL_VOLATILE); return TCL_ERROR; } PowDestroyImage(argv[1],&status); if (status != 0) { /* Result already set to error message by PowDestroyImage*/ return TCL_ERROR; } return TCL_OK; } int PowCreateImage_Tcl(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]) { /* usage: powCreateImage image_name data_name xoffset yoffset\ */ /* width height xorigin xinc yorigin yinc xunits yunits zunits */ /* this is the TCL wrapper for the PowCreateImage routine. */ int xoffset,yoffset,width,height,status=0; double xorigin,xinc,yorigin,yinc; if(argc != 14) { Tcl_SetResult(interp, "usage: powCreateImage image_name data_name xoffset yoffset\\\n width height xorigin xinc yorigin yinc xunits yunits zunits", TCL_VOLATILE); return TCL_ERROR; } Tcl_GetInt(interp,argv[3],&xoffset); Tcl_GetInt(interp,argv[4],&yoffset); Tcl_GetInt(interp,argv[5],&width); Tcl_GetInt(interp,argv[6],&height); Tcl_GetDouble(interp,argv[7],&xorigin); Tcl_GetDouble(interp,argv[8],&xinc); Tcl_GetDouble(interp,argv[9],&yorigin); Tcl_GetDouble(interp,argv[10],&yinc); /* fprintf(stdout, "PowCommands before calling PowCreateImage\n"); */ /* fprintf(stdout, "xoffset: %f\n", xoffset);*/ /* fprintf(stdout, "yoffset: %f\n", yoffset);*/ /* fprintf(stdout, "width: %f\n", width);*/ /* fprintf(stdout, "height: %f\n", height);*/ /* fprintf(stdout, "xorigin: %f\n", xorigin);*/ /* fprintf(stdout, "yorigin: %f\n", yorigin);*/ /* fprintf(stdout, "xinc: %f\n", xinc);*/ /* fprintf(stdout, "yinc: %f\n", yinc);*/ /* fprintf(stdout, "argv[11]: %s\n", argv[11]);*/ /* fprintf(stdout, "argv[12]: %s\n", argv[12]);*/ /* fprintf(stdout, "argv[13]: %s\n", argv[13]);*/ /* fprintf(stdout, "status: %d\n", status);*/ PowCreateImage(argv[1],argv[2],&xoffset,&yoffset,&width,&height, &xorigin,&xinc,&yorigin,&yinc,argv[11],argv[12], argv[13],&status); /* fprintf(stdout, "xoffset: %f\n", xoffset);*/ /* fprintf(stdout, "yoffset: %f\n", yoffset);*/ /* fprintf(stdout, "width: %f\n", width);*/ /* fprintf(stdout, "height: %f\n", height);*/ /* fprintf(stdout, "xorigin: %f\n", xorigin);*/ /* fprintf(stdout, "yorigin: %f\n", yorigin);*/ /* fprintf(stdout, "xinc: %f\n", xinc);*/ /* fprintf(stdout, "yinc: %f\n", yinc);*/ /* fprintf(stdout, "argv[11]: %s\n", argv[11]);*/ /* fprintf(stdout, "argv[12]: %s\n", argv[12]);*/ /* fprintf(stdout, "argv[13]: %s\n", argv[13]);*/ /* fprintf(stdout, "status: %d\n", status);*/ /* fprintf(stdout, "done calling PowCommands\n"); */ if(status != 0) { Tcl_SetResult(interp, "Couldn't create image.", TCL_VOLATILE); return TCL_ERROR; } return TCL_OK; } int PowDestroyVector_Tcl(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]) { /* usage: powDestroyVector vector_name*/ int status=0; if (argc != 2) { Tcl_SetResult(interp,"usage: powDestroyVector vector_name",TCL_VOLATILE); return TCL_ERROR; } PowDestroyVector(argv[1],&status); if (status != 0) { /* Result already set to error message by PowDestroyVector*/ return TCL_ERROR; } return TCL_OK; } int PowCreateVector_Tcl(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]) { /* usage: powCreateVector vector_name data_name offset length\ */ /* units */ /* this is the TCL wrapper for the PowCreateVector routine. */ int offset,status=0; int *length; if(argc != 6) { Tcl_SetResult(interp, "usage: powCreateVector vector_name data_name offset length units", TCL_VOLATILE); return TCL_ERROR; } Tcl_GetInt(interp,argv[3],&offset); if ( strstr(argv[4],"NULL") == NULL ) { length = (int *) ckalloc(sizeof(int)); Tcl_GetInt(interp,argv[4],length); } else { length = NULL; } PowCreateVector(argv[1],argv[2],&offset,length,argv[5],&status); if(status != 0) { Tcl_SetResult(interp, "Couldn't create vector.", TCL_VOLATILE); return TCL_ERROR; } return TCL_OK; } int PowDestroyCurve_Tcl(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]) { /* usage: powDestroyCurve curve_name*/ int status=0; if (argc != 2) { Tcl_SetResult(interp,"usage: powDestroyCurve curve_name",TCL_VOLATILE); return TCL_ERROR; } PowDestroyCurve(argv[1],&status); if (status != 0) { /* Result already set to error message by PowDestroyCurve*/ return TCL_ERROR; } return TCL_OK; } int PowCreateCurve_Tcl(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]) { /* usage: powCreateCurve curve_name x_vector x_error y_vector y_error\ */ /* */ /* this is the TCL wrapper for the PowCreateVector routine. */ char *z_vector, *z_error; int status=0; if(argc < 6 || argc == 7) { Tcl_SetResult(interp, "usage: powCreateCurve curve_name x_vector x_error y_vector y_error ", TCL_VOLATILE); return TCL_ERROR; } if(argc == 6) { z_vector = ckalloc(sizeof("NULL")); strcpy(z_vector,"NULL"); z_error = ckalloc(sizeof("NULL")); strcpy(z_error,"NULL"); } else { z_vector = argv[6]; z_error = argv[7]; } PowCreateCurve(argv[1],argv[2],argv[3],argv[4],argv[5],z_vector,z_error,&status); if(status != 0) { Tcl_SetResult(interp, "Couldn't create curve.", TCL_VOLATILE); return TCL_ERROR; } return TCL_OK; } int PowCreateVectorEN_Tcl(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]) { /* usage: powCreateVectorEN vector_name data_name length start increment units */ /* this is the TCL wrapper for the PowCreateVector routine. */ int length,status=0; double start,increment; PowData *data_instance; char ptrString[40]; if(argc != 7) { Tcl_SetResult(interp, "usage: powCreateVectorEN vector_name data_name length start increment units", TCL_VOLATILE); return TCL_ERROR; } Tcl_GetInt(interp,argv[3],&length); Tcl_GetDouble(interp,argv[4],&start); Tcl_GetDouble(interp,argv[5],&increment); PowCreateVectorEN(argv[1],argv[2],&length,&start,&increment,argv[6],&status); if(status != 0) { Tcl_SetResult(interp, "Couldn't create vector.", TCL_VOLATILE); return TCL_ERROR; } data_instance = PowFindData(argv[1]); /*Return the string representation of the PowData pointer */ sprintf(ptrString,PTRFORMAT,data_instance); Tcl_SetResult(interp,ptrString,TCL_VOLATILE); return TCL_OK; } int PowDataPtr_Tcl(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const argv[]) { /* usage: powDataPtr data_name */ PowData *data_instance; char ptrString[40]; if(argc != 2) { Tcl_SetResult(interp, "usage: powDataPtr data_name", TCL_VOLATILE); return TCL_ERROR; } data_instance = PowFindData( Tcl_GetStringFromObj( argv[1], NULL ) ); /*Return the string representation of the PowData pointer */ sprintf(ptrString,PTRFORMAT,data_instance); Tcl_SetResult(interp,ptrString,TCL_VOLATILE); return TCL_OK; } int PowCreateHisto_Tcl(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]) { /* usage: powCreateHisto histo_name x_vector y_vector */ /* this is the TCL wrapper for the PowCreateHisto routine. */ int status=0; if(argc != 4) { Tcl_SetResult(interp, "usage: powCreateHisto histo_name x_vector y_vector", TCL_VOLATILE); return TCL_ERROR; } PowCreateHisto(argv[1],argv[2],argv[3],&status); if(status != 0) { Tcl_SetResult(interp, "Couldn't create histo.", TCL_VOLATILE); return TCL_ERROR; } return TCL_OK; } int PowDestroyGraph_Tcl(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]) { /* usage: powDestroyGraph graph_name*/ int status=0; if (argc != 2) { Tcl_SetResult(interp,"usage: powDestroyGraph graph_name",TCL_VOLATILE); return TCL_ERROR; } PowDestroyGraph(argv[1],&status); if (status != 0) { /* Result already set to error message by PowDestroyGraph*/ return TCL_ERROR; } return TCL_OK; } int PowCreateGraph_Tcl(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]) { /* usage: powCreateGraph graph_name curves images xunits yunits xlabel\ */ /* ylabel xdimdisp ydimdisp */ /* this is the TCL wrapper for the PowCreateImage routine. */ int xdimdisp,ydimdisp,*pxdimdisp,*pydimdisp,status=0; double rxdimdisp,rydimdisp; double xmin,xmax,ymin,ymax; double *pxmin,*pxmax,*pymin,*pymax; char *whichPowCanvas; Tcl_DString errMsg; pxmin = &xmin; pxmax = &xmax; pymin = &ymin; pymax = &ymax; pxdimdisp = &xdimdisp; pydimdisp = &ydimdisp; if(argc < 8) { Tcl_SetResult(interp, "usage: powCreateGraph graph_name curves images xunits yunits xlabel\\\n ylabel ?xdimdisp ydimdisp xmin ymin xmax ymax? ", TCL_VOLATILE); return TCL_ERROR; } if( argc > 8 && strstr(argv[8],"NULL") == NULL ) { if( Tcl_GetDouble(interp,argv[8],&rxdimdisp)!=TCL_OK ) { pxdimdisp = NULL; } else { xdimdisp = (int) ceil(rxdimdisp); } } else { pxdimdisp = NULL; } if( argc > 9 && strstr(argv[9],"NULL") == NULL ) { if( Tcl_GetDouble(interp,argv[9],&rydimdisp)!=TCL_OK ) { pydimdisp = NULL; } else { ydimdisp = (int) ceil(rydimdisp); } } else { pydimdisp = NULL; } if (argc >= 11 && (strstr(argv[10],"NULL") == NULL)) { Tcl_GetDouble(interp,argv[10],pxmin); } else { pxmin = NULL; } if (argc >= 12 && (strstr(argv[11], "NULL") == NULL)) { Tcl_GetDouble(interp,argv[11],pymin); } else { pymin = NULL; } if (argc >= 13 && (strstr(argv[12], "NULL") == NULL)) { Tcl_GetDouble(interp,argv[12],pxmax); } else { pxmax = NULL; } if (argc >= 14 && (strstr(argv[13],"NULL") == NULL)) { Tcl_GetDouble(interp,argv[13],pymax); } else { pymax = NULL; } /* set global whichPowCanvas variable (only used internally to implement "scope" window, *not* for public usage at this time) */ if (argc >=15 && (strstr(argv[14],"NULL") == NULL)) { whichPowCanvas=(char *) ckalloc((strlen(argv[14])+1)*sizeof(char)); strcpy(whichPowCanvas,argv[14]); } else { whichPowCanvas=(char *) ckalloc(sizeof(".pow.pow")); strcpy(whichPowCanvas,".pow.pow"); } /* This can take a while, so set POW's cursor to a watch */ Tcl_GlobalEval(interp, "powSetCursor watch"); PowCreateGraph_internal( argv[1], argv[2], argv[3], argv[4], argv[5], argv[6], argv[7], pxdimdisp, pydimdisp, pxmin, pymin, pxmax, pymax, whichPowCanvas, &status); if( status ) { Tcl_DStringInit(&errMsg); Tcl_DStringGetResult(interp, &errMsg); } Tcl_GlobalEval(interp, "powSetCursor reset"); ckfree(whichPowCanvas); if( status ) { Tcl_DStringAppend( &errMsg, "\nCouldn't create graph", -1 ); Tcl_DStringResult( interp, &errMsg ); return TCL_ERROR; } return TCL_OK; } int PowTestImage(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const argv[] ) { /*******************************************************/ /* Test new image with old graph for WCS consistency */ /*******************************************************/ PowGraph *graph; PowImage *image; double xorigin, yorigin, xotherend, yotherend, xcorner, ycorner; if( argc != 3 ) { Tcl_SetResult( interp, "Usage: powTestImage gn image", TCL_VOLATILE ); return TCL_ERROR; } graph = PowFindGraph( Tcl_GetStringFromObj( argv[1], NULL ) ); image = PowFindImage( Tcl_GetStringFromObj( argv[2], NULL ) ); if( graph==NULL || image==NULL ) return TCL_ERROR; /*************************************************************/ /* Convert origin and otherend info into pixel coordinates */ /*************************************************************/ if( PowPosToPix( image->xorigin, image->yorigin, &graph->WCS, &xorigin, &yorigin ) ) return TCL_ERROR; if( PowPosToPix( image->xotherend, image->yotherend, &graph->WCS, &xotherend, &yotherend ) ) return TCL_ERROR; if( (graph->WCS.type[0]!='\0') != (image->WCS.type[0]!='\0') ) { Tcl_SetResult(interp,"WCS state of graph and image differ", TCL_VOLATILE); return TCL_ERROR; } /*************************************************/ /* We are in pixel coordinates, so they should */ /* ALWAYS go from left->right */ /*************************************************/ if( xorigin > xotherend || yorigin > yotherend ) { /* fprintf(stdout, "-------> xorigin: <%20.15f>, xotherend: <%20.15f>\n", xorigin, xotherend); fprintf(stdout, "-------> yorigin: <%20.15f>, yotherend: <%20.15f>\n", yorigin, yotherend); fflush(stdout); */ Tcl_SetResult(interp,"New image does not point in same direction", TCL_VOLATILE); return TCL_ERROR; } /***************************************************/ /* Images must project to an unrotated rectangle */ /***************************************************/ if( PowPixToPos( -0.5, image->height-0.5, &image->WCS, &xcorner, &ycorner ) ) return TCL_ERROR; if( PowPosToPix( xcorner, ycorner, &graph->WCS, &xcorner, &ycorner ) ) return TCL_ERROR; if( fabs( xcorner-xorigin ) > 1.0 || fabs( ycorner-yotherend ) > 1.0 ) { Tcl_SetResult(interp, "Graph and image have different rotation angles.", TCL_VOLATILE); return TCL_ERROR; } if( PowPixToPos( image->width-0.5, -0.5, &image->WCS, &xcorner, &ycorner ) ) return TCL_ERROR; if( PowPosToPix( xcorner, ycorner, &graph->WCS, &xcorner, &ycorner ) ) return TCL_ERROR; if( fabs( xcorner-xotherend ) > 1.0 || fabs( ycorner-yorigin ) > 1.0 ) { Tcl_SetResult(interp, "Graph and image have different rotation angles.", TCL_VOLATILE); return TCL_ERROR; } return TCL_OK; } int PowFetchCurveInfoHash(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]) { /* usage: powFetchVectorHash curvename */ /* used by the vector edit window to fetch component vector names */ PowCurve *curve_ptr; if(argc != 2) { Tcl_SetResult(interp, "usage: powFetchVectorHash curvename", TCL_VOLATILE); return TCL_ERROR; } curve_ptr = PowFindCurve(argv[1]); if (curve_ptr == (PowCurve *) NULL) { Tcl_SetResult(interp,"Couldn't find curve.",TCL_VOLATILE); return TCL_ERROR; } Tcl_SetResult(interp,"X",TCL_VOLATILE); if (curve_ptr->x_vector) { Tcl_AppendResult(interp," ", (curve_ptr->x_vector)->vector_name,(char *)NULL); } else { Tcl_AppendResult(interp," NULL",(char *)NULL); } if (curve_ptr->x_error) { Tcl_AppendResult(interp," XE ", (curve_ptr->x_error)->vector_name,(char *)NULL); } else { Tcl_AppendResult(interp," XE NULL",(char *)NULL); } if (curve_ptr->y_vector) { Tcl_AppendResult(interp," Y ", (curve_ptr->y_vector)->vector_name,(char *)NULL); } else { Tcl_AppendResult(interp," Y NULL",(char *)NULL); } if (curve_ptr->y_error) { Tcl_AppendResult(interp," YE ", (curve_ptr->y_error)->vector_name,(char *)NULL); } else { Tcl_AppendResult(interp," YE NULL",(char *)NULL); } return TCL_OK; } int PowFetchDataLength(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]) { /* usage: powFetchDataLength data_name */ /* used by the data edit window to fetch data structure fields */ PowData *data_ptr; char length_str[22]; if(argc != 2) { Tcl_SetResult(interp, "usage: powFetchDataLength dataname", TCL_VOLATILE); return TCL_ERROR; } data_ptr = PowFindData(argv[1]); if (data_ptr == (PowData *) NULL) { Tcl_SetResult(interp,"Couldn't find data: ",TCL_VOLATILE); Tcl_AppendResult(interp,argv[1],(char *)NULL); return TCL_ERROR; } sprintf(length_str,"%d",data_ptr->length); Tcl_SetResult(interp,length_str,TCL_VOLATILE); return TCL_OK; } int PowExprDataInfo(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const argv[] ) { /* usage: NONE! This is a callback function to be used in */ /* conjunction with the fitsTcl vector expression calculator. */ /* It locates the powData object being referenced and returns */ /* A pointer to the data, the datatype, and the data length. */ PowData *data_ptr; Tcl_Obj *res[4]; char ptrStr[16]; if(argc != 2) { Tcl_SetResult(interp, "usage: powExprDataInfo dataname", TCL_VOLATILE); return TCL_ERROR; } data_ptr = PowFindData( Tcl_GetStringFromObj(argv[1],NULL) ); if (data_ptr == (PowData *) NULL) { Tcl_SetResult(interp,"Couldn't find data.",TCL_VOLATILE); return TCL_ERROR; } sprintf(ptrStr, PTRFORMAT, data_ptr->data_array); res[0] = Tcl_NewStringObj( "-ptr", -1 ); res[1] = Tcl_NewStringObj( ptrStr, -1 ); res[2] = Tcl_NewIntObj( data_ptr->data_type ); res[3] = Tcl_NewIntObj( data_ptr->length ); Tcl_SetObjResult(interp, Tcl_NewListObj(4, res) ); return TCL_OK; } int PowFetchVectorInfoHash(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]) { /* usage: powFetchVectorInfoHash vector_name */ /* used by the vector edit window to fetch vector structure fields */ PowVector *vector_ptr; char length_str[22]; if(argc != 2) { Tcl_SetResult(interp, "usage: powFetchVectorInfoHash vectorname", TCL_VOLATILE); return TCL_ERROR; } vector_ptr = PowFindVector(argv[1]); if (vector_ptr == (PowVector *) NULL) { Tcl_SetResult(interp,"Couldn't find vector.",TCL_VOLATILE); return TCL_ERROR; } Tcl_SetResult(interp,"data",TCL_VOLATILE); Tcl_AppendResult(interp," ", (vector_ptr->dataptr)->data_name,(char *)NULL); sprintf(length_str,"%d",vector_ptr->length); Tcl_AppendResult(interp," length ", length_str,(char *)NULL); Tcl_AppendResult(interp," units ", vector_ptr->units,(char *)NULL); return TCL_OK; } int PowFetchImageInfoHash(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]) { /* usage: powFetchImageInfoHash image_name */ /* used by the image edit window to fetch image structure fields */ PowImage *image_ptr; char tmp_str[22]; if(argc != 2) { Tcl_SetResult(interp, "usage: powFetchImageInfoHash imagename", TCL_VOLATILE); return TCL_ERROR; } image_ptr = PowFindImage(argv[1]); if (image_ptr == (PowImage *) NULL) { Tcl_SetResult(interp,"Couldn't find image.",TCL_VOLATILE); return TCL_ERROR; } Tcl_SetResult(interp,"data",TCL_VOLATILE); Tcl_AppendResult(interp," ", (image_ptr->dataptr)->data_name,(char *)NULL); sprintf(tmp_str,"%d",image_ptr->width); Tcl_AppendResult(interp," width ", tmp_str,(char *)NULL); sprintf(tmp_str,"%d",image_ptr->height); Tcl_AppendResult(interp," height ", tmp_str,(char *)NULL); sprintf(tmp_str,"%lg",image_ptr->xorigin+0.5*image_ptr->xinc); Tcl_AppendResult(interp," xorigin ", tmp_str,(char *)NULL); sprintf(tmp_str,"%lg",image_ptr->yorigin+0.5*image_ptr->yinc); Tcl_AppendResult(interp," yorigin ", tmp_str,(char *)NULL); sprintf(tmp_str,"%lg",image_ptr->xinc); Tcl_AppendResult(interp," xinc ", tmp_str,(char *)NULL); sprintf(tmp_str,"%lg",image_ptr->yinc); Tcl_AppendResult(interp," yinc ", tmp_str,(char *)NULL); Tcl_AppendResult(interp," xunits ", image_ptr->xunits,(char *)NULL); Tcl_AppendResult(interp," yunits ", image_ptr->yunits,(char *)NULL); if (strcmp(image_ptr->zunits, "") != 0 ) { Tcl_AppendResult(interp," zunits ", image_ptr->zunits,(char *)NULL); } sprintf(tmp_str,"%lg",image_ptr->xotherend+0.5*image_ptr->xinc); Tcl_AppendResult(interp," xotherend ", tmp_str,(char *)NULL); sprintf(tmp_str,"%lg",image_ptr->yotherend+0.5*image_ptr->yinc); Tcl_AppendResult(interp," yotherend ", tmp_str,(char *)NULL); return TCL_OK; } int PowFindCurvesMinMax_Tcl(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]) { /* usage: powFindCurveMinMax curves axis */ /* this is the TCL wrapper for the PowFindCurvesMinMax routine. */ double min, max; char outstring[1024]; if(argc != 3) { Tcl_SetResult(interp, "usage: powFindCurveMinMax curves axis", TCL_VOLATILE); return TCL_ERROR; } min = 6.66e100; max = -6.66e100; PowFindCurvesMinMax(argv[1], argv[2], &min, &max, 0); sprintf(outstring,"%g",min); Tcl_AppendElement(interp,outstring); sprintf(outstring,"%g",max); Tcl_AppendElement(interp,outstring); return TCL_OK; } int PowCreateDataFromChannel(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const argv[] ) { /* usage: powCDFC channel data_name bitpix byteOrder */ Tcl_Channel channel; char buffer[1024]; char *data, *cName, *dName, *bin, *bout; int done=0, copy=-1, status=0, i, j; int nPts, datasize, bitpix, byteOrder, bytesRead, len=0; if( argc!=5 ) { Tcl_SetResult(interp, "usage: powCreateDataFromChannel chanName " "data_name bitpix byteOrder", TCL_VOLATILE); return TCL_ERROR; } cName = Tcl_GetStringFromObj( argv[1], NULL ); dName = Tcl_GetStringFromObj( argv[2], NULL ); Tcl_GetIntFromObj( interp, argv[3], &bitpix ); Tcl_GetIntFromObj( interp, argv[4], &byteOrder ); if( bitpix<0 || bitpix>4 ) { Tcl_SetResult(interp, "Unsupported bitpix value", TCL_VOLATILE); return TCL_ERROR; } channel = Tcl_GetChannel( interp, cName, NULL ); if( channel==NULL ) { Tcl_AppendResult(interp, "Unable to find channel ", cName, NULL); return TCL_ERROR; } switch (bitpix) { case 0: datasize = 1; break; case 1: datasize = 2; break; case 2: datasize = 4; break; case 3: datasize = 4; break; case 4: datasize = 8; break; } while( !done ) { bytesRead = Tcl_Read( channel, buffer, 1024 ); if( len==0 ) { len = bytesRead; data = (char *) ckalloc( bytesRead * sizeof(char) ); } else if( bytesRead>0 ) { len += bytesRead; data = (char *) ckrealloc( data, len * sizeof(char) ); if( bytesRead<1024 ) done=1; } else if( bytesRead==0 ) { done=1; } else { /* ERROR */ if( len>0 ) ckfree( data ); Tcl_AppendResult(interp, "Error reading channel", NULL); return TCL_ERROR; } if( byteOrder>0 || datasize==1 ) { /* fprintf(stdout, "memcpy\n"); */ memcpy( data+len-bytesRead, buffer, bytesRead ); } else { /* fprintf(stdout, "else\n"); */ bin = buffer; bout = data+len-bytesRead; nPts = bytesRead/datasize; for( i=0; i4 ) { Tcl_SetResult(interp, "Unsupported bitpix value", TCL_VOLATILE); return TCL_ERROR; } switch (bitpix) { case 0: datasize = 1; break; case 1: datasize = 2; break; case 2: datasize = 4; break; case 3: datasize = 4; break; case 4: datasize = 8; break; } Tcl_GetIntFromObj(interp, argv[2], &bytesRead); len = bytesRead; /* fprintf(stdout, "PowCreateDataFromBuffer: size of data= %ld\n", len); */ /* fprintf(stdout, "PowCreateDataFromBuffer: byteOrder = %d\n", byteOrder); */ /* fprintf(stdout, "PowCreateDataFromBuffer: datasize = %d\n", datasize); */ data = (char *) ckalloc( bytesRead * sizeof(char)); if ( byteOrder>0 || datasize==1 ) { /* fprintf(stdout, "PowCreateDataFromBuffer: memcpy\n"); */ memcpy( data, Tcl_GetByteArrayFromObj(argv[1], NULL) , bytesRead ); } else { /* fprintf(stdout, "PowCreateDataFromBuffer: else\n"); */ bin = Tcl_GetByteArrayFromObj(argv[1], NULL); bout = data; nPts = bytesRead/datasize; for ( i=0; i4 ) { Tcl_SetResult(interp, "Unsupported bitpix value", TCL_VOLATILE); return TCL_ERROR; } switch (bitpix) { case 0: datasize = 1; break; case 1: datasize = 2; break; case 2: datasize = 4; break; case 3: datasize = 4; break; case 4: datasize = 8; break; } if( byteOrder>0 || datasize==1 ) { copy = 1; } else { bin = (char *)data; bout = (char *)ckalloc( nPts * datasize * sizeof(char) ); for( i=0; i 4) { Tcl_SetResult(interp, "usage: powCreateDataFromList data_name list_o_data ?stringflag?", TCL_VOLATILE); return TCL_ERROR; } if (Tcl_SplitList(interp,argv[2],&largc,&largv) != TCL_OK) { Tcl_SetResult(interp,"Couldn't split input data list",TCL_VOLATILE); return TCL_ERROR; } if (argc == 4) { if (Tcl_GetBoolean(interp,argv[3],&string_flag) != TCL_OK) { Tcl_SetResult(interp,"Couldn't convert stringflag to boolean", TCL_VOLATILE); return TCL_ERROR; } } if (string_flag) { i=0; j=STRING_DATA; PowCreateData(argv[1],(void *)largv,&j,&largc,&i,&status); } else { data = (double *)ckalloc(largc * sizeof(double)); counter = largv; datacounter = data; for (i=0;icopy = 1; /*Return the string representation of the PowData pointer */ sprintf(ptrString,PTRFORMAT,data_instance); Tcl_SetResult(interp,ptrString,TCL_VOLATILE); return TCL_OK; } int PowCreateStrFromPtr(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const argv[] ) { Tcl_Obj **dList; char *data, *dPtr; int i, j; int nPts, datasize, bitpix; if( argc!=4 ) { Tcl_SetResult(interp, "usage: powCreateStrFromPtr " "address bitpix naxes", TCL_VOLATILE); return TCL_ERROR; } dPtr = Tcl_GetStringFromObj( argv[1], NULL ); if (sscanf(dPtr,PTRFORMAT,&data) != 1) { Tcl_SetResult(interp,"Couldn't parse data address into an integer", TCL_VOLATILE); return TCL_ERROR; } Tcl_GetIntFromObj( interp, argv[2], &bitpix ); /* Read NAXES list and calculate data length */ if( Tcl_ListObjGetElements( interp, argv[3], &i, &dList ) != TCL_OK ) { Tcl_AppendResult(interp, "Bad naxes parameter", TCL_VOLATILE); return TCL_ERROR; } for( nPts=1; i; ) { Tcl_GetIntFromObj( interp, dList[--i], &j ); nPts *= j; } if( bitpix<0 || bitpix>4 ) { Tcl_SetResult(interp, "Unsupported bitpix value", TCL_VOLATILE); return TCL_ERROR; } switch (bitpix) { case 0: datasize = 1; break; case 1: datasize = 2; break; case 2: datasize = 4; break; case 3: datasize = 4; break; case 4: datasize = 8; break; } Tcl_SetObjResult( interp, Tcl_NewStringObj( data, nPts * datasize ) ); return TCL_OK; } int PowGraphToCanvas( ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const argv[]) { PowGraph *graph; Tcl_Obj *list, *elem[4]; double x, y, xorig, yorig; double xorig_curr, yorig_curr; char *canvas=".pow.pow"; char *graphName; int len; char *idxStr; const char *graphType; int zoomed; int xCount, yCount; int graph_is_scope; if( argc < 4 || argc > 5 ) { Tcl_SetResult(interp,"usage: powGraphToCanvas graph x y ?canvas?", TCL_VOLATILE); return TCL_ERROR; } graphName = Tcl_GetStringFromObj( argv[1], NULL ); graph = PowFindGraph( graphName ); if( graph==NULL ) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "Graph ",graphName," does not exist", NULL); return TCL_ERROR; } Tcl_GetDoubleFromObj(interp, argv[2], &x); Tcl_GetDoubleFromObj(interp, argv[3], &y); if( argc==5 ) canvas = Tcl_GetStringFromObj( argv[4], NULL ); Tcl_VarEval(interp, canvas, " coords ",graphName, "box", NULL); list = Tcl_GetObjResult(interp); Tcl_ListObjIndex(interp, list, 0, &elem[0]); Tcl_ListObjIndex(interp, list, 1, &elem[1]); Tcl_ListObjIndex(interp, list, 2, &elem[2]); Tcl_ListObjIndex(interp, list, 3, &elem[3]); if( elem[0]==NULL || elem[3]==NULL ) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "Unable to find bbox for ", graphName, " in ",canvas, NULL); return TCL_ERROR; } Tcl_GetDoubleFromObj(interp, elem[0], &xorig); Tcl_GetDoubleFromObj(interp, elem[3], &yorig); len = strlen(graphName)+15; idxStr = (char *) ckalloc( len*sizeof(char) ); sprintf(idxStr, "%s,%s", "graphType", graphName); graphType = Tcl_GetVar2(interp,"powPlotParam",idxStr,TCL_GLOBAL_ONLY); ckfree(idxStr); len = strlen(graphName)+15; idxStr = (char *) ckalloc( len*sizeof(char) ); sprintf(idxStr, "%s,%s", "zoomed", graphName); zoomed = atoi(Tcl_GetVar2(interp,"powPlotParam",idxStr,TCL_GLOBAL_ONLY)); ckfree(idxStr); xCount = atoi(Tcl_GetVar2(interp,"xCount",graphName,TCL_GLOBAL_ONLY)); yCount = atoi(Tcl_GetVar2(interp,"yCount",graphName,TCL_GLOBAL_ONLY)); /* Chai 06/29/2007: We are not actually fliping the coordinates on the canvas. If tk allows this, then there is no need to do the following. What the logic below is to trick pow to think that the point on the canvas has been flipped. The xCount and yCount indicate if the graph has been flipped before. So if X has been previously flipped, the next flipping occurs on Y, the logic inside ..Count % 2 will make sure the information on previous flip still exists. */ /* fprintf(stdout, "powGraphToCanvas xorig, yorig (%20.15f, %20.15f)\n", xorig, yorig); fflush(stdout); */ if (strcmp(graphType, "binary") == 0 && xCount % 2 != 0) { Tcl_GetDoubleFromObj(interp, elem[2], &xorig_curr); } if (strcmp(graphType, "binary") == 0 && yCount % 2 != 0) { Tcl_GetDoubleFromObj(interp, elem[1], &yorig_curr); } if( PowPosToPix( x, y, &graph->WCS, &x, &y ) != TCL_OK ) return TCL_ERROR; idxStr = strstr(graphName, "scope"); graph_is_scope = 0; if (idxStr != (char *)NULL) { graph_is_scope = 1; } /* fprintf(stdout, "graphName: <%s>, graph_is_scope: <%d>\n", graphName, graph_is_scope); fflush(stdout); */ if ( strcmp(graphType, "binary") == 0 && xCount % 2 != 0 ) { if ( graph->WCS.type[0] != '\0' ) { /* previous flip */ x = xorig + x * graph->xmagstep; } else { x = xorig + (-1.0 * x) * graph->xmagstep; } } else { x = xorig + x * graph->xmagstep; } if ( strcmp(graphType, "binary") == 0 && yCount % 2 != 0 ) { /* previous flip */ if ( graph->WCS.type[0] != '\0' ) { y = yorig - y * graph->ymagstep; } else { y = yorig - (-1.0 * y) * graph->ymagstep; } } else { y = yorig - y * graph->ymagstep; } elem[0] = Tcl_NewDoubleObj(x); elem[1] = Tcl_NewDoubleObj(y); list = Tcl_NewListObj(2,elem); Tcl_SetObjResult(interp, list); /* fprintf(stdout, " return x, y (%20.15f, %20.15f)\n", x, y); fflush(stdout); */ return TCL_OK; } int PowCanvasToGraph( ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const argv[]) { PowGraph *graph; Tcl_Obj *list, *elem[4]; double x, y, xorig, yorig; double xorig_curr, yorig_curr; char *canvas=".pow.pow"; char *graphName; int len; char *idxStr; const char *graphType; int zoomed; int xCount, yCount; int graph_is_scope; if( argc < 4 || argc > 5 ) { Tcl_SetResult(interp,"usage: powCanvasToGraph graph x y {canvas}", TCL_VOLATILE); return TCL_ERROR; } graphName = Tcl_GetStringFromObj( argv[1], NULL ); graph = PowFindGraph( graphName ); if( graph==NULL ) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "Graph ",graphName," does not exist", NULL); return TCL_ERROR; } Tcl_GetDoubleFromObj(interp, argv[2], &x); Tcl_GetDoubleFromObj(interp, argv[3], &y); if( argc==5 ) canvas = Tcl_GetStringFromObj( argv[4], NULL ); Tcl_VarEval(interp, canvas, " coords ",graphName, "box", NULL); list = Tcl_GetObjResult(interp); Tcl_ListObjIndex(interp, list, 0, &elem[0]); Tcl_ListObjIndex(interp, list, 1, &elem[1]); Tcl_ListObjIndex(interp, list, 2, &elem[2]); Tcl_ListObjIndex(interp, list, 3, &elem[3]); Tcl_GetDoubleFromObj(interp, elem[0], &xorig); Tcl_GetDoubleFromObj(interp, elem[3], &yorig); len = strlen(graphName)+15; idxStr = (char *) ckalloc( len*sizeof(char) ); sprintf(idxStr, "%s,%s", "graphType", graphName); graphType = Tcl_GetVar2(interp,"powPlotParam",idxStr,TCL_GLOBAL_ONLY); ckfree(idxStr); len = strlen(graphName)+15; idxStr = (char *) ckalloc( len*sizeof(char) ); sprintf(idxStr, "%s,%s", "zoomed", graphName); zoomed = atoi(Tcl_GetVar2(interp,"powPlotParam",idxStr,TCL_GLOBAL_ONLY)); ckfree(idxStr); xCount = atoi(Tcl_GetVar2(interp,"xCount",graphName,TCL_GLOBAL_ONLY)); yCount = atoi(Tcl_GetVar2(interp,"yCount",graphName,TCL_GLOBAL_ONLY)); if ( strcmp(graphType, "binary") == 0 && xCount % 2 != 0 ) { Tcl_GetDoubleFromObj(interp, elem[2], &xorig_curr); } if ( strcmp(graphType, "binary") == 0 && yCount % 2 != 0 ) { Tcl_GetDoubleFromObj(interp, elem[1], &yorig_curr); } idxStr = strstr(graphName, "scope"); graph_is_scope = 0; if (idxStr != (char *)NULL) { graph_is_scope = 1; } /* Chai 06/29/2007: We are not actually fliping the coordinates on the canvas. If tk allows this, then there is no need to do the following. What the logic below is to trick pow to think that the point on the canvas has been flipped. The xCount and yCount indicate if the graph has been flipped before. So if X has been previously flipped, the next flipping occurs on Y, the logic inside ..Count % 2 will make sure the information on previous flip still exists. */ if ( strcmp(graphType, "binary") == 0 && xCount % 2 != 0 ) { /* previous flip */ if ( graph->WCS.type[0] != '\0' ) { x = (x - xorig) / graph->xmagstep; } else { x = (xorig - x) / graph->xmagstep; } } else { x = (x - xorig) / graph->xmagstep; } if ( strcmp(graphType, "binary") == 0 && yCount % 2 != 0 ) { /* previous flip */ if ( graph->WCS.type[0] != '\0' ) { y = (yorig - y) / graph->ymagstep; } else { y = (y - yorig) / graph->ymagstep; } } else { y = (yorig - y) / graph->ymagstep; } if( PowPixToPos( x, y, &graph->WCS, &x, &y ) != TCL_OK ) return TCL_ERROR; elem[0] = Tcl_NewDoubleObj(x); elem[1] = Tcl_NewDoubleObj(y); list = Tcl_NewListObj(2,elem); Tcl_SetObjResult(interp, list); return TCL_OK; } int PowResetWcsStructure ( ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const argv[]) { PowGraph *graph; PowGraph *scopegraph; PowImage *image; PowCurve *curve; double refpix_1, refpix_2, xoff, yoff; char *graphName, *operation, *direction; int wcsStatus; const char *WCSstring; char powWCS[7]="powWCS"; char curveName[512]; char scopeName[1024]; int coordSel; if( argc != 5 && argc != 6 ) { Tcl_SetResult(interp,"usage: powResetWcsStructure <-g/-r graph refpix1/xoff refpix2/yoff> or <-d direction refpix1 refpix2>", TCL_VOLATILE); return TCL_ERROR; } operation = Tcl_GetStringFromObj( argv[1], NULL ); graphName = Tcl_GetStringFromObj( argv[2], NULL ); sprintf(scopeName, "%sscope", graphName); graph = PowFindGraph( graphName ); scopegraph = PowFindGraph( scopeName ); if( scopegraph==NULL ) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "graph Object ",scopeName," does not exist", NULL); return TCL_ERROR; } if( graph==NULL ) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "graph Object ",graphName," does not exist", NULL); return TCL_ERROR; } Tcl_GetDoubleFromObj(interp, argv[3], &refpix_1); Tcl_GetDoubleFromObj(interp, argv[4], &refpix_2); if (!strcmp(operation, "-g")) { graph->WCS.haveWCSinfo = 0; PowPosToPix( graph->xleft, graph->ybot, &graph->WCS, &xoff, &yoff ); graph->WCS.refPix[0] = refpix_1 + xoff; graph->WCS.refPix[1] = refpix_2 + yoff; graph->xoff = xoff; graph->yoff = yoff; } else if (!strcmp(operation, "-r")) { /* user refpix_1 and 2 for storage only, purpose is to reset xoff and yoff back to 0.0 */ graph->xoff = 0.0; graph->yoff = 0.0; } else if (!strcmp(operation, "-d")) { if (graph->WCS.haveWCSinfo == 0) return TCL_OK; image = PowFindImage ( graphName ); if( image == NULL ) { curve = PowFindCurve( graphName ); if ( curve == NULL ) { sprintf(curveName, "c1_%s", graphName); curve = PowFindCurve( curveName ); if ( curve == NULL ) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "Curve ", curveName," does not exist", NULL); return TCL_ERROR; } } } direction = Tcl_GetStringFromObj( argv[3], NULL ); Tcl_GetDoubleFromObj(interp, argv[4], &refpix_1); Tcl_GetDoubleFromObj(interp, argv[5], &refpix_2); coordSel = atoi(Tcl_GetVar2(interp,"powWCSName",graphName,TCL_GLOBAL_ONLY)); if (!strcmp(direction, "X")) { graph->WCS.wcs[coordSel].cdelt[0] *= -1.0f; scopegraph->WCS.wcs[coordSel].cdelt[0] *= -1.0f; } else if (!strcmp(direction, "Y")) { graph->WCS.wcs[coordSel].cdelt[1] *= -1.0f; scopegraph->WCS.wcs[coordSel].cdelt[1] *= -1.0f; } else if (!strcmp(direction, "B") || !strcmp(direction, "U")) { graph->WCS.wcs[coordSel].cdelt[0] *= -1.0f; graph->WCS.wcs[coordSel].cdelt[1] *= -1.0f; scopegraph->WCS.wcs[coordSel].cdelt[0] *= -1.0f; scopegraph->WCS.wcs[coordSel].cdelt[1] *= -1.0f; } graph->WCS.haveWCSinfo = 1; graph->WCS.refPix[0] = refpix_1 + graph->xoff; graph->WCS.refPix[1] = refpix_2 + graph->yoff; /* fprintf(stdout, "X graph->xleft (%20.15f), graph->xright (%20.15f)\n", graph->xleft, graph->xright); fprintf(stdout, "X graph->ybot (%20.15f), graph->ytop (%20.15f)\n", graph->ybot, graph->ytop); fflush(stdout); */ wcsStatus = TCL_ERROR; if ( image != NULL ) { image->WCS.refPix[0] = graph->WCS.refPix[0]; image->WCS.refPix[1] = graph->WCS.refPix[1]; image->WCS.wcs[coordSel].cdelt[0] = graph->WCS.wcs[coordSel].cdelt[0]; image->WCS.wcs[coordSel].cdelt[1] = graph->WCS.wcs[coordSel].cdelt[1]; WCSstring = Tcl_GetVar2(interp,powWCS,image->WCS.graphName,TCL_GLOBAL_ONLY); if( (WCSstring != NULL) && strcmp(WCSstring,"") ) { wcsStatus = Tcl_VarEval(interp, "powWCSInitImage ", image->WCS.graphName, " ", WCSstring, (char *) NULL); } FillinWCSStructure (&image->WCS); refpix_1 = image->WCS.refPix[0]; refpix_2 = image->WCS.refPix[1]; } else { curve->WCS.refPix[0] = graph->WCS.refPix[0]; curve->WCS.refPix[1] = graph->WCS.refPix[1]; curve->WCS.wcs[coordSel].cdelt[0] = graph->WCS.wcs[coordSel].cdelt[0]; curve->WCS.wcs[coordSel].cdelt[1] = graph->WCS.wcs[coordSel].cdelt[1]; WCSstring = Tcl_GetVar2(interp,powWCS,curve->WCS.curveName,TCL_GLOBAL_ONLY); if( (WCSstring != NULL) && strcmp(WCSstring,"") != 0 ) { wcsStatus = Tcl_VarEval(interp, "powWCSInitCurve ", curve->WCS.curveName, " ", WCSstring, (char *) NULL); } FillinWCSStructure (&curve->WCS); refpix_1 = curve->WCS.refPix[0]; refpix_2 = curve->WCS.refPix[1]; } } graph->WCS.refPix[0] = refpix_1; graph->WCS.refPix[1] = refpix_2; strcpy(graph->WCS.graphName, graphName); strcpy(graph->WCS.curveName, "\0"); FillinWCSStructure (&graph->WCS); strcpy(scopegraph->WCS.graphName, graphName); FillinWCSStructure (&scopegraph->WCS); return TCL_OK; } int PowPixelToGraph( ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const argv[]) { PowImage *image; PowCurve *curve; Tcl_Obj *list, *elem[2]; double x, y; char *objName; if( argc != 4 ) { Tcl_SetResult(interp,"usage: powPixelToGraph image|curve x y}", TCL_VOLATILE); return TCL_ERROR; } objName = Tcl_GetStringFromObj( argv[1], NULL ); Tcl_GetDoubleFromObj(interp, argv[2], &x); Tcl_GetDoubleFromObj(interp, argv[3], &y); image = PowFindImage( objName ); if( image ) { if( PowPixToPos( x, y, &image->WCS, &x, &y ) != TCL_OK ) return TCL_ERROR; } else { curve = PowFindCurve( objName ); if( curve ) { if( PowPixToPos( x, y, &curve->WCS, &x, &y ) != TCL_OK ) return TCL_ERROR; } else { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "Object ",objName," does not exist", NULL); return TCL_ERROR; } } elem[0] = Tcl_NewDoubleObj(x); elem[1] = Tcl_NewDoubleObj(y); list = Tcl_NewListObj(2,elem); Tcl_SetObjResult(interp, list); return TCL_OK; } int PowGraphToPixel( ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const argv[]) { PowImage *image; PowCurve *curve; Tcl_Obj *list, *elem[2]; double x, y; char *objName; if( argc != 4 ) { Tcl_SetResult(interp,"usage: powGraphToPixel image|curve x y", TCL_VOLATILE); return TCL_ERROR; } objName = Tcl_GetStringFromObj( argv[1], NULL ); Tcl_GetDoubleFromObj(interp, argv[2], &x); Tcl_GetDoubleFromObj(interp, argv[3], &y); image = PowFindImage( objName ); if( image ) { if( PowPosToPix( x, y, &image->WCS, &x, &y ) != TCL_OK ) return TCL_ERROR; } else { curve = PowFindCurve( objName ); if( curve ) { if( PowPosToPix( x, y, &curve->WCS, &x, &y ) != TCL_OK ) return TCL_ERROR; } else { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "Object ",objName," does not exist", NULL); return TCL_ERROR; } } elem[0] = Tcl_NewDoubleObj(x); elem[1] = Tcl_NewDoubleObj(y); list = Tcl_NewListObj(2,elem); Tcl_SetObjResult(interp, list); return TCL_OK; } int PowPixelVToGraphV( ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const argv[]) { PowImage *image; PowCurve *curve; WCSdata *WCS; Tcl_Obj *list, *elem[2]; double x, y, xorig, yorig; char *objName; if( argc != 4 ) { Tcl_SetResult(interp,"usage: powPixelVToGraphV image|curve dx dy}", TCL_VOLATILE); return TCL_ERROR; } objName = Tcl_GetStringFromObj( argv[1], NULL ); Tcl_GetDoubleFromObj(interp, argv[2], &xorig); Tcl_GetDoubleFromObj(interp, argv[3], &yorig); image = PowFindImage( objName ); if( image ) { WCS = &image->WCS; } else { curve = PowFindCurve( objName ); if( curve ) { WCS = &curve->WCS; } else { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "Object ",objName," does not exist", NULL); return TCL_ERROR; } } x = WCS->cdFrwd[0][0] * xorig + WCS->cdFrwd[0][1] * yorig; y = WCS->cdFrwd[1][0] * xorig + WCS->cdFrwd[1][1] * yorig; elem[0] = Tcl_NewDoubleObj(x); elem[1] = Tcl_NewDoubleObj(y); list = Tcl_NewListObj(2,elem); Tcl_SetObjResult(interp, list); return TCL_OK; } int PowGraphVToPixelV( ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const argv[]) { PowImage *image; PowCurve *curve; WCSdata *WCS; Tcl_Obj *list, *elem[2]; double x, y, xorig, yorig; char *objName; if( argc != 4 ) { Tcl_SetResult(interp,"usage: powGraphVToPixelV image|curve dx dy", TCL_VOLATILE); return TCL_ERROR; } objName = Tcl_GetStringFromObj( argv[1], NULL ); Tcl_GetDoubleFromObj(interp, argv[2], &xorig); Tcl_GetDoubleFromObj(interp, argv[3], &yorig); image = PowFindImage( objName ); if( image ) { WCS = &image->WCS; } else { curve = PowFindCurve( objName ); if( curve ) { WCS = &curve->WCS; } else { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "Object ",objName," does not exist", NULL); return TCL_ERROR; } } x = WCS->cdRvrs[0][0] * xorig + WCS->cdRvrs[0][1] * yorig; y = WCS->cdRvrs[1][0] * xorig + WCS->cdRvrs[1][1] * yorig; elem[0] = Tcl_NewDoubleObj(x); elem[1] = Tcl_NewDoubleObj(y); list = Tcl_NewListObj(2,elem); Tcl_SetObjResult(interp, list); return TCL_OK; } int PowGetImageClipbox( ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const argv[]) { PowGraph *graph; PowImage *image; Tcl_Obj *list, *clip[6]; char *graphName, *imageName; double xorigin, yorigin, xother, yother, gWidth, gHeight; double xscale, yscale, xleft, ybot; /* FILE *fp; */ if( argc < 3 || argc > 4 ) { Tcl_SetResult(interp,"usage: powGetImageClipbox graph image ?canvas?", TCL_VOLATILE); return TCL_ERROR; } graphName = Tcl_GetStringFromObj( argv[1], NULL ); graph = PowFindGraph( graphName ); if( graph==NULL ) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "Graph ",graphName," does not exist", NULL); return TCL_ERROR; } imageName = Tcl_GetStringFromObj( argv[2], NULL ); image = PowFindImage( imageName ); if( image==NULL ) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "Image ",imageName," does not exist", NULL); return TCL_ERROR; } /* fprintf(fp, "PowCommands: image->xorigin: %f\n", image->xorigin); */ /* fprintf(fp, "PowCommands: image->yorigin: %f\n", image->yorigin); */ /* fprintf(fp, "PowCommands: image->xotherend: %f\n", image->xotherend); */ /* fprintf(fp, "PowCommands: image->yotherend: %f\n", image->yotherend); */ PowPosToPix( image->xorigin, image->yorigin, &graph->WCS, &xorigin, &yorigin ); PowPosToPix( image->xotherend, image->yotherend, &graph->WCS, &xother, &yother ); PowPosToPix( graph->xright, graph->ytop, &graph->WCS, &gWidth, &gHeight ); if( xother<=0.0 || yother<=0.0 || xorigin>=gWidth || yorigin>=gHeight ) { Tcl_SetResult(interp,"clipped", TCL_VOLATILE); return TCL_OK; } /* fprintf(fp, "PowCommands: xother: %f\n", xother); */ /* fprintf(fp, "PowCommands: yother: %f\n", yother); */ /* fprintf(fp, "PowCommands: xorigin: %f\n", xorigin); */ /* fprintf(fp, "PowCommands: yorigin: %f\n", yorigin); */ /* fprintf(fp, "PowCommands: image->width: %f\n", image->width); */ /* fprintf(fp, "PowCommands: image->height: %f\n", image->height); */ xscale = image->width / (xother - xorigin); yscale = image->height / (yother - yorigin); /* fprintf(fp, "PowCommands: xscale: %f\n", xscale); */ /* fprintf(fp, "PowCommands: yscale: %f\n", yscale); */ if( xorigin < 0.0 ) { xleft = - xorigin * xscale; xorigin = 0.0; } else xleft = 0.0; if( yorigin < 0.0 ) { ybot = - yorigin * yscale; yorigin = 0.0; } else ybot = 0.0; /* fprintf(fp, "PowCommands: xleft: %f\n", xleft); */ /* fprintf(fp, "PowCommands: ybot: %f\n", ybot); */ if( xother > gWidth ) xother = image->width - (xother-gWidth) * xscale; else xother = image->width; if( yother > gHeight ) yother = image->height - (yother-gHeight) * yscale; else yother = image->height; /* fprintf(fp, "PowCommands: xother: %f\n", xother); */ /* fprintf(fp, "PowCommands: yother: %f\n", yother); */ /* fprintf(fp, "***************************\n"); */ PowPixToPos( xorigin, yorigin, &graph->WCS, &xorigin, &yorigin ); clip[0] = Tcl_NewDoubleObj(xorigin ); clip[1] = Tcl_NewDoubleObj(yorigin ); clip[2] = Tcl_NewDoubleObj(xleft -0.5); clip[3] = Tcl_NewDoubleObj(ybot -0.5); clip[4] = Tcl_NewDoubleObj(xother -0.5); clip[5] = Tcl_NewDoubleObj(yother -0.5); list = Tcl_NewListObj(6,clip); Tcl_SetObjResult(interp, list); /* fclose(fp); */ return TCL_OK; } int PowWCSexists( ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const argv[]) { PowGraph *graph; Tcl_Obj *result; char *graphName; if( argc != 2 ) { Tcl_SetResult(interp,"usage: powWCSexists graph", TCL_VOLATILE); return TCL_ERROR; } graphName = Tcl_GetStringFromObj( argv[1], NULL ); graph = PowFindGraph( graphName ); if( graph==NULL ) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "Graph ",graphName," does not exist", NULL); return TCL_ERROR; } result = Tcl_NewBooleanObj( graph->WCS.type[0]!='\0' ); Tcl_SetObjResult(interp, result); return TCL_OK; } int PowWCSisSwapped( ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const argv[]) { PowGraph *graph; Tcl_Obj *result; char *graphName; if( argc != 2 ) { Tcl_SetResult(interp,"usage: powWCSisSwapped graph", TCL_VOLATILE); return TCL_ERROR; } graphName = Tcl_GetStringFromObj( argv[1], NULL ); graph = PowFindGraph( graphName ); if( graph==NULL ) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "Graph ",graphName," does not exist", NULL); return TCL_ERROR; } /* for the unknown WCS type, always set the swap to zero */ if (graph->WCS.type[0]=='\0') graph->WCS.RaDecSwap = 0; result = Tcl_NewLongObj( graph->WCS.RaDecSwap ); Tcl_SetObjResult(interp, result); return TCL_OK; } /* Get the centroid and flux */ int PowGetRegionStatistics( ClientData clientData, Tcl_Interp *interp, int argc, char **argv ) { char *imgName; PowImage *image_ptr; char *descr; char *cPar; char *shape; char *sign; char *regionFile; double *dataPar; const char **argvPtr; int i, numPars; int plen; double cent[2], cstd[2],flux, npix; double mean,dmean; double a,b,c,d; char results[512]; int ix,iy; char *ptr; int rect[4]; int status; int good; if(argc != 6) { Tcl_SetResult( interp, "usage: powGetGetRegionStatistics image regionFile/NONE descr shape sign", TCL_VOLATILE ); good = 0; return TCL_ERROR; } imgName = argv[1]; image_ptr = PowFindImage( imgName ); if (image_ptr == (PowImage *) NULL) { Tcl_AppendResult(interp, "Couldn't find image: ",imgName, NULL); good = 0; return TCL_ERROR; } regionFile = argv[2]; descr = argv[3]; shape = argv[4]; sign = argv[5]; plen = strlen(descr); /* parse the parameters */ cPar = (char *)malloc ((plen+1)*sizeof(char)); strcpy(cPar,descr); ptr = cPar; while ( *ptr!='\0') { if( *ptr == ','|| *ptr == '(' || *ptr == ')' ) *ptr = ' '; ptr++; } if(Tcl_SplitList(interp, cPar, &numPars, &argvPtr) != TCL_OK ) { good = 0; return TCL_ERROR; } dataPar = (double*) malloc(numPars*sizeof(double)); for (i=0; idataptr, iy * image_ptr->width + ix); cent[0] = dataPar[0]; cent[1] = dataPar[1]; good = 1; } if (!strcmp(shape,"Line")) { good = 0; } /* Find the binding box for circle, box, ellipse, and polygon */ if (!strcmp(shape,"Circle")) { rect[0] = (int)(dataPar[0] - dataPar[2] + 0.5 -1) ; rect[1] = (int)(dataPar[1] - dataPar[2] + 0.5 -1) ; rect[2] = (int)(dataPar[0] + dataPar[2] + 0.5 +1) ; rect[3] = (int)(dataPar[1] + dataPar[2] + 0.5 +1) ; } if (!strcmp(shape,"Box")) { a = sqrt(dataPar[2]*dataPar[2]+dataPar[3]*dataPar[3])/2.0; rect[0] = (int)(dataPar[0] - a + 0.5 -1) ; rect[1] = (int)(dataPar[1] - a + 0.5 -1) ; rect[2] = (int)(dataPar[0] + a + 0.5 +1) ; rect[3] = (int)(dataPar[1] + a + 0.5 +1) ; } if (!strcmp(shape,"Ellipse")) { a = sqrt(dataPar[2]*dataPar[2]+dataPar[3]*dataPar[3]); rect[0] = (int)(dataPar[0] - a + 0.5 -1) ; rect[1] = (int)(dataPar[1] - a + 0.5 -1) ; rect[2] = (int)(dataPar[0] + a + 0.5 +1) ; rect[3] = (int)(dataPar[1] + a + 0.5 +1) ; } if (!strcmp(shape,"Polygon")) { a = dataPar[0]; b = dataPar[1]; c = dataPar[0]; d = dataPar[1]; for (i = 0; i < numPars/2; i++) { a = a > dataPar[2*i] ? dataPar[2*i] : a; b = b > dataPar[2*i+1] ? dataPar[2*i+1] : b; c = c < dataPar[2*i] ? dataPar[2*i] : c; d = d < dataPar[2*i+1] ? dataPar[2*i+1] : d; } rect[0] = (int)(a + 0.5 -1) ; rect[1] = (int)(b + 0.5 -1) ; rect[2] = (int)(c + 0.5 +1) ; rect[3] = (int)(d + 0.5 +1) ; } status = 0; PowCalRegion(image_ptr, regionFile, rect,dataPar, numPars, shape,sign, cent, cstd, &flux, &npix, &mean, &dmean, &status); if(status == 0) good = 1; else good = 0; sprintf(results,"%d %g %g %g %g %g %g %g %g",good,cent[0],cent[1],cstd[0], cstd[1], flux, npix, mean, dmean); Tcl_SetResult( interp, results,TCL_VOLATILE ); free(dataPar); free(cPar); return TCL_OK; } /*---------------------------------------------------------------------- * * Pow_PhotoPutScaledBlock (formerly Tk_PhotoPutScaledBlock) -- * * This procedure is called to put image data into a photo image, * with possible zooming of the pixels. * * Results: * None. * * Side effects: * The image data is stored. The image may be expanded. * The Tk image code is informed that the image has changed. * *----------------------------------------------------------------------*/ void Pow_PhotoPutScaledBlock(handle, blockPtr, x, y, width, height, zoomX, zoomY, Xoff, Yoff) Tk_PhotoHandle handle; /* Opaque handle for the photo image * to be updated. */ register Tk_PhotoImageBlock *blockPtr; /* Pointer to a structure describing the * pixel data to be copied into the image. */ int x, y; /* Coordinates of the top-left pixel to * be updated in the image. */ int width, height; /* Dimensions of the area of the image * to be updated. */ double zoomX, zoomY; /* Zoom factors for the X and Y axes. */ double Xoff, Yoff; /* Offset into initial pixel data */ { int greenOffset, blueOffset, alphaOffset; int wCopy, hCopy; unsigned char *srcPtr, *srcLinePtr; unsigned char *destPtr, *destLinePtr; int pitch; double xRepeat, yRepeat; int blockXSkip, blockYSkip; Tk_PhotoImageBlock destBlockPtr; if( (zoomX <= 0.0) || (zoomY <= 0.0) || (width <= 0) || (height <= 0) || (x < 0) || (y < 0) ) return; if( (zoomX == 1.0) && (zoomY == 1.0) ) { Tk_PhotoPutBlock(interp, handle, blockPtr, x, y, width, height, TK_PHOTO_COMPOSITE_SET); return; } Tk_PhotoExpand(interp, handle, x+width, y+height); Tk_PhotoGetImage(handle, &destBlockPtr); /* * If this image block could have different red, green and blue * components, mark it as a color image. */ greenOffset = blockPtr->offset[1] - blockPtr->offset[0]; blueOffset = blockPtr->offset[2] - blockPtr->offset[0]; alphaOffset = blockPtr->offset[3]; if ((alphaOffset >= blockPtr->pixelSize) || (alphaOffset < 0)) { alphaOffset = 0; } else { alphaOffset -= blockPtr->offset[0]; } /* * Copy the data into the destination's 32-bit/pixel array. */ destLinePtr = destBlockPtr.pixelPtr + (y * destBlockPtr.width + x) * 4; pitch = destBlockPtr.width * 4; srcLinePtr = blockPtr->pixelPtr + blockPtr->offset[0]; blockXSkip = blockPtr->pixelSize; blockYSkip = blockPtr->pitch; yRepeat = Yoff; for (hCopy=height; hCopy > 0; hCopy--) { destPtr = destLinePtr; srcPtr = srcLinePtr; xRepeat = Xoff; for (wCopy=width; wCopy > 0; wCopy--) { if (!destPtr[3]) { destPtr[0] = destPtr[1] = destPtr[2] = 0xd9; } if (!alphaOffset || (srcPtr[alphaOffset] == 255)) { *destPtr++ = srcPtr[0]; *destPtr++ = srcPtr[greenOffset]; *destPtr++ = srcPtr[blueOffset]; *destPtr++ = 255; } else { if (srcPtr[alphaOffset]) { destPtr[0] += (srcPtr[0] - destPtr[0]) * srcPtr[alphaOffset] / 255; destPtr[1] += (srcPtr[greenOffset] - destPtr[1]) * srcPtr[alphaOffset] / 255; destPtr[2] += (srcPtr[blueOffset] - destPtr[2]) * srcPtr[alphaOffset] / 255; destPtr[3] += (255 - destPtr[3]) * srcPtr[alphaOffset] / 255; } destPtr+=4; } xRepeat--; while( xRepeat <= 0.0 ) { srcPtr += blockXSkip; xRepeat += zoomX; } } destLinePtr += pitch; yRepeat--; while( yRepeat <= 0.0 ) { srcLinePtr += blockYSkip; yRepeat += zoomY; } } Tk_PhotoPutBlock(interp, handle, &destBlockPtr, x, y, width, height, TK_PHOTO_COMPOSITE_SET); } fv5.5/tcltk/pow/PowCreateCurve.c0000644000220700000360000002320713224715127015515 0ustar birbylhea#include "pow.h" void PowCreateCurve(char *curve_name, char *x_vector, char *x_error, char *y_vector, char *y_error, char *z_vector, char *z_error, int *status) { /*Until we see a problem with this, the length of the curve is the length of the x-vector (or y-vector if x-vector is null) or z- vector if y-vector is null)). If any of the other non-null vectors are shorter than this, the command returns an error.*/ PowCurve *curve_instance; Tcl_HashEntry *entry_ptr; int new = 0, wcsStatus; char *str_ptr; int length = 0; const char *WCSstring; char powWCS[7]="powWCS"; entry_ptr = Tcl_CreateHashEntry(&PowCurveTable, curve_name, &new); #ifdef DEBUG if (!new) { printf("Reusing curve name: %s\n",curve_name); } #endif curve_instance = (PowCurve *) ckalloc(sizeof(PowCurve)); if(curve_instance == NULL) { *status = TCL_ERROR; fprintf(stderr, "Couldn't malloc curve structure space"); Tcl_DeleteHashEntry(entry_ptr); return; } Tcl_SetHashValue( entry_ptr, curve_instance); str_ptr = ckalloc(strlen(curve_name)+1); strncpy(str_ptr,curve_name,strlen(curve_name)+1); curve_instance->curve_name = str_ptr; length = 0; if ((curve_instance->x_vector = PowFindVector(x_vector)) != NULL) { length = (curve_instance->x_vector)->length; if ((curve_instance->x_error = PowFindVector(x_error)) != NULL) { if ((curve_instance->x_error)->length < length) { *status = TCL_ERROR; fprintf(stderr, "x_error vector too short\n"); Tcl_DeleteHashEntry(entry_ptr); return; } } }else if ((curve_instance->x_error = PowFindVector(x_error)) != NULL) { /*we've got an x_error but no x_vector */ *status = TCL_ERROR; fprintf(stderr, "Can't have an X error without an X vector\n"); Tcl_DeleteHashEntry(entry_ptr); return; } if ((curve_instance->y_vector = PowFindVector(y_vector)) != NULL) { if(length == 0) { length = (curve_instance->y_vector)->length; } else { if( length > (curve_instance->y_vector)->length) { *status = TCL_ERROR; fprintf(stderr, "Y vector shorter than X vector\n"); Tcl_DeleteHashEntry(entry_ptr); return; } } if ((curve_instance->y_error = PowFindVector(y_error)) != NULL) { if ((curve_instance->y_error)->length < length) { *status = TCL_ERROR; fprintf(stderr, "y_error vector too short\n"); Tcl_DeleteHashEntry(entry_ptr); return; } } }else if ((curve_instance->y_error = PowFindVector(y_error)) != NULL) { /*we've got an y_error but no y_vector */ *status = TCL_ERROR; fprintf(stderr, "Can't have a Y error without a Y vector\n"); Tcl_DeleteHashEntry(entry_ptr); return; } if ((curve_instance->z_vector = PowFindVector(z_vector)) != NULL) { if(length == 0) { length = (curve_instance->z_vector)->length; } else { if( length > (curve_instance->z_vector)->length) { *status = TCL_ERROR; fprintf(stderr, "Z vector too short.\n"); Tcl_DeleteHashEntry(entry_ptr); return; } } if ((curve_instance->z_error = PowFindVector(z_error)) != NULL) { if ((curve_instance->z_error)->length < length) { *status = TCL_ERROR; fprintf(stderr, "z_error vector too short.\n"); Tcl_DeleteHashEntry(entry_ptr); return; } } }else if ((curve_instance->z_error = PowFindVector(z_error)) != NULL) { /*we've got an z_error but no z_vector */ *status = TCL_ERROR; fprintf(stderr, "Can't have a Z error without a Z vector\n"); Tcl_DeleteHashEntry(entry_ptr); return; } /* do final sanity checking */ if(length == 0) { *status = TCL_ERROR; fprintf(stderr, "Invalid curve, no non-zero vectors.\n"); Tcl_DeleteHashEntry(entry_ptr); return; } else { curve_instance->length = length; } /* if a vector not named "NULL" comes back NULL, it probably doesn't exist */ /* error out */ if ( x_vector != NULL && (strstr(x_vector,"NULL") == NULL ) && (curve_instance->x_vector == NULL)) { *status = TCL_ERROR; fprintf(stderr, "Vector %s doesn't exist.\n",x_vector); Tcl_DeleteHashEntry(entry_ptr); return; } if ( x_error != NULL && (strstr(x_error,"NULL") == NULL ) && (curve_instance->x_error == NULL)) { *status = TCL_ERROR; fprintf(stderr, "Vector %s doesn't exist.\n",x_error); Tcl_DeleteHashEntry(entry_ptr); return; } if ( y_vector != NULL && (strstr(y_vector,"NULL") == NULL) && (curve_instance->y_vector == NULL)) { *status = TCL_ERROR; fprintf(stderr, "Vector %s doesn't exist.\n",y_vector); Tcl_DeleteHashEntry(entry_ptr); return; } if ( y_error != NULL && (strstr(y_error,"NULL") == NULL ) && (curve_instance->y_error == NULL)) { *status = TCL_ERROR; fprintf(stderr, "Vector %s doesn't exist.\n",y_error); Tcl_DeleteHashEntry(entry_ptr); return; } if ( z_vector != NULL && (strstr(z_vector,"NULL") == NULL ) && (curve_instance->z_vector == NULL)) { *status = TCL_ERROR; fprintf(stderr, "Vector %s doesn't exist.\n",z_vector); Tcl_DeleteHashEntry(entry_ptr); return; } if ( z_error != NULL && (strstr(z_error,"NULL") == NULL ) && (curve_instance->z_error == NULL)) { *status = TCL_ERROR; fprintf(stderr, "Vector %s doesn't exist.\n",z_error); Tcl_DeleteHashEntry(entry_ptr); return; } /* Call WCS init procedure if applicable */ wcsStatus = TCL_ERROR; WCSstring = Tcl_GetVar2(interp,powWCS,curve_name,TCL_GLOBAL_ONLY); if( (WCSstring != NULL) && strcmp(WCSstring,"") ) { wcsStatus = Tcl_VarEval(interp, "powWCSInitCurve ", curve_name, " ", WCSstring, (char *) NULL); } if ( wcsStatus == TCL_ERROR ) { /* Set WCS structure to defaults... The Identity transform */ PowInitWCS( &curve_instance->WCS, 2 ); } } void PowCreateHisto(char *histo_name, char *x_vector, char *y_vector, int *status) { /*create 2 new vectors (named "histo_name"_histo_x and "histo_name"_histo_y) if x_vector is NULL or "NULL" create the x vector with integral numbered bins. Then use these vectors to create a curve "histo_name" */ PowVector *X,*Y; int i; double *dummy_X,*dummy_Y,*counter; double a,b,halfwidth; char *xname,*yname; int dtype = DOUBLE_DATA,copy = 0, offset = 0; int newflag; int histo_length; xname = ckalloc(strlen(x_vector) + 9); strcpy(xname,histo_name); strcat(xname,"_histo_x"); if ((Y = PowFindVector(y_vector)) == NULL) { fprintf(stderr,"You must specify an existing Y vector."); *status = TCL_ERROR; return; } yname = ckalloc(strlen(x_vector) + 9); strcpy(yname,histo_name); strcat(yname,"_histo_y"); /* create Y histo data */ dummy_Y = (double *)ckalloc((Y->length * 2 + 2) * sizeof(double)); counter = dummy_Y; *counter++ = 0; for (i=0; i < Y->length; i++) { a = PowExtractDatum(Y->dataptr,i); *counter++ = a; *counter++ = a; } *counter++ = 0; if ((X = PowFindVector(x_vector)) == NULL) { newflag = 1; } else { newflag = 0; if (X->length < Y->length) { fprintf(stderr,"X vector too short."); *status = TCL_ERROR; return; } } /* create X histo data */ dummy_X = (double *)ckalloc((Y->length * 2 + 2) * sizeof(double)); counter = dummy_X; if (newflag) { *counter++ = 0.5; for (i=1; i <= Y->length; i++) { *counter++ = i - 0.5; *counter++ = i + 0.5; } *counter++ = i + 0.5; } else { a = PowExtractDatum(X->dataptr,0); b = PowExtractDatum(X->dataptr,1); halfwidth = (b - a)/2.0; *counter++ = a - halfwidth; *counter++ = a - halfwidth; *counter++ = a + halfwidth; for (i=1; i < Y->length; i++) { b = PowExtractDatum(X->dataptr,i); halfwidth = (b - a)/2.0; *counter++ = b - halfwidth; *counter++ = b + halfwidth; a = b; } *counter++ = b + halfwidth; } histo_length = Y->length * 2 + 2; PowCreateData( xname, dummy_X, &dtype, &histo_length, ©, status); PowCreateVector( xname, xname, &offset, &histo_length, "NULL", status); PowCreateData( yname, dummy_Y, &dtype, &histo_length, ©, status); PowCreateVector( yname, yname, &offset, &histo_length, "NULL", status); PowCreateCurve( histo_name, xname, NULL, yname, NULL, NULL, NULL, status); return; } void PowDestroyCurve(char *curve_name, int *status) { Tcl_HashEntry *entry_ptr; char errormsg[1024]; PowCurve *curve_ptr; entry_ptr = Tcl_FindHashEntry(&PowCurveTable,curve_name); if (entry_ptr == NULL) { *status = TCL_ERROR; sprintf(errormsg,"Can't find POWCurve Object %s to destroy",curve_name); Tcl_SetResult(interp,errormsg,TCL_VOLATILE); return; } curve_ptr = (struct PowCurve *)Tcl_GetHashValue(entry_ptr); /*Delete the entry from the master POWData Hash*/ Tcl_DeleteHashEntry(entry_ptr); /*free the PowCurve memory itself and the string holding the name, although this is small change*/ ckfree(curve_ptr->curve_name); ckfree((char*)curve_ptr); return; } void PowCreateCurveFlip (char *graphName, char *direction, int *status) { PowCurve *current_curve; PowVector *Xvec, *Yvec; double xdatum, ydatum; int i, j; char curveName[1024]; sprintf(curveName, "c1_%s", graphName); status = 0; current_curve = PowFindCurve(curveName); Xvec = current_curve->x_vector; Yvec = current_curve->y_vector; for (i = Xvec->offset, j = Yvec->offset ; i < Xvec->offset + current_curve->length ; i++, j++) { xdatum = PowExtractDatum(Xvec->dataptr,i); ydatum = PowExtractDatum(Yvec->dataptr,j); if (strcmp(direction, "X")) { /* PowPutDatum(Xvec->dataptr, (double)i, i); */ } else if (strcmp(direction, "Y")) { /* PowPutDatum(Yvec->dataptr, (double)j, j); */ } } } fv5.5/tcltk/pow/PowCreateData.c0000644000220700000360000001675313224715127015312 0ustar birbylhea#include "pow.h" /* Initializes a PowData structure and adds it to powTable */ void PowCreateData(char *data_name, void *data_array, int *data_type, int *length, int *copy, int *status) { PowData *array_instance; Tcl_HashEntry *entry_ptr; char *str_ptr; char *orig_ptr,*cpy_ptr; int new = 0; int i; entry_ptr = Tcl_CreateHashEntry(&PowDataTable, data_name, &new); #ifdef DEBUG if (!new) { printf("Reusing data name: %s\n",data_name); } #endif array_instance = (PowData *) ckalloc(sizeof(PowData)); if(array_instance == NULL) { *status = TCL_ERROR; fprintf(stderr, "Couldn't ckalloc array structure space"); Tcl_DeleteHashEntry(entry_ptr); return; } Tcl_SetHashValue( entry_ptr, array_instance); str_ptr = ckalloc(strlen(data_name)+1); strncpy(str_ptr,data_name,strlen(data_name)+1); array_instance->data_name = str_ptr; array_instance->data_array = data_array; array_instance->copy = *copy; array_instance->data_type = *data_type; array_instance->length = *length; if (array_instance->data_type >= 8 || array_instance->data_type <= -8) { switch (array_instance->data_type) { case 8: array_instance->data_type = 0; break; case 16: array_instance->data_type = 1; break; case 32: array_instance->data_type = 2; break; case -32: array_instance->data_type = 3; break; case -64: array_instance->data_type = 4; break; case 64: array_instance->data_type = 5; break; default: *status = TCL_ERROR; fprintf(stderr, "Unknown data type\n"); Tcl_DeleteHashEntry(entry_ptr); return; } } if( *copy > 0 ) { /* copy data: If *copy<0, don't copy but free pointer in DestroyData */ orig_ptr = (char *) data_array; array_instance->data_array = (void *) ckalloc(*length * pixelSizes[*data_type]); if(array_instance->data_array == NULL) { *status = TCL_ERROR; fprintf(stderr, "Couldn't allocate space for copy of data."); Tcl_DeleteHashEntry(entry_ptr); return; } cpy_ptr = (char *) array_instance->data_array; for (i=0; i < *length * pixelSizes[*data_type]; i++) { *(cpy_ptr++) = *(orig_ptr++); } } } /* Initializes a PowData structure and adds it to powTable */ void PowCreateDataFlip(char *data_name, char *direction, int *height, int *width, int *status) { PowData *array_instance; char *start_ptr; char *orig_ptr, *cpy_ptr; int data_type = 0; int i, j, k; int cIdx, whichset; long value, maxValue, minValue; void *tmp_array; array_instance = PowFindData(data_name); if (array_instance == (PowData *) NULL) { *status = TCL_ERROR; fprintf(stderr, "Couldn't locate data_name, %s.", data_name); return; } data_type = array_instance->data_type; orig_ptr = (char *) array_instance->data_array; tmp_array = (void *) ckalloc(array_instance->length * pixelSizes[array_instance->data_type]); if (tmp_array == NULL) { *status = TCL_ERROR; fprintf(stderr, "Couldn't allocate space for copy of data."); return; } cpy_ptr = (char *) tmp_array; switch (*direction) { case 'X': cIdx = 0; for (i=0; i < *height; i++) { whichset = i; maxValue = whichset * (*width) + (*width) - 1; minValue = whichset * (*width); for (j = 0; j < *width; j++) { value = maxValue; maxValue--; start_ptr = orig_ptr + value * pixelSizes[array_instance->data_type]; for (k = 0; k < pixelSizes[array_instance->data_type]; k++) { *(cpy_ptr++) = *(start_ptr++); } cIdx++; } } break; case 'Y': cIdx = 0; whichset = *height; for (i=0; i < *height; i++) { maxValue = whichset * (*width) - 1; minValue = whichset * (*width) - (*width); for (j=0; j < *width; j++) { value = minValue; minValue++; start_ptr = orig_ptr + value * pixelSizes[array_instance->data_type]; for (k = 0; k < pixelSizes[array_instance->data_type]; k++) { *(cpy_ptr++) = *(start_ptr++); } cIdx++; } whichset--; } break; default: break; } start_ptr = (char *) array_instance->data_array; cpy_ptr = (char *) tmp_array; /* copy the result data back to array */ for (k = 0; k < array_instance->length * pixelSizes[array_instance->data_type]; k++) { *(start_ptr++) = *(cpy_ptr++); } ckfree(tmp_array); } void PowCreateVectorDataFlip(char *data_name, int *length, int *status) { PowData *array_instance; char *start_ptr; char *orig_ptr, *cpy_ptr, *pixel_ptr; int data_type = 0; int i, k; void *tmp_array, *pixel_array; array_instance = PowFindData(data_name); if (array_instance == (PowData *) NULL) { *status = TCL_ERROR; fprintf(stderr, "Couldn't locate data_name, %s.", data_name); return; } data_type = array_instance->data_type; orig_ptr = (char *) array_instance->data_array; tmp_array = (void *) ckalloc(array_instance->length * pixelSizes[array_instance->data_type]); if (tmp_array == NULL) { *status = TCL_ERROR; fprintf(stderr, "Couldn't allocate space for copy of data."); return; } cpy_ptr = (char *) tmp_array; for (i=(array_instance->length) - 1; i >= 0; i--) { pixel_array = (char *) ckalloc(pixelSizes[array_instance->data_type] + 1); pixel_ptr = (char *) pixel_array; start_ptr = orig_ptr + i * pixelSizes[array_instance->data_type]; for (k = 0; k < pixelSizes[array_instance->data_type]; k++) { *(cpy_ptr++) = *(start_ptr); *(pixel_ptr++) = *(start_ptr++); } ckfree(pixel_array); } start_ptr = (char *) array_instance->data_array; cpy_ptr = (char *) tmp_array; /* copy the result data back to array */ for (k = 0; k < array_instance->length * pixelSizes[array_instance->data_type]; k++) { *(start_ptr++) = *(cpy_ptr++); } ckfree(tmp_array); } void PowDestroyData(char *data_name, int *status) { Tcl_HashEntry *entry_ptr; char errormsg[1024]; PowData *data_ptr; entry_ptr = Tcl_FindHashEntry(&PowDataTable,data_name); if (entry_ptr == NULL) { *status = TCL_ERROR; sprintf(errormsg,"Can't find POWData Object %s to destroy",data_name); Tcl_SetResult(interp,errormsg,TCL_VOLATILE); return; } data_ptr = (PowData *)Tcl_GetHashValue(entry_ptr); /*free the data if it's ours*/ if (data_ptr->copy != 0) { ckfree(data_ptr->data_array); } /*Delete the entry from the master POWData Hash*/ Tcl_DeleteHashEntry(entry_ptr); /*free the PowData memory itself and the string holding the name, although this is small change*/ ckfree( (char*)data_ptr->data_name); ckfree( (char*)data_ptr); } void PowRegisterData(PowData *dataptr,int *status) { int new = 0; Tcl_HashEntry *entry_ptr; entry_ptr = Tcl_CreateHashEntry(&PowDataTable, dataptr->data_name, &new); #ifdef DEBUG if (!new) { printf("Reusing data name: %s\n",data_name); } #endif Tcl_SetHashValue( entry_ptr, dataptr); return; } fv5.5/tcltk/pow/PowCreateGraph.c0000644000220700000360000002375213224715127015477 0ustar birbylhea#include "pow.h" void PowCreateGraph(char *graph_name, char *curves, char *images, char *xunits, char *yunits, char *xlabel, char *ylabel, int *xdimdisp, int *ydimdisp, double *xmin_in, double *ymin_in, double *xmax_in, double *ymax_in, int *status) { char whichPowCanvas[9]=".pow.pow"; PowCreateGraph_internal(graph_name, curves, images, xunits, yunits, xlabel, ylabel, xdimdisp, ydimdisp, xmin_in, ymin_in, xmax_in, ymax_in, whichPowCanvas, status) ; } void PowCreateGraph_internal(char *graph_name, char *curves, char *images, char *xunits, char *yunits, char *xlabel, char *ylabel, int *xdimdisp, int *ydimdisp, double *xmin_in, double *ymin_in, double *xmax_in, double *ymax_in, char *whichPowCanvas, int *status) { /* xdimdisp and ydimdisp are the *displayed* size of the new graph it will be zoomed or shrunk by an integral or 1/integral factor to come as close as possible to filling this requested space. If xdimdisp and ydimdisp are both 0, the graph will appear at Magstep 1 */ PowGraph *graph_instance; Tcl_HashEntry *entry_ptr; int new = 0; double xmin,xmax,ymin,ymax,xdim,ydim,tmp; int xmargin,ymargin; double xoff, yoff; char bbox[128]; char extraparams[256], *pPtr; char *str_ptr; char *aspect="no"; int in_limits; int x_points_right,y_points_up; int len; int zoomed; char *idxStr; const char *graphType; int xCount, yCount; const char *WCSvalue; char errormsg[512]; in_limits = 1; entry_ptr = Tcl_CreateHashEntry(&PowGraphTable, graph_name, &new); if ( new ) { graph_instance = (PowGraph *) ckalloc(sizeof(PowGraph)); if(graph_instance == NULL) { *status = TCL_ERROR; Tcl_SetResult( interp, "Couldn't ckalloc graph structure space", TCL_VOLATILE ); Tcl_DeleteHashEntry(entry_ptr); return; } Tcl_SetHashValue( entry_ptr, graph_instance); /* Copy graph_name into graph's structure */ str_ptr = ckalloc(strlen(graph_name)+1); strcpy(str_ptr,graph_name); graph_instance->graph_name = str_ptr; } else { #ifdef DEBUG printf("Reusing graph name: %s\n",graph_name); #endif graph_instance = (PowGraph *) Tcl_GetHashValue( entry_ptr ); /* Free up old string pointers */ ckfree(graph_instance->xunits); ckfree(graph_instance->yunits); ckfree(graph_instance->xlabel); ckfree(graph_instance->ylabel); } if (xmin_in != NULL && xmax_in != NULL && *xmin_in > *xmax_in) { x_points_right = 0; } else { x_points_right = 1; } if (ymin_in != NULL && ymax_in != NULL && *ymin_in > *ymax_in) { y_points_up = 0; } else { y_points_up = 1; } graph_instance->WCS.haveWCSinfo = 0; PowWCSInitGraph( graph_instance, curves, images, x_points_right, y_points_up); /* FillinWCSStructure ( &graph_instance->WCS ); image_instance = PowFindImage(images); FillinWCSStructure ( &image_instance->WCS ); */ /* Do we need to keep a fixed Aspect ratio? */ if( graph_instance->WCS.type[0] || ( images != NULL && strstr(images,"NULL") == NULL ) ) aspect = "yes"; /* * If any of the min/max values are not specified, search * the graph's contents for its bounding box. */ if( xmin_in==NULL || xmax_in==NULL || ymin_in==NULL || ymax_in==NULL ) { if( PowFindGraphBBox( graph_instance, images, curves, &xmin, &xmax, &ymin, &ymax ) != TCL_OK ) { *status = TCL_ERROR; Tcl_AppendResult( interp, "\nError locating curves' bounding boxes", NULL ); ckfree( (char *)graph_instance->graph_name ); ckfree( (char *)graph_instance ); Tcl_DeleteHashEntry(entry_ptr); return; } } /* Now apply supplied bounding box values */ if (xmin_in != NULL) xmin = *xmin_in; if (xmax_in != NULL) xmax = *xmax_in; if (ymin_in != NULL) ymin = *ymin_in; if (ymax_in != NULL) ymax = *ymax_in; if (xmin == xmax) { if(xmin == 0) { xmax = 1; } else { xmin *= 0.9; xmax *= 1.1; } } if (ymin == ymax) { if (ymin == 0) { ymax = 1; } else { ymin *= 0.9; ymax *= 1.1; } } len = strlen(graph_name)+15; idxStr = (char *) ckalloc( len*sizeof(char) ); sprintf(idxStr, "%s,%s", "graphType", graph_name); graphType = Tcl_GetVar2(interp,"powPlotParam",idxStr,TCL_GLOBAL_ONLY); ckfree(idxStr); len = strlen(graph_name)+15; idxStr = (char *) ckalloc( len*sizeof(char) ); sprintf(idxStr, "%s,%s", "zoomed", graph_name); zoomed = atoi(Tcl_GetVar2(interp,"powPlotParam",idxStr,TCL_GLOBAL_ONLY)); ckfree(idxStr); xCount = atoi(Tcl_GetVar2(interp,"xCount",graph_name,TCL_GLOBAL_ONLY)); yCount = atoi(Tcl_GetVar2(interp,"yCount",graph_name,TCL_GLOBAL_ONLY)); if ( graph_instance->WCS.type[0] == '\0' && strcmp(graphType, "binary") == 0 && xCount % 2 != 0 ) { graph_instance->WCS.cdFrwd[0][0] = 1.0; } if ( graph_instance->WCS.type[0] == '\0' && strcmp(graphType, "binary") == 0 && yCount % 2 != 0 ) { graph_instance->WCS.cdFrwd[1][1] = 1.0; } if( PowSortGraphMinMax(graph_instance,&xmin,&xmax,&ymin,&ymax,&xdim,&ydim) ) { /* Bounding box is invalid. Force default bounding box. */ PowFindGraphBBox( graph_instance, images, curves, &xmin, &xmax, &ymin, &ymax ); PowSortGraphMinMax(graph_instance,&xmin,&xmax,&ymin,&ymax,&xdim,&ydim); } WCSvalue = Tcl_GetVar(interp,"powWCSTranslation",TCL_GLOBAL_ONLY); if (WCSvalue[0] != '0') { sprintf(errormsg, "\nError translating WCS information. error:<%s>.", WCSvalue); *status = TCL_ERROR; Tcl_AppendResult( interp, errormsg, NULL ); Tcl_DeleteHashEntry(entry_ptr); return; } /* Chai 06/29/2007: We are not actually fliping the coordinates on the canvas. If tk allows this, then there is no need to do the following. What the logic below is to trick pow to think that the point on the canvas has been flipped. The xCount and yCount indicate if the graph has been flipped before. So if X has been previously flipped, the next flipping occurs on Y, the logic inside ..Count % 2 will make sure the information on previous flip still maintained. */ if ( graph_instance->WCS.type[0] == '\0' && strcmp(graphType, "binary") == 0 && xCount % 2 != 0 ) { /* previous flip */ tmp = xmin; xmin = xmax; xmax = tmp; } if ( graph_instance->WCS.type[0] == '\0' && strcmp(graphType, "binary") == 0 && yCount % 2 != 0 ) { /* previous flip */ tmp = ymin; ymin = ymax; ymax = tmp; } graph_instance->xleft = xmin; graph_instance->xright = xmax; graph_instance->ybot = ymin; graph_instance->ytop = ymax; PowPosToPix( xmin, ymin, &graph_instance->WCS, &xoff, &yoff ); graph_instance->WCS.refPix[0] -= xoff; graph_instance->WCS.refPix[1] -= yoff; graph_instance->xoff -= xoff; graph_instance->yoff -= yoff; str_ptr = ckalloc(strlen(xunits)+1); strncpy(str_ptr,xunits,strlen(xunits)+1); graph_instance->xunits = str_ptr; str_ptr = ckalloc(strlen(yunits)+1); strncpy(str_ptr,yunits,strlen(yunits)+1); graph_instance->yunits = str_ptr; str_ptr = ckalloc(strlen(xlabel)+1); strncpy(str_ptr,xlabel,strlen(xlabel)+1); graph_instance->xlabel = str_ptr; str_ptr = ckalloc(strlen(ylabel)+1); strncpy(str_ptr,ylabel,strlen(ylabel)+1); graph_instance->ylabel = str_ptr; sprintf(bbox," %#.17g %#.17g %#.17g %#.17g", graph_instance->xleft, graph_instance->xright, graph_instance->ybot, graph_instance->ytop); if( xdimdisp && *xdimdisp<=0 ) *xdimdisp = (int)xdim; if( ydimdisp && *ydimdisp<=0 ) *ydimdisp = (int)ydim; xmargin = 80; ymargin = 60; sprintf(extraparams," %#.17g %#.17g ", xdim, ydim ); /* Handle possible NULL value of dimdisp's */ pPtr = extraparams + strlen(extraparams); if( xdimdisp ) sprintf(pPtr, "%d ", *xdimdisp); else sprintf(pPtr, "NULL "); pPtr += strlen( pPtr ); if( ydimdisp ) sprintf(pPtr, "%d ", *ydimdisp); else sprintf(pPtr, "NULL "); pPtr += strlen( pPtr ); sprintf(pPtr, "%s %d %d ",aspect, xmargin, ymargin); if ( Tcl_VarEval(interp, "powInitGraph ", graph_name, bbox," {", xunits,"} {", yunits,"} {",xlabel,"} {",ylabel,"} ", whichPowCanvas, extraparams, (char *) NULL) == TCL_ERROR) { *status = TCL_ERROR; Tcl_AppendResult( interp, "\nError initializing graph.", NULL ); Tcl_DeleteHashEntry(entry_ptr); return; }; if( images==NULL ) images="NULL"; if( curves==NULL ) curves="NULL"; if ( Tcl_VarEval(interp, "powBuildGraph ", graph_name, " [list ", images," ] ", " [list ", curves," ] ", whichPowCanvas, (char *) NULL) == TCL_ERROR) { *status = TCL_ERROR; Tcl_AppendResult( interp, "\nError building graph.", NULL ); Tcl_DeleteHashEntry(entry_ptr); return; } if ( !strcmp( whichPowCanvas, ".pow.pow" ) ) { if ( Tcl_VarEval(interp, "powSelectGraph ", graph_name, (char *) NULL) == TCL_ERROR) { *status = TCL_ERROR; Tcl_AppendResult( interp, "\nError selecting graph.", NULL ); Tcl_DeleteHashEntry(entry_ptr); return; } } } void PowDestroyGraph(char *graph_name, int *status) { Tcl_HashEntry *entry_ptr; char errormsg[1024]; PowGraph *graph_ptr; entry_ptr = Tcl_FindHashEntry(&PowGraphTable,graph_name); if (entry_ptr == NULL) { *status = TCL_ERROR; sprintf(errormsg,"Can't find POWGraph Object %s to destroy",graph_name); Tcl_SetResult(interp,errormsg,TCL_VOLATILE); return; } Tcl_VarEval(interp,"powUnmapGraph ",graph_name,(char *)NULL); Tcl_VarEval(interp,"powFreeGraph ", graph_name,(char *)NULL); graph_ptr = (PowGraph *)Tcl_GetHashValue(entry_ptr); /*Delete the entry from the master POWData Hash*/ Tcl_DeleteHashEntry(entry_ptr); /*free the PowGraph memory itself and the string holding the name and labels, although this is small change*/ ckfree(graph_ptr->graph_name); ckfree(graph_ptr->xunits); ckfree(graph_ptr->yunits); ckfree(graph_ptr->xlabel); ckfree(graph_ptr->ylabel); ckfree((char*)graph_ptr); return; } fv5.5/tcltk/pow/PowCreateImage.c0000644000220700000360000002126113224715127015451 0ustar birbylhea#include "pow.h" void PowCreateImage(char *image_name, char *data_name, int *xoffset, int *yoffset, int *width, int *height, double *xorigin, double *xinc, double *yorigin, double *yinc, char *xunits, char *yunits, char *zunits, int *status) { /* xinc or yinc == 0 will mean count by integers */ PowImage *image_instance; PowData *dataptr; #if !(defined(__WIN32__) || defined(macintosh)) Tk_PictHandle pict_image_handle; Tk_PictImageBlock pict_block; PictMaster *masterPtr; #endif Tk_PhotoHandle photo_image_handle; Tk_PhotoImageBlock photo_block; Tcl_HashEntry *entry_ptr; int new = 0; char *str_ptr; int pseudoImages; double min,max; char smin[30]; char smax[30]; double datum; int i, wcsStatus; const char *WCSstring; char powWCS[7]="powWCS"; Tcl_GetInt(interp,Tcl_GetVar(interp,"powPseudoImages",TCL_GLOBAL_ONLY), &pseudoImages); entry_ptr = Tcl_CreateHashEntry(&PowImageTable, image_name, &new); if (!new) { /* fprintf(stdout, "Reusing image name: %s\n", image_name); */ #ifdef DEBUG printf("Reusing image name: %s",image_name); #endif #if !(defined(__WIN32__) || defined(macintosh)) /* zero out the data ptr field so VISU won't throw away our data */ /* when you reuse an image name, VISU calls ImgPictDelete on it */ /* this frees the data pointer. We don't want that.... */ if( pseudoImages ) { masterPtr = (PictMaster *)Tk_FindPict(image_name); if ( (unsigned char*)masterPtr->data == masterPtr->bytedata) { masterPtr->bytedata = NULL; } masterPtr->data = NULL; } #endif } image_instance = (PowImage *) ckalloc(sizeof(PowImage)); if(image_instance == NULL) { *status = TCL_ERROR; fprintf(stderr, "Couldn't malloc image structure space"); Tcl_DeleteHashEntry(entry_ptr); return; } Tcl_SetHashValue( entry_ptr, image_instance); str_ptr = ckalloc(strlen(image_name)+1); strncpy(str_ptr,image_name,strlen(image_name)+1); image_instance->image_name = str_ptr; image_instance->xoffset = *xoffset; image_instance->yoffset = *yoffset; image_instance->width = *width; image_instance->height = *height; image_instance->xorigin = *xorigin; image_instance->xinc = *xinc; image_instance->yorigin = *yorigin; image_instance->yinc = *yinc; str_ptr = ckalloc(strlen(xunits)+1); strncpy(str_ptr,xunits,strlen(xunits)+1); image_instance->xunits = str_ptr; str_ptr = ckalloc(strlen(yunits)+1); strncpy(str_ptr,yunits,strlen(yunits)+1); image_instance->yunits = str_ptr; str_ptr = ckalloc(strlen(zunits)+1); strncpy(str_ptr,zunits,strlen(zunits)+1); image_instance->zunits = str_ptr; /* Now set up the image */ if (pseudoImages != 0) { #if !(defined(__WIN32__) || defined(macintosh)) /* use Pict widget (Visu) */ if (Tcl_VarEval(interp,"image create pict ",image_instance->image_name,(char *) NULL) == TCL_ERROR) { *status = TCL_ERROR; fprintf(stderr, "%s\n", Tcl_GetStringResult(interp)); Tcl_DeleteHashEntry(entry_ptr); return; } pict_image_handle = Tk_FindPict(image_instance->image_name); if(pict_image_handle == NULL) { *status = TCL_ERROR; fprintf(stderr, "%s\n", Tcl_GetStringResult(interp)); Tcl_DeleteHashEntry(entry_ptr); return; } image_instance->image_handle = (void *) pict_image_handle; #else fprintf(stderr,"You should not see this. Pict images disabled in Win32.\n"); return; #endif /*__WIN32__ || macintosh*/ } else { /* use Photo widget */ if (Tcl_VarEval(interp,"image create photo ",image_instance->image_name,(char *) NULL) == TCL_ERROR) { *status = TCL_ERROR; fprintf(stderr, "%s\n", Tcl_GetStringResult(interp)); Tcl_DeleteHashEntry(entry_ptr); return; } photo_image_handle = Tk_FindPhoto(interp,image_instance->image_name); if(photo_image_handle == NULL) { *status = TCL_ERROR; fprintf(stderr, "%s\n", Tcl_GetStringResult(interp)); Tcl_DeleteHashEntry(entry_ptr); return; } image_instance->image_handle = (void *) photo_image_handle; } /* Get the data address out of the hash table */ entry_ptr = Tcl_FindHashEntry (&PowDataTable, data_name); if(entry_ptr == NULL) { *status = TCL_ERROR; fprintf(stderr, "%s\n", Tcl_GetStringResult(interp)); Tcl_DeleteHashEntry(entry_ptr); return; } dataptr = (PowData *) Tcl_GetHashValue(entry_ptr); /*Setup displayed min and max stuff */ min = DBL_MAX; max = -DBL_MAX; for (i = 0; i < image_instance->width * image_instance->height; i++) { datum = PowExtractDatum(dataptr,i); if (datum != DBL_MAX) { min = (datum < min) ? datum : min; max = (datum > max) ? datum : max; } } if( max==-DBL_MAX ) min=max=0.0; sprintf(smin,"%.17lg",min); sprintf(smax,"%.17lg",max); Tcl_SetVar2(interp,"powRBmin",image_name,smin,TCL_GLOBAL_ONLY); Tcl_SetVar2(interp,"powRBmax",image_name,smax,TCL_GLOBAL_ONLY); image_instance->dataptr = dataptr; /* notice that the "offsets" are not implemented here yet*/ /* this will require some serious tweaking to pixelPtr and skip fields */ if (pseudoImages != 0) { #if !(defined(__WIN32__) || defined(macintosh)) /*Pict*/ pict_block.datatype = dataptr->data_type; pict_block.pixelPtr = (unsigned char *) dataptr->data_array; pict_block.width = image_instance->width; pict_block.height = image_instance->height; pict_block.pixelSize = pixelSizes[dataptr->data_type]; pict_block.pitch = pict_block.pixelSize; pict_block.skip = 0; pict_block.copy = NO_COPY; Tk_PictExpand(pict_image_handle,image_instance->width,image_instance->height); Tk_PictPutBlock(pict_image_handle,&pict_block,0,0,image_instance->width,image_instance->height); #else fprintf(stderr,"You should not see this\n"); return; #endif /*__WIN32__ || macintosh*/ } else { PowDitherToPhoto(image_instance,&photo_block,min,max); photo_block.pixelSize = 3; photo_block.width = image_instance->width; photo_block.height = image_instance->height; photo_block.pitch = image_instance->width * 3; photo_block.offset[0] = 0; photo_block.offset[1] = 1; photo_block.offset[2] = 2; Tk_PhotoExpand(interp, photo_image_handle, image_instance->width, image_instance->height); Tk_PhotoPutBlock(interp, photo_image_handle, &photo_block, 0, 0, image_instance->width, image_instance->height, TK_PHOTO_COMPOSITE_SET); ckfree(photo_block.pixelPtr); } /* Call WCS init procedure if applicable */ wcsStatus = TCL_ERROR; WCSstring = Tcl_GetVar2(interp,powWCS,image_name,TCL_GLOBAL_ONLY); if( (WCSstring != NULL) && strcmp(WCSstring,"") ) { wcsStatus = Tcl_VarEval(interp, "powWCSInitImage ", image_name, " ", WCSstring, (char *) NULL); } if( wcsStatus == TCL_ERROR ) { image_instance->xorigin -= 0.5*image_instance->xinc; image_instance->yorigin -= 0.5*image_instance->yinc; image_instance->xotherend = image_instance->xorigin + image_instance->width*image_instance->xinc; image_instance->yotherend = image_instance->yorigin + image_instance->height*image_instance->yinc; memset(image_instance->WCS.type, '\0', 6); image_instance->WCS.nAxis = 2; image_instance->WCS.refVal[0] = image_instance->xorigin; image_instance->WCS.refVal[1] = image_instance->yorigin; image_instance->WCS.refPix[0] = -0.5; image_instance->WCS.refPix[1] = -0.5; image_instance->WCS.cdFrwd[0][0] = image_instance->xinc; image_instance->WCS.cdFrwd[1][1] = image_instance->yinc; image_instance->WCS.cdFrwd[0][1] = 0.0; image_instance->WCS.cdFrwd[1][0] = 0.0; image_instance->WCS.cdRvrs[0][0] = 1.0/image_instance->xinc; image_instance->WCS.cdRvrs[1][1] = 1.0/image_instance->yinc; image_instance->WCS.cdRvrs[0][1] = 0.0; image_instance->WCS.cdRvrs[1][0] = 0.0; } return; } void PowDestroyImage(char *image_name, int *status) { Tcl_HashEntry *entry_ptr; char errormsg[1024]; PowImage *image_ptr; entry_ptr = Tcl_FindHashEntry(&PowImageTable,image_name); if (entry_ptr == NULL) { *status = TCL_ERROR; sprintf(errormsg,"Can't find POWImage Object %s to destroy",image_name); Tcl_SetResult(interp,errormsg,TCL_VOLATILE); return; } image_ptr = (PowImage *)Tcl_GetHashValue(entry_ptr); /*Delete the entry from the master POWData Hash*/ Tcl_DeleteHashEntry(entry_ptr); /*free the PowImage memory itself and the string holding the name, although this is small change*/ ckfree(image_ptr->image_name); ckfree(image_ptr->xunits); ckfree(image_ptr->yunits); ckfree(image_ptr->zunits); ckfree((char*)image_ptr); return; } fv5.5/tcltk/pow/PowCreateVector.c0000644000220700000360000000570213224715127015673 0ustar birbylhea#include "pow.h" void PowCreateVector(char *vector_name, char *data_name, int *offset, int *length, char *units, int *status) { PowVector *vector_instance; PowData *dataptr; Tcl_HashEntry *entry_ptr,*data_entry_ptr; int new = 0; char *str_ptr; entry_ptr = Tcl_CreateHashEntry(&PowVectorTable, vector_name, &new); #ifdef DEBUG if (!new) { printf("Reusing vector name: %s\n",vector_name); } #endif vector_instance = (PowVector *) ckalloc(sizeof(PowVector)); if(vector_instance == NULL) { *status = TCL_ERROR; fprintf(stderr, "Couldn't malloc vector structure space"); Tcl_DeleteHashEntry(entry_ptr); return; } Tcl_SetHashValue( entry_ptr, vector_instance); data_entry_ptr = Tcl_FindHashEntry(&PowDataTable, data_name); if(data_entry_ptr == NULL) { *status = TCL_ERROR; fprintf(stderr, "Couldn't find data: %s\n", data_name); Tcl_DeleteHashEntry(entry_ptr); return; } dataptr = (PowData *) Tcl_GetHashValue(data_entry_ptr); str_ptr = ckalloc(strlen(vector_name)+1); strncpy(str_ptr,vector_name,strlen(vector_name)+1); vector_instance->vector_name = str_ptr; vector_instance->dataptr = dataptr; vector_instance->offset = *offset; if (length == NULL) { vector_instance->length = dataptr->length; } else { vector_instance->length = *length; } str_ptr = ckalloc(strlen(units)+1); strncpy(str_ptr,units,strlen(units)+1); vector_instance->units = str_ptr; } void PowCreateVectorEN(char *vector_name, char *data_name, int *length, double *start, double *increment, char *units, int *status) { double *array; int data_type; int offset; int i; PowData *data_instance; array = (double *) ckalloc(*length * sizeof(double)); for (i = 0; i < *length; i++) { array[i] = *start + *increment * (double) i; } data_type = DOUBLE_DATA; i = 0; PowCreateData(data_name, (void *) array, &data_type, length, &i, status); data_instance = PowFindData(data_name); /*Since this data was made by us, we'll mark it as a POW copy so that PowDestroyData will free it.*/ data_instance->copy = 1; offset = 0; PowCreateVector(vector_name, data_name, &offset, length, units, status); return; } void PowDestroyVector(char *vector_name, int *status) { Tcl_HashEntry *entry_ptr; char errormsg[1024]; PowVector *vector_ptr; entry_ptr = Tcl_FindHashEntry(&PowVectorTable,vector_name); if (entry_ptr == NULL) { *status = TCL_ERROR; sprintf(errormsg,"Can't find POWVector Object %s to destroy",vector_name); Tcl_SetResult(interp,errormsg,TCL_VOLATILE); return; } vector_ptr = (PowVector *)Tcl_GetHashValue(entry_ptr); /*Delete the entry from the master POWData Hash*/ Tcl_DeleteHashEntry(entry_ptr); /*free the PowVector memory itself and the string holding the name, although this is small change*/ ckfree(vector_ptr->vector_name); ckfree(vector_ptr->units); ckfree((char *)vector_ptr); return; } fv5.5/tcltk/pow/PowDrvr.c0000644000220700000360000001034113224715127014215 0ustar birbylhea/************************************************************************ * * POW C socket/XPA driver * * Use this code to make an XPA connection to a POW process and * send pow scripting commands. * ***********************************************************************/ #include #include #include #include #include #include int openPowConnection ( void ); void closePowConnection ( void ); int sendSetCmdToPow ( char *cmd, char *buf, int buflen ); int sendGetCmdToPow ( char *cmd, char **rtnBuf, int *bufLen ); int postProcessCall ( int got, char **names, char **messages ); #define NXPA 1 static XPA powConnection = NULL; static char *powAddress = NULL; int openPowConnection() { extern XPA powConnection; char *rtnBuf; int bufLen; if( !powAddress ) { powAddress = getenv( "POW_DISPLAY" ); if( !powAddress || strlen(powAddress)==0 ) { /* POW_DISPLAY not defined, must depend on a name server */ powAddress = "pow"; } } powConnection = XPAOpen( NULL ); if( sendGetCmdToPow( "version", &rtnBuf, &bufLen )<0 ) { system("POWplot &"); sendSetCmdToPow( "scope 0", NULL, 0); sleep(3); if( sendGetCmdToPow( "version", &rtnBuf, &bufLen )<0 ) { sleep(3); if( sendGetCmdToPow( "version", &rtnBuf, &bufLen )<0 ) { return 1; } } } free( rtnBuf ); return 0; } void closePowConnection() { extern XPA powConnection; XPAClose( powConnection ); powConnection = NULL; } int sendGetCmdToPow( char *cmd, char **rtnBuf, int *bufLen) { int got, stat=0; char *bufs[NXPA]; char *names[NXPA]; char *messages[NXPA]; int lens[NXPA]; extern XPA powConnection; extern char *powAddress; /* Flush 'sendSet' command cache */ stat = sendSetCmdToPow( NULL, NULL, -1 ); if( !stat ) { got = XPAGet(powConnection, powAddress, cmd, "", bufs, lens, names, messages, NXPA); if( got==0 ) stat = -1; else stat = postProcessCall(got, names, messages); *rtnBuf = bufs[0]; *bufLen = lens[0]; } return stat; } int sendSetCmdToPow( char *cmd, char *buf, int buflen ) { int got, len, stat=0; char *names[NXPA]; char *messages[NXPA]; extern XPA powConnection; extern char *powAddress; static char *cache = NULL; static int cachePos = 0; static int cacheSize = 0; switch ( buflen ) { case -2: /* Free the cache */ free(cache); cache = NULL; cachePos = cacheSize = 0; break; case -1: /* Flush the cache */ if( cachePos ) { len = cachePos; cachePos = 0; stat = sendSetCmdToPow( "tcl", cache, len ); } break; case 0: /* No data, so just cache command */ len = strlen(cmd); if( cachePos + len + 2 > cacheSize ) { cacheSize += 4096 + len; if( cache ) { cache = (char*) realloc( cache, sizeof(char) * cacheSize ); } else { cache = (char*) malloc( sizeof(char) * cacheSize ); } } cache[cachePos++] = '\n'; strcpy( cache+cachePos, cmd ); cachePos += len; if( cachePos>60000 ) { /* Flush the cache */ stat = sendSetCmdToPow( NULL, NULL, -1 ); } break; default: /* Data being sent */ if( cachePos ) { /* Flush cache first */ stat = sendSetCmdToPow( NULL, NULL, -1 ); } if( !stat ) { got = XPASet(powConnection, powAddress, cmd, "", buf, buflen, names, messages, NXPA); if( got==0 ) stat = -1; else stat = postProcessCall(got, names, messages); } break; } return stat; } int postProcessCall( int got, char **names, char **messages ) { int i, status=0; for(i=0; iWCS.type[0]!='\0'); /***********************************/ /* Get the bounding box of graph */ /***********************************/ sprintf(cmdLine, "%s coords %sbox", canvas, gn ); if( Tcl_Eval(interp,cmdLine)!=TCL_OK ) { Tcl_SetResult(interp,"Couldn't get bounding box", TCL_VOLATILE); return TCL_ERROR; } strncpy(cmdLine,Tcl_GetStringResult(interp),256); Tcl_SplitList(interp,cmdLine,&i,&list); len = strlen(gn)+15; idxStr = (char *) ckalloc( len*sizeof(char) ); sprintf(idxStr, "%s,%s", "graphType", gn); graphType = Tcl_GetVar2(interp,"powPlotParam",idxStr,TCL_GLOBAL_ONLY); ckfree(idxStr); len = strlen(gn)+15; idxStr = (char *) ckalloc( len*sizeof(char) ); sprintf(idxStr, "%s,%s", "zoomed", gn); zoomed = atoi(Tcl_GetVar2(interp,"powPlotParam",idxStr,TCL_GLOBAL_ONLY)); ckfree(idxStr); xCount = atoi(Tcl_GetVar2(interp,"xCount",gn,TCL_GLOBAL_ONLY)); yCount = atoi(Tcl_GetVar2(interp,"yCount",gn,TCL_GLOBAL_ONLY)); Tcl_GetDouble(interp,list[0],&(bbox_ll.x)); Tcl_GetDouble(interp,list[1],&(bbox_ur.y)); Tcl_GetDouble(interp,list[2],&(bbox_ur.x)); Tcl_GetDouble(interp,list[3],&(bbox_ll.y)); /* Chai 06/29/2007: We are not actually fliping the coordinates on the canvas. If tk allows this, then there is no need to do the following. What the logic below is to trick pow to think that the point on the canvas has been flipped. The xCount and yCount indicate if the graph has been flipped before. So if X has been previously flipped, the next flipping occurs on Y, the logic inside ..Count % 2 will make sure the information on previous flip still exists. */ /* Chai 07/19/2007: When reverse axis for a plot with WCS, the CDELT value was changed (i.e. * -1.0) in pow.tcl powFlipImage routine and reset in powResetWcsStructure C code. That is enough to flip the axis so there is no need to recalculate the value. Just call routines in this file the normal way. */ if ( (graph->WCS.type[0] == '\0' && zoomed == 0) && strcmp(graphType, "binary") == 0 && xCount % 2 != 0 ) { /* previous flip */ Tcl_GetDouble(interp,list[0],&(bbox_ur.x)); Tcl_GetDouble(interp,list[2],&(bbox_ll.x)); } if ( (graph->WCS.type[0] == '\0' && zoomed == 0) && strcmp(graphType, "binary") == 0 && yCount % 2 != 0 ) { /* previous flip */ Tcl_GetDouble(interp,list[1],&(bbox_ll.y)); Tcl_GetDouble(interp,list[3],&(bbox_ur.y)); } BotLft.x = bbox_ll.x; BotLft.y = bbox_ll.y; TopLft.x = bbox_ll.x; TopLft.y = bbox_ur.y; TopRgt.x = bbox_ur.x; TopRgt.y = bbox_ur.y; BotRgt.x = bbox_ur.x; BotRgt.y = bbox_ll.y; Tcl_GetDouble(interp,list[0],&(BotLft_real.x)); Tcl_GetDouble(interp,list[3],&(BotLft_real.y)); ckfree((char *) list); resultLen = 1024; result = ckalloc(sizeof(char)*resultLen); result[0] = 0; /*************************************************/ /* Create an array of grid points around graph */ /* and use it to obtain the list of tick marks */ /*************************************************/ nGrid = CreateGridPts(graph,zoomed, graphType,xCount,yCount,BotLft_real, BotLft,TopRgt,&Grid); nTicks = GetTicks(nGrid,Grid,useWCS,tickScal,numTicks,&TickList,&TickAxis); for( i=0; i0 && k=2 ) { char *line,*cmd; int loc=0; line = ckalloc(sizeof(char)*nSegs*60); for( k=0; kWCS.type[0] != '\0' && strcmp(graphType, "binary") == 0 && (xCount % 2 != 0 || yCount % 2 != 0)) { which = 'r'; } */ InitGridPt(Grid[0],BotLft.x,BotLft.y,left,which); InitGridPt(Grid[1],BotLft.x,TopRgt.y,top,which); InitGridPt(Grid[2],TopRgt.x,TopRgt.y,right,which); InitGridPt(Grid[3],TopRgt.x,BotLft.y,bottom,which); InitGridPt(Grid[4],BotLft.x,BotLft.y,none,which); for (i=0;i<4;i++) { GridOrder[i]=i; CalcCoeff(graph, Grid+i,Grid+i+1,NULL,zoomed,graphType,xCount,yCount); } GridOrder[4] = 4; nPts = 5; start = 0; /**************************************************************************/ /* No need to look for extra points around graph if using linear coords */ /**************************************************************************/ if( graph->WCS.type[0] ) { Point midpt,testpt,testPt; GridPt *currGrid,*newlGrid,*newrGrid,*nextGrid; double diff,dist,bnds; for( i=0; iscrnPt.x + nextGrid->scrnPt.x ); midpt.y = 0.5*( currGrid->scrnPt.y + nextGrid->scrnPt.y ); InitGridPt(*newlGrid,midpt.x,midpt.y,currGrid->side,which); /* PowPixToPos( midpt.x, midpt.y, &graph->WCS, &testPt.x, &testPt.y ); PowPosToPix( testPt.x, testPt.y, &graph->WCS, &testpt.x, &testpt.y ); */ testPt = CalcXY( graph, midpt, currGrid, zoomed, graphType, xCount, yCount ); GraphToCanv(graph, zoomed, graphType, xCount, yCount, BotLft,testPt,BotLft_real, &testpt); diff = fabs(midpt.x-testpt.x) + fabs(midpt.y-testpt.y); dist = fabs(currGrid->scrnPt.x-nextGrid->scrnPt.x) + fabs(currGrid->scrnPt.y-nextGrid->scrnPt.y); if( diff>4.0 && dist>4.0 ) { /* Chai: 07/20/2007: These codes will not be used anymore after WCS lib routines are installed. */ /*************************************************/ /* Not too good, must add a new point to array */ /*************************************************/ CalcCoeff(graph, currGrid,newlGrid,NULL,zoomed,graphType,xCount,yCount); CalcCoeff(graph, newlGrid,nextGrid,NULL,zoomed,graphType,xCount,yCount); if( dist<=9.0 && ( fabs(currGrid->coeff[0])>40.0 || fabs(newlGrid->coeff[0])>40.0 ) ) { /***************************************************/ /* Seems the problem is that we are crossing the */ /* 0/360 position of right ascension. Create an */ /* extra point to eliminate discontinuity. */ /***************************************************/ newrGrid = newlGrid+1; if( fabs(currGrid->coeff[0])>40.0 ) { bnds = (currGrid->imgPt.x < newlGrid->imgPt.x) ? 360.0 : 0.0; newlGrid->imgPt = SolveXY( bnds, 'x', newlGrid); GraphToCanv( graph, zoomed, graphType,xCount,yCount,BotLft, newlGrid->imgPt, BotLft_real, &newlGrid->scrnPt ); *newrGrid = *newlGrid; newlGrid->imgPt.x = 360.0 - bnds; } else { bnds = (newlGrid->imgPt.x > nextGrid->imgPt.x) ? 360.0 : 0.0; newlGrid->imgPt = SolveXY( bnds, 'x', currGrid); GraphToCanv( graph, zoomed, graphType,xCount,yCount,BotLft, newlGrid->imgPt, BotLft_real, &newlGrid->scrnPt ); *newrGrid = *newlGrid; newrGrid->imgPt.x = 360.0 - bnds; } CalcCoeff(graph, currGrid,newlGrid,NULL,zoomed,graphType,xCount,yCount); CalcCoeff(graph, newrGrid,nextGrid,NULL,zoomed,graphType,xCount,yCount); newlGrid->side = none; for (j=nPts-1; j>i; j--) GridOrder[j+2]=GridOrder[j]; GridOrder[i+1] = nPts; GridOrder[i+2] = nPts+1; nPts += 2; start = (i+=2); } else { CalcCoeff(graph, currGrid,newlGrid,nextGrid,zoomed,graphType,xCount,yCount); for (j=nPts-1; j>i; j--) GridOrder[j+1]=GridOrder[j]; GridOrder[i+1]=nPts; nPts++; i--; } if( nPts+3>nGrds ) { nGrds += 25; Grid = (GridPt *)ckrealloc( (char *)Grid, nGrds*sizeof(GridPt) ); GridOrder = (int *)ckrealloc( (char *)GridOrder, nGrds*sizeof(int) ); } } else { CalcCoeff(graph, currGrid,newlGrid,nextGrid,zoomed,graphType,xCount,yCount); } } } /*************************************************************************/ /* Copy grid points in order to the return grid array. Use the */ /* 0/360 discontinuity as the start/end of array if it was encountered */ /*************************************************************************/ *rtnGrid = (GridPt *)ckalloc( nPts*sizeof(GridPt) ); for( i=start,j=0; i maxX ) maxX = Grid[i].imgPt.x; if( Grid[i].imgPt.y < minY ) minY = Grid[i].imgPt.y; else if( Grid[i].imgPt.y > maxY ) maxY = Grid[i].imgPt.y; /* Note that the 0-element will never be a discontinuity */ if( useWCS && ( Grid[i].imgPt.x<0.000001 || Grid[i].imgPt.x>359.999999 ) && Grid[i].side==none ) nBreaks++; } if( nBreaks % 2 ) { /* Crossed 0/360 boundary odd times, so must have a pole present */ if( (maxY+minY)>1.0 ) maxY=90.0; else if( (maxY+minY)<-1.0 ) minY=-90.0; nBreaks = 0; } else if( nBreaks ) { /* Crossed 0/360 boundary even times, so must find -180,180 min/max */ double val; minX = maxX = 0.0; for( i=0; i180.0 ) val -= 360.0; if( val < minX ) minX = val; else if( val > maxX ) maxX = val; } } /**************************************************************************/ /* Get the values of the tick marks and copy them to the returned array */ /**************************************************************************/ nx = GetTics( minX, maxX, numTicks[0], 100, tickScal[0], xlist ); ny = GetTics( minY, maxY, numTicks[1], 100, tickScal[1], ylist ); n = nx+ny; *ticks = (double *)ckalloc(sizeof(double)*n); *axis = (char *)ckalloc(sizeof(char)*n); for(i=0;ia2 ) { value = a1; a1 = a2; a2 = value; } adiff = a2 - a1; a1 -= 1e-6 * adiff; a2 += 1e-6 * adiff; /* Identify the scaling method */ if( !strcmp("ra",tickScal) ) { diff = log10( (adiff/15.0)/nlabel ) / log10(60.0); iexp = (int)floor(diff); amant = diff - iexp; if( iexp<-2 ) { /* This is the sub-second level... resort to base 10/3600 steps */ diff = log10( (adiff*3600.0/15.0)/nlabel ); iexp = (int)floor(diff); amant = diff - iexp; if ( amant < .15 ) num = 1; else if( amant < .50 ) num = 2; else if( amant < .85 ) num = 5; else num = 10; step = num * pow(10.0, (double)iexp) * 15.0 / 3600.0; } else if( iexp<0 ) { if ( amant < .10 ) num = 1; else if( amant < .21 ) num = 2; else if( amant < .30 ) num = 3; else if( amant < .36 ) num = 4; else if( amant < .43 ) num = 5; else if( amant < .46 ) num = 6; else if( amant < .60 ) num = 10; else if( amant < .70 ) num = 15; else if( amant < .79 ) num = 20; else if( amant < .92 ) num = 30; else num = 60; step = num * pow(60.0, (double)iexp) * 15.0; } else { if ( amant < .10 ) num = 1; else if( amant < .20 ) num = 2; else if( amant < .30 ) num = 3; else if( amant < .40 ) num = 4; else if( amant < .46 ) num = 6; else if( amant < .55 ) num = 8; else num = 12; step = num * pow(60.0, (double)iexp) * 15.0; } } else if( !strcmp("dec",tickScal) ) { diff = log10( adiff/nlabel ) / log10(60.0); iexp = (int)floor(diff); amant = diff - iexp; if( iexp<-2 ) { /* This is the sub-second level... resort to base 10/3600 steps */ diff = log10( (adiff*3600.0)/nlabel ); iexp = (int)floor(diff); amant = diff - iexp; if ( amant < .15 ) num = 1; else if( amant < .50 ) num = 2; else if( amant < .85 ) num = 5; else num = 10; step = num * pow(10.0, (double)iexp) / 3600.0; } else { if ( amant < .10 ) num = 1; else if( amant < .21 ) num = 2; else if( amant < .30 ) num = 3; else if( amant < .36 ) num = 4; else if( amant < .43 ) num = 5; else if( amant < .46 ) num = 6; else if( amant < .60 ) num = 10; else if( amant < .70 ) num = 15; else if( amant < .79 ) num = 20; else if( amant < .92 ) num = 30; else num = 60; step = num * pow(60.0, (double)iexp); } } else if( !strcmp("log",tickScal) ) { static int logTicks[][10] = { { 1, 10 }, { 1, 3, 10 }, { 1, 2, 5, 10 }, { 1, 2, 4, 6, 10 }, { 1, 2, 4, 6, 8, 10 }, { 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 } }; double logDiff, base; int i, idx; if( fabs(a1)>300 || fabs(a2)>300 ) { return 0; } base = pow(10.0, floor(a1) ); a1 = pow(10.0,a1); a2 = pow(10.0,a2); logDiff = adiff / nlabel; if( logDiff < 0.15 ) { value = a1; do { diff = log10( value*pow(10.0, logDiff) - value ); iexp = (int)floor(diff); amant = diff - iexp; if ( amant < .10 ) num = 1; else if( amant < .45 ) num = 2; else if( amant < .80 ) num = 5; else { iexp++; num = 1; } base = pow(10.0, (double)iexp); step = num * base; off = (int)floor( value / step ) + 1; do { value = step * off++; if( value>=a1 && value<=a2 ) { list[n++] = log10(value); } if( ((int)(value/base))%10 == 0 ) break; } while( value<=a2 && na2 ) return n; } while(1); } if ( logDiff < 0.19 ) idx = 5; /* 1, 2, 3, 4, 5, ... */ else if( logDiff < 0.24 ) idx = 4; /* 1, 2, 4, 6, 8 */ else if( logDiff < 0.30 ) idx = 3; /* 1, 2, 4, 6 */ else if( logDiff < 0.45 ) idx = 2; /* 1, 2, 5 */ else if( logDiff < 0.75 ) idx = 1; /* 1, 3 */ else idx = 0; /* 1 */ if( logDiff > 1.8 ) step = pow(10.0, floor(logDiff+0.2) ); else step = 10.0; i = 0; do { do { value = logTicks[idx][i] * base; if( value>=a1 && value <=a2 ) { list[n++] = log10(value); } } while( logTicks[idx][i++]<10 ); base *= step; i = 1; } while( value1000.0 ) value = 0.0; list[n++] = value; value += step; } while( value<=a2 && ngraph_name)+15; idxStr = (char *) ckalloc( len*sizeof(char) ); sprintf(idxStr, "%s,%s", "graphType", graph->graph_name); graphType = Tcl_GetVar2(interp,"powPlotParam",idxStr,TCL_GLOBAL_ONLY); ckfree(idxStr); len = strlen(graph->graph_name)+15; idxStr = (char *) ckalloc( len*sizeof(char) ); sprintf(idxStr, "%s,%s", "zoomed", graph->graph_name); zoomed = atoi(Tcl_GetVar2(interp,"powPlotParam",idxStr,TCL_GLOBAL_ONLY)); ckfree(idxStr); xCount = atoi(Tcl_GetVar2(interp,"xCount",graph->graph_name,TCL_GLOBAL_ONLY)); yCount = atoi(Tcl_GetVar2(interp,"yCount",graph->graph_name,TCL_GLOBAL_ONLY)); /* when zoom, the flipping of axis is already done. So right X at zoomed = 0 will now be at left X */ if ( graph->WCS.type[0] == '\0' && strcmp(graphType, "binary") == 0 && xCount % 2 != 0 ) { if ( zoomed == 0 ) { pt.x = (pt.x - Pt0.x) / graph->xmagstep; } else { pt.x = (Pt0.x - pt.x) / graph->xmagstep; } } else { pt.x = (pt.x - Pt0.x) / graph->xmagstep; } if ( graph->WCS.type[0] == '\0' && strcmp(graphType, "binary") == 0 && yCount % 2 != 0 ) { if ( zoomed == 0 ) { pt.y = (Pt0.y - pt.y) / graph->ymagstep; } else { pt.y = (pt.y - Pt0.y) / graph->ymagstep; } } else { pt.y = (Pt0.y - pt.y) / graph->ymagstep; } errFlag = PowPixToPos( pt.x, pt.y, &graph->WCS, &Pt->x, &Pt->y ); return(errFlag); } int GraphToCanv( PowGraph *graph, int zoomed, const char *graphType, int xCount, int yCount, Point Pt0, Point Pt, Point Pt0_real, Point *pt ) { int errFlag; errFlag = PowPosToPix( Pt.x, Pt.y, &graph->WCS, &pt->x, &pt->y ); /* WCS Flag ? */ if ( graph->WCS.type[0] == '\0' && strcmp(graphType, "binary") == 0 && xCount % 2 != 0 ) { if ( zoomed == 0 ) { pt->x = Pt0.x + pt->x * graph->xmagstep; } else { pt->x = Pt0.x + (-1.0 * pt->x) * graph->xmagstep; } } else { pt->x = Pt0.x + pt->x * graph->xmagstep; } if ( graph->WCS.type[0] == '\0' && strcmp(graphType, "binary") == 0 && yCount % 2 != 0 ) { if ( zoomed == 0 ) { pt->y = Pt0.y - pt->y * graph->ymagstep; } else { pt->y = Pt0.y - (-1.0 * pt->y) * graph->ymagstep; } } else { pt->y = Pt0.y - pt->y * graph->ymagstep; } return(errFlag); } int PtBtwnPts(Point pt, Point pt1, Point pt2, char fixed) { double x, x1, x2, y, y1, y2; if( fixed!='x' && fixed!='l' && fixed!='r' ) { x = pt.x; x1 = pt1.x; x2 = pt2.x; if( x1=x2 ) return 0; } else { if( x=x1 ) return 0; } } if( fixed!='y' && fixed!='t' && fixed!='b' ) { y = pt.y; y1 = pt1.y; y2 = pt2.y; if( y1=y2 ) return 0; } else { if( y=y1 ) return 0; } } return 1; } Point CalcXY ( PowGraph *graph, Point pt, GridPt *G, int zoomed, const char *graphType, int xCount, int yCount ) { /* Chai: 07/19/2007: This function is no longer used. */ Point XY; double ds; int errFlag = 0; /*********************************************************************/ /* Calculate the graph cordinates of pt using the info in GridPt G */ /*********************************************************************/ errFlag = PowPixToPos( pt.x, pt.y, &graph->WCS, &XY.x, &XY.y ); if( G->side==left || G->side==right ) { if ( strcmp(graphType, "binary") == 0 && yCount % 2 != 0 ) { ds = pt.y - G->scrnPt.y; } else { ds = G->scrnPt.y - pt.y; } } else { if ( graph->WCS.type[0] == '\0' && strcmp(graphType, "binary") == 0 && xCount % 2 != 0 ) { ds = G->scrnPt.x - pt.x; } else { ds = pt.x - G->scrnPt.x; } } XY.x = G->imgPt.x + G->coeff[0]*ds + G->coeff[2]*ds*ds; XY.y = G->imgPt.y + G->coeff[1]*ds + G->coeff[3]*ds*ds; return XY; } Point SolveXY ( double Val, char axis, GridPt *G) { double a,b,c,ds,ds1,ds2,quad; Point XY; /*************************************************************/ /* Calculate the full graph coordinates of where the given */ /* tick value, Val, intersects the graph's bounding box. */ /*************************************************************/ if( axis=='x' ) { a = G->coeff[2]; b = G->coeff[0]; c = G->imgPt.x-Val; } else { a = G->coeff[3]; b = G->coeff[1]; c = G->imgPt.y-Val; } if( a==0.0 ) ds = -c/b; else { quad = sqrt(b*b-4.0*a*c); ds1 = (-b-quad)/(2.0*a); ds2 = (-b+quad)/(2.0*a); if( ds1>ds2 ) { ds = ds1; ds1 = ds2; ds2 = ds; } if( G->side==top || G->side==right ) { if( ds1<0.0 ) ds = ds2; else ds = ds1; } else { if( ds2>0.0 ) ds = ds1; else ds = ds2; } } if( axis=='x' ) { XY.x = Val; XY.y = G->imgPt.y + G->coeff[1]*ds + G->coeff[3]*ds*ds; } else { XY.x = G->imgPt.x + G->coeff[0]*ds + G->coeff[2]*ds*ds; XY.y = Val; } return XY; } void CalcCoeff( PowGraph *graph, GridPt *G1, GridPt *G2, GridPt *G3, int zoomed, const char *graphType, int xCount, int yCount ) { double dX,dY,ds; double dX2,dY2; /********************************************************************/ /* Calculate the linear or 2nd-order polynomial coefficients which */ /* fit the dependency of graph coordinates on canvas coordinates */ /********************************************************************/ if( G1->side==left || G1->side==right ) { ds = G2->scrnPt.y - G1->scrnPt.y; } else { ds = G2->scrnPt.x - G1->scrnPt.x; } dX = G2->imgPt.x - G1->imgPt.x; dY = G2->imgPt.y - G1->imgPt.y; if( G3==NULL ) { G1->coeff[0] = dX/ds; G1->coeff[1] = dY/ds; G1->coeff[2] = G1->coeff[3] = 0.0; } else { dX2 = G3->imgPt.x - G1->imgPt.x; dY2 = G3->imgPt.y - G1->imgPt.y; G1->coeff[0] = (4.0*dX-dX2)/(ds+ds); G1->coeff[1] = (4.0*dY-dY2)/(ds+ds); G1->coeff[2] = (dX2-2.0*dX)/(2.0*ds*ds); G1->coeff[3] = (dY2-2.0*dY)/(2.0*ds*ds); } } /***********************************************************************/ #define MAXCONTOURS 50 typedef struct { int xdim, ydim; double **rows; char *usedGrid; long nPts, nAlloc; double *X, *Y; } Contours; int BuildContours( int nCntrs, double *levels, int xdim, int ydim, double *image, int *nPts, double **X, double **Y ); int TraceContour ( Contours *Info, double cntr, int xCell, int yCell, SideVal side); int PowCreateContour(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]) { char *contour, *image; double *imgData, levels[MAXCONTOURS], *lvlPtr; double xfrac, yfrac; double *X, *Y; int nPts; int nContours, xdim, ydim, res, status=TCL_OK; int i, j, xbnds, ybnds; long nelem, elem; PowImage *img; const char **list; if( argc != 5 ) { Tcl_SetResult(interp, "usage: powCreateContour contour image levels res", TCL_VOLATILE); return TCL_ERROR; } /********************************************************/ /* Convert parameter arguments to useable C variables */ /********************************************************/ contour = argv[1]; image = argv[2]; Tcl_GetInt (interp,argv[4],&res); if( res<1 ) res = 1; if( Tcl_SplitList(interp, argv[3], &nContours, &list)!=TCL_OK) { Tcl_SetResult(interp, "Contour levels not a valid list", TCL_VOLATILE); return TCL_ERROR; } if( nContours > MAXCONTOURS ) { Tcl_SetResult(interp, "Too many levels selected", TCL_VOLATILE); ckfree( (char*)list ); return TCL_ERROR; } lvlPtr = levels; for( i=0; iwidth + res - 1) / res; ydim = (img->height + res - 1) / res; nelem = xdim * ydim; imgData = (double*)ckalloc( nelem*sizeof(double) ); if( !imgData ) { Tcl_SetResult(interp, "Could not allocate memory for image", TCL_VOLATILE); return TCL_ERROR; } /* Rescale image to desired contour resolution */ for( elem=0; elemwidth - img->width%res; ybnds = img->height - img->height%res; yfrac = 1.0/res; for( j=0; jheight; j++ ) { if( j == ybnds ) yfrac = 1.0/(img->height - ybnds); xfrac = 1.0/res; for( i=0; iwidth; i++ ) { if( i == xbnds ) xfrac = 1.0/(img->width - xbnds); imgData[(j/res)*xdim+(i/res)] += xfrac * yfrac * PowExtractDatum( img->dataptr, j*(img->width)+i ); } } status = BuildContours( nContours, levels, xdim, ydim, imgData, &nPts, &X, &Y); if( !status ) { /* Must use pointers to pass data to PowCreateXXX... ICK!!! */ int datatype = DOUBLE_DATA; int length = nPts; int copy = 1; int offset = 0; int sLen; char str1[256], str2[256]; for( elem = 0; elemWCS.type[0]=='\0' ) { X[elem] = (X[elem] - 0.5) * img->xinc + img->xorigin; Y[elem] = (Y[elem] - 0.5) * img->yinc + img->yorigin; } } sLen = strlen(contour); if( sLen>245 ) sLen=245; strncpy(str1,contour,sLen); str1[sLen]='\0'; strncpy(str2,contour,sLen); str2[sLen]='\0'; strcpy(str1+sLen,"_Xdata"); strcpy(str2+sLen,"_Xvec"); PowCreateData( str1, X, &datatype, &length, ©, &status ); PowCreateVector( str2, str1, &offset, &length, "NULL", &status ); ckfree( (char *)X ); strcpy(str1+sLen,"_Ydata"); strcpy(str2+sLen,"_Yvec"); PowCreateData( str1, Y, &datatype, &length, ©, &status ); PowCreateVector( str2, str1, &offset, &length, "NULL", &status ); ckfree( (char *)Y ); strcpy(str1+sLen,"_Xvec"); PowCreateCurve( contour, str1, NULL, str2, NULL, NULL, NULL, &status ); } ckfree( (char *)imgData ); if( status ) Tcl_SetResult(interp, "Unable to build contours", TCL_VOLATILE); return status; } int BuildContours( int nCntrs, double *levels, int xdim, int ydim, double *image, int *nPts, double **X, double **Y ) { int i, j, c, status = TCL_OK; double cntour; long nelem, elem; Contours Info; Info.xdim = xdim; Info.ydim = ydim; Info.nPts = 6; Info.nAlloc = 2000; Info.X = (double*)ckalloc( Info.nAlloc * sizeof(double) ); Info.Y = (double*)ckalloc( Info.nAlloc * sizeof(double) ); if( !(Info.X && Info.Y) ) return TCL_ERROR; Info.X[0] = Info.Y[0] = 0.0; Info.X[1] = 0.0; Info.Y[1] = ydim-1; Info.X[2] = xdim-1; Info.Y[2] = ydim-1; Info.X[3] = xdim-1; Info.Y[3] = 0.0; Info.X[4] = 0.0; Info.Y[4] = 0.0; Info.X[5] = Info.Y[5] = DBL_MAX; nelem = xdim*ydim; Info.usedGrid = (char *)ckalloc( nelem*sizeof(char) ); if( ! Info.usedGrid ) { ckfree( (char *)Info.X ); ckfree( (char *)Info.Y ); return TCL_ERROR; } Info.rows = (double **)ckalloc( ydim * sizeof(double*) ); for( j=0; j=0 && !status; i-- ) if( Info.rows[j][i+1]=0 && !status; j-- ) if( Info.rows[j+1][i]nPts; done = (i<0 || i>=Info->xdim-1 || j<0 && j>=Info->ydim-1); while( !done ) { flag = 0; a = Info->rows[j][i]; b = Info->rows[j][i+1]; c = Info->rows[j+1][i+1]; d = Info->rows[j+1][i]; if( init ) { init = 0; switch( side ) { case top: X = (cntr-a) / (b-a) + i; Y = j; break; case right: X = i+1; Y = (cntr-b) / (c-b) + j; break; case bottom: X = (cntr-c) / (d-c) + i; Y = j+1; break; case left: X = i; Y = (cntr-a) / (d-a) + j; break; } } else { if( side==top ) Info->usedGrid[j*Info->xdim + i] = 1; do { if( ++side == none ) side = top; switch( side ) { case top: if( a>=cntr && cntr>b ) { flag = 1; X = (cntr-a) / (b-a) + i; Y = j; j--; } break; case right: if( b>=cntr && cntr>c ) { flag = 1; X = i+1; Y = (cntr-b) / (c-b) + j; i++; } break; case bottom: if( c>=cntr && cntr>d ) { flag = 1; X = (cntr-d) / (c-d) + i; Y = j+1; j++; } break; case left: if( d>=cntr && cntr>a ) { flag = 1; X = i; Y = (cntr-a) / (d-a) + j; i--; } break; } } while (!flag); if( ++side == none ) side = top; if( ++side == none ) side = top; if( i==xCell && j==yCell && side==origSide ) done = 1; if( i<0 || i>=Info->xdim-1 || j<0 || j>=Info->ydim-1 ) done = 1; } /* Make sure there are at least 2 more Pts available to allocate */ if( npts+2 > Info->nAlloc ) { ptr = (double*)ckrealloc( (char *)Info->X, (Info->nAlloc+1000) * sizeof(double) ); if( ptr ) { Info->X = ptr; ptr = (double*)ckrealloc( (char *)Info->Y, (Info->nAlloc+1000) * sizeof(double) ); if( ptr ) Info->Y = ptr; } if( !ptr ) return TCL_ERROR; Info->nAlloc += 1000; } Info->X[ npts ] = X; Info->Y[ npts ] = Y; npts++; if( done ) { Info->X[ npts ] = DBL_MAX; Info->Y[ npts ] = DBL_MAX; npts++; } } Info->nPts = npts; return TCL_OK; } fv5.5/tcltk/pow/PowInit.c0000644000220700000360000004717213224715127014217 0ustar birbylhea#ifdef __WIN32__ #include #endif #include "pow.h" #include "stretcharrow.xbm" /* *---------------------------------------------------------------------- * * DllEntryPoint -- * * This wrapper function is used by Windows to invoke the * initialization code for the DLL. If we are compiling * with Visual C++, this routine will be renamed to DllMain. * routine. * * Results: * Returns TRUE; * * Side effects: * None. * *---------------------------------------------------------------------- */ #ifdef __WIN32__ int WINAPI dllEntry(HANDLE hDll, DWORD reason, LPVOID reserved) { return TRUE; } #endif int pixelSizes[6] = {1,2,4,4,8,8}; char *WCSpih_Message[] = { "Success.", "Null wcsprm pointer passed.", "Memory allocation failed.", "Linear transformation matrix is singular.", "Inconsistent or unrecognized coordinate axis types.", "Invalid parameter value.", "Invalid coordinate transformation parameters.", "Ill-conditioned coordinate transformation parameters.", "One or more of the world coordinates were invalid." }; char *WCStrans_Message[] = { "Success", "Null wcsprm pointer passed", "Memory allocation failed", "Linear transformation matrix is singular", "Inconsistent or unrecognized coordinate axis types", "Invalid parameter value", "Invalid coordinate transformation parameters", "Ill-conditioned coordinate transformation parameters", "One or more of the pixel coordinates were invalid", "One or more of the world coordinates were invalid", "Invalid world coordinate", "No solution found in the specified interval", "Invalid subimage specification", "Non-separable subimage coordinate system"}; /* globals linked with tcl variables */ int tty = 0; int Pow_Done = 0; /* current method for event handling, will change */ # extern int Pow_Allocated; Tcl_HashTable PowDataTable; Tcl_HashTable PowImageTable; Tcl_HashTable PowVectorTable; Tcl_HashTable PowCurveTable; Tcl_HashTable PowGraphTable; Tcl_Interp *interp = NULL; /* Interpreter for application. */ Tk_Window mainWindow; /* The main window for the application. If * NULL then the application no longer * exists. */ /*This stuff currently lives here for plugin purposes */ #ifdef PLUGIN extern int singleBarFastGen(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]); extern int singleRollMe(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]); extern int c_given_RADecMJD_return_Roll(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]); #endif /*PLUGIN */ int Pow_Init(Tcl_Interp *interp_instance) { Tcl_DString pow_env; const char *charptr; char temp[1000]; Tcl_DStringInit(&pow_env); interp = interp_instance; if (Visu_Init(interp) == TCL_ERROR) { return TCL_ERROR; } #if defined(MAC_TCL) && defined(PLUGIN) strcpy(temp,"source -rsrc html_library\n"); strcat(temp,"source -rsrc notebook\n"); strcat(temp,"source -rsrc pow\n"); strcat(temp,"source -rsrc powEdit\n"); strcat(temp,"source -rsrc powRgn\n"); strcat(temp,"source -rsrc powMovie\n"); strcat(temp,"source -rsrc powScript\n"); strcat(temp,"powInitGlobals\n"); if( Tcl_GlobalEval(interp,temp) == TCL_ERROR ) { return TCL_ERROR; } #else charptr = Tcl_GetVar2(interp,"env", "POW_LIBRARY", TCL_GLOBAL_ONLY); if( charptr == NULL ) { puts("Could not find defaults."); puts(" Set your POW_LIBRARY environment variable."); return TCL_ERROR; } else { Tcl_DStringAppend(&pow_env,charptr, -1); } /* Brackets needed around %s to prevent Windows-style paths */ /* ... eg, c:\fv... from getting converted to control chars */ /* when doing the GlobalEval. */ sprintf(temp,"lappend auto_path {%s}; powInitGlobals",charptr); if( Tcl_GlobalEval(interp,temp) == TCL_ERROR ) return TCL_ERROR; /* Lets try using auto_path instead of all these sources.... Tcl_SetVar(interp, "powsrcdir",Tcl_DStringValue(&pow_env), TCL_GLOBAL_ONLY); Tcl_DStringInit(&pow_script); Tcl_DStringAppend(&pow_script,Tcl_DStringValue(&pow_env),-1); Tcl_DStringAppend(&pow_script,"/html_library.tcl",-1); if( Tcl_EvalFile(interp,Tcl_DStringValue(&pow_script)) == TCL_ERROR) { fprintf(stderr, "%s\n", interp->result); return TCL_ERROR; } Tcl_DStringFree(&pow_script); Tcl_DStringInit(&pow_script); Tcl_DStringAppend(&pow_script,Tcl_DStringValue(&pow_env),-1); Tcl_DStringAppend(&pow_script,"/notebook.tcl",-1); if( Tcl_EvalFile(interp,Tcl_DStringValue(&pow_script)) == TCL_ERROR) { fprintf(stderr, "%s\n", interp->result); return TCL_ERROR; } Tcl_DStringFree(&pow_script); Tcl_DStringInit(&pow_script); Tcl_DStringAppend(&pow_script,Tcl_DStringValue(&pow_env),-1); Tcl_DStringAppend(&pow_script,"/pow.tcl",-1); if( Tcl_EvalFile(interp,Tcl_DStringValue(&pow_script)) == TCL_ERROR) { fprintf(stderr, "%s\n", interp->result); return TCL_ERROR; } Tcl_DStringFree(&pow_script); Tcl_DStringInit(&pow_script); Tcl_DStringAppend(&pow_script,Tcl_DStringValue(&pow_env),-1); Tcl_DStringAppend(&pow_script,"/powEdit.tcl",-1); if( Tcl_EvalFile(interp,Tcl_DStringValue(&pow_script)) == TCL_ERROR) { fprintf(stderr, "%s\n", interp->result); return TCL_ERROR; } Tcl_DStringFree(&pow_script); Tcl_DStringInit(&pow_script); Tcl_DStringAppend(&pow_script,Tcl_DStringValue(&pow_env),-1); Tcl_DStringAppend(&pow_script,"/powRgn.tcl",-1); if( Tcl_EvalFile(interp,Tcl_DStringValue(&pow_script)) == TCL_ERROR) { fprintf(stderr, "%s\n", interp->result); return TCL_ERROR; } Tcl_DStringFree(&pow_script); */ #endif /* MAC_TCL and PLUGIN*/ Tcl_InitHashTable(&PowDataTable, TCL_STRING_KEYS); Tcl_InitHashTable(&PowImageTable, TCL_STRING_KEYS); Tcl_InitHashTable(&PowVectorTable, TCL_STRING_KEYS); Tcl_InitHashTable(&PowCurveTable, TCL_STRING_KEYS); Tcl_InitHashTable(&PowGraphTable, TCL_STRING_KEYS); Tk_DefineBitmap(interp, Tk_GetUid("stretcharrow"), stretcharrow_bits, stretcharrow_width, stretcharrow_height); #if !(defined(__WIN32__) || defined(macintosh)) /* Keeps track of whether Pow has allocated its PseudoColor cells or not */ strcpy(temp,"Pow_Allocated"); Tcl_LinkVar(interp,temp,(char *) &Pow_Allocated,TCL_LINK_INT); #endif Pow_CreateCommands(interp); Tk_CreateItemType(&tkPowCurveType); return TCL_OK; } /* initialization only for Unix standalone */ int Pow_InitExec(Tcl_Interp *interp_instance) { Tcl_DString pow_env; #if !(defined(__WIN32__) || defined(macintosh)) char temp[1000]; #endif Tcl_DStringInit(&pow_env); interp = interp_instance; if (Visu_Init(interp) == TCL_ERROR) { return TCL_ERROR; } #if defined(MAC_TCL) && defined(PLUGIN) strcpy(temp,"source -rsrc html_library\n"); strcat(temp,"source -rsrc notebook\n"); strcat(temp,"source -rsrc pow\n"); strcat(temp,"source -rsrc powEdit\n"); strcat(temp,"source -rsrc powRgn\n"); strcat(temp,"source -rsrc powMovie\n"); strcat(temp,"source -rsrc powScript\n"); strcat(temp,"powInitGlobals\n"); if( Tcl_GlobalEval(interp,temp) == TCL_ERROR ) { return TCL_ERROR; } #else #endif /* MAC_TCL and PLUGIN*/ Tcl_InitHashTable(&PowDataTable, TCL_STRING_KEYS); Tcl_InitHashTable(&PowImageTable, TCL_STRING_KEYS); Tcl_InitHashTable(&PowVectorTable, TCL_STRING_KEYS); Tcl_InitHashTable(&PowCurveTable, TCL_STRING_KEYS); Tcl_InitHashTable(&PowGraphTable, TCL_STRING_KEYS); Tk_DefineBitmap(interp, Tk_GetUid("stretcharrow"), stretcharrow_bits, stretcharrow_width, stretcharrow_height); #if !(defined(__WIN32__) || defined(macintosh)) /* Keeps track of whether Pow has allocated its PseudoColor cells or not */ strcpy(temp,"Pow_Allocated"); Tcl_LinkVar(interp,temp,(char *) &Pow_Allocated,TCL_LINK_INT); #endif Pow_CreateCommands(interp); Tk_CreateItemType(&tkPowCurveType); return TCL_OK; } /* Create the Pow Commands */ int Pow_CreateCommands(Tcl_Interp *interp) { Tcl_CreateObjCommand(interp,"powWCSInitImage",PowWCSInitImage, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateObjCommand(interp,"powWCSInitCurve",PowWCSInitCurve, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateObjCommand(interp, "powWCSexists", PowWCSexists, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateObjCommand(interp, "powWCSisSwapped", PowWCSisSwapped, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp,"powGetImageOrigin",PowGetImageOrigin, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp,"powGetImageOtherend",PowGetImageOtherend, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp,"powGetImageUnits",PowGetImageUnits, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp,"powDestroyData",PowDestroyData_Tcl, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp,"powDestroyImage",PowDestroyImage_Tcl, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp,"powDestroyVector",PowDestroyVector_Tcl, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp,"powDestroyCurve",PowDestroyCurve_Tcl, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp,"powDestroyGraph",PowDestroyGraph_Tcl, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp,"powCreateImage",PowCreateImage_Tcl, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp,"powCreateGraph",PowCreateGraph_Tcl, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp,"powFindData",PowFindData_Tcl, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp,"powFindCurvesMinMax",PowFindCurvesMinMax_Tcl, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp,"powFetchDataLength",PowFetchDataLength, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp,"powFetchCurveInfoHash",PowFetchCurveInfoHash, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp,"powFetchVectorInfoHash",PowFetchVectorInfoHash, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp,"powFetchImageInfoHash",PowFetchImageInfoHash, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp,"powCreateVector",PowCreateVector_Tcl, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp,"powCreateVectorEN",PowCreateVectorEN_Tcl, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp,"powCreateCurve",PowCreateCurve_Tcl, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp,"powCreateHisto",PowCreateHisto_Tcl, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp,"powCreateDataFlip",PowCreateDataFlip_Tcl, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp,"powCreateCurveFlip",PowCreateCurveFlip_Tcl, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp,"powCreateData",PowCreateData_Tcl, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp,"powCloneData",PowCloneData, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp,"powRegisterData",PowRegisterData_Tcl, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp,"powCreateDataFromList",PowCreateDataFromList, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateObjCommand(interp,"powCreateDataFromBuffer", PowCreateDataFromBuffer, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateObjCommand(interp,"powCreateDataFromChannel", PowCreateDataFromChannel, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateObjCommand(interp,"powCreateDataFromPtr", PowCreateDataFromPtr, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateObjCommand(interp,"powCreateStrFromPtr", PowCreateStrFromPtr, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp,"powSetGraphMagstep",PowSetGraphMagstep, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp,"powProcessCurve",PowProcessCurve, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp,"powListGraphs",PowListGraphs, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp,"powListCurves",PowListCurves, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp,"powListImages",PowListImages, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp,"powListVectors",PowListVectors, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp,"powListData",PowListData, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp,"powCleanUp",PowCleanUp, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp,"powSetupColormap",PowSetupColormap, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp,"powSetupPhotoImages",PowSetupPhotoImages, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp,"powTestColormap",PowTestColormap, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp,"powPutZoomedBlock",PowPutZoomedBlock, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp,"powPhotoColorTable",PowPhotoColorTable, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp,"powReditherPhotoBlock",PowReditherPhotoBlock, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateObjCommand(interp,"powTestMacMemory",PowTestMacMemory, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateObjCommand(interp,"powPhotoCmapStretch",PowPhotoCmapStretch, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateObjCommand(interp, "powImageScale", PowImageScale, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateObjCommand(interp, "powGetHisto", PowGetHisto, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateObjCommand(interp,"powGetImageZ",PowGetImageZ, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateObjCommand(interp,"powWorldPos",PowWorldPos, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateObjCommand(interp,"powXYPx",PowXYPx, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateObjCommand(interp, "powGraphToCanvas", PowGraphToCanvas, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateObjCommand(interp, "powCanvasToGraph", PowCanvasToGraph, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateObjCommand(interp, "powGraphToPixel", PowGraphToPixel, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateObjCommand(interp, "powPixelToGraph", PowPixelToGraph, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateObjCommand(interp, "powResetWcsStructure", PowResetWcsStructure, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateObjCommand(interp, "powGraphVToPixelV", PowGraphVToPixelV, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateObjCommand(interp, "powPixelVToGraphV", PowPixelVToGraphV, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateObjCommand(interp, "powGetImageClipbox", PowGetImageClipbox, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateObjCommand(interp, "powExprGetData", PowExprDataInfo, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateObjCommand(interp, "powDataPtr", PowDataPtr_Tcl, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateObjCommand(interp, "powTestImage", PowTestImage, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp,"powDrawGridLines",PowDrawGridLines, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp,"powCreateContour",PowCreateContour, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp,"powGetTics",PowGetTics, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp,"powGetRegionStatistics", PowGetRegionStatistics, (ClientData) NULL, (Tcl_CmdDeleteProc*) NULL); #ifdef PLUGIN Tcl_CreateCommand(interp_instance,"singleBarFastGen", (Tcl_CmdProc*)singleBarFastGen, (ClientData) NULL, (Tcl_CmdDeleteProc*) NULL); Tcl_CreateCommand(interp_instance,"singleRollMe", (Tcl_CmdProc*)singleRollMe, (ClientData) NULL, (Tcl_CmdDeleteProc*) NULL); Tcl_CreateCommand(interp_instance,"c_given_RADecMJD_return_Roll", (Tcl_CmdProc*)c_given_RADecMJD_return_Roll, (ClientData) NULL, (Tcl_CmdDeleteProc*) NULL); #endif /*PLUGIN */ return TCL_OK; } void PowInit(char *powSetupColormapArgs, char *powInitArgs, int *status) { /*call this one from a standalone C or FORTRAN main (as opposed to a tkAppInit file) */ if (*status != 0) return; if (interp == NULL || Tcl_InterpDeleted(interp)) { /* the test condition above should ensure that we only create a new interpreter if we don't have one already */ interp = Tcl_CreateInterp(); if (Tcl_Init(interp) == TCL_ERROR) { *status = TCL_ERROR; fprintf(stderr, "%s\n", Tcl_GetStringResult(interp)); return; } if (Tk_Init(interp) == TCL_ERROR) { *status = TCL_ERROR; fprintf(stderr, "%s\n", Tcl_GetStringResult(interp)); return; } tty = isatty(0); Tcl_SetVar(interp, "tcl_interactive", tty ? "1" : "0", TCL_GLOBAL_ONLY); Tcl_LinkVar(interp,"Pow_Done",(char *) &Pow_Done,TCL_LINK_INT); /* currently used for event handling */ *status = Pow_Init(interp); if (*status != 0) return; } if (Tcl_RegExpMatch(interp,powSetupColormapArgs,"[^ \t\n\r\f]") == 1) { /*if user supplied args for powSetupColormap are not pure whitespace...*/ if(Tcl_VarEval(interp, "powSetupColormap ", powSetupColormapArgs, (char *) NULL) == TCL_ERROR) { *status = TCL_ERROR; fprintf(stderr, "Error initializing POW.\n%s\n", Tcl_GetStringResult(interp)); } } if(Tcl_VarEval(interp, "powInit ", powInitArgs, (char *) NULL) == TCL_ERROR) { *status = TCL_ERROR; fprintf(stderr, "Error initializing POW.\n%s\n", Tcl_GetStringResult(interp)); } } fv5.5/tcltk/pow/PowUtils.c0000644000220700000360000011400613224715127014403 0ustar birbylhea#include #include #include "pow.h" #include "powRegion.h" /* on some system , e.g. linux, SUNs DBL_MAX is in float.h */ #ifndef DBL_MAX #include #endif #ifndef DBL_MIN #include #endif #define NCOORD 1 static int Pt_in_Poly( double x, double y, int nPts, double *Pts ); int PowFindCurvesMinMax(const char *curves, char *axis, double *min, double *max, int filter) /* Sets min and max to the minimum and maximum values found in the "axis" vector of each member of the list of curves. Initial values for min and max are whatever they are when the routine is called. (i.e. if *min == 0 upon entry and there are no negative values in the curves, *min will == 0 upon return). */ { PowCurve *current_curve; PowVector *current_vector; PowData *current_data; int curve_index,curveArgc; const char **curveArgv; double datum; int i; if(curves == NULL || strstr(curves,"NULL") != NULL ) return TCL_OK; if(Tcl_SplitList(interp,curves,&curveArgc,&curveArgv) != TCL_OK) { return TCL_ERROR; } for (curve_index = 0; curve_index < curveArgc;curve_index++) { current_curve = PowFindCurve(curveArgv[curve_index]); switch (*axis) { case 'X': current_vector = current_curve->x_vector; break; case 'Y': current_vector = current_curve->y_vector; break; case 'Z': current_vector = current_curve->z_vector; break; default: Tcl_SetResult( interp, "Axis must be X, Y, or Z.", TCL_VOLATILE ); ckfree( (char *)curveArgv ); return TCL_ERROR; } if(current_vector != NULL) { current_data = current_vector->dataptr; for (i = current_vector->offset ; i < current_vector->offset + current_curve->length ; i++) { datum = PowExtractDatum(current_data,i); if( filter && datum <= 0.0 ) /* Positive data only (for logs) */ datum = DBL_MAX; if (datum != DBL_MAX) { *min = (datum < *min) ? datum : *min; *max = (datum > *max) ? datum : *max; } } } else { *min = ( 1.0 < *min) ? 1.0 : *min; *max = (current_curve->length > *max) ? current_curve->length : *max; } } ckfree((char *) curveArgv); return TCL_OK; } int PowFindCurvesBBox(char *graph, char *curves, double *xleft, double *xright, double *ybot, double *ytop, WCSdata *BaseWCS) { PowCurve *current_curve; PowVector *Xvec, *Yvec; int curve_index,curveArgc; const char **curveArgv; double xdatum, ydatum, xmin, xmax, ymin, ymax, tmp; double lxmin, lxmax, lymin, lymax; int i,j, logX, logY; const char *optVal; if(curves == NULL || strstr(curves,"NULL") != NULL ) return TCL_OK; if(Tcl_SplitList(interp,curves,&curveArgc,&curveArgv) != TCL_OK) { return TCL_ERROR; } /* Search through curve list for bounding box information */ /* Skip any curves which raise errors, but don't abort! */ for( curve_index = 0; curve_index < curveArgc; curve_index++ ) { current_curve = PowFindCurve(curveArgv[curve_index]); Xvec = current_curve->x_vector; Yvec = current_curve->y_vector; optVal = PowGetObjectOption( graph, curveArgv[curve_index], "logX", "curve" ); if( !optVal || Tcl_GetBoolean( interp, optVal, &logX )==TCL_ERROR ) { logX = 0; } optVal = PowGetObjectOption( graph, curveArgv[curve_index], "logY", "curve" ); if( !optVal || Tcl_GetBoolean( interp, optVal, &logY )==TCL_ERROR ) { logY = 0; } xmin = ymin = DBL_MAX; xmax = ymax = - DBL_MAX; if( Xvec==NULL || Yvec==NULL || (current_curve->WCS.type[0]=='\0' && current_curve->WCS.cdFrwd[0][1]==0.0 && current_curve->WCS.cdFrwd[1][0]==0.0 ) ) { lxmin = lymin = DBL_MAX; lxmax = lymax = - DBL_MAX; PowFindCurvesMinMax( curveArgv[curve_index], "X", &lxmin, &lxmax, logX ); PowFindCurvesMinMax( curveArgv[curve_index], "Y", &lymin, &lymax, logY ); if( logX ) { if( lxmin<=0.0 || lxmax<=0.0 ) { return TCL_ERROR; } else { lxmin = log10(lxmin); lxmax = log10(lxmax); } } if( logY ) { if( lymin<=0.0 || lymax<=0.0 ) { return TCL_ERROR; } else { lymin = log10(lymin); lymax = log10(lymax); } } xmin = (lxmin < xmin) ? lxmin : xmin; xmax = (lxmax > xmax) ? lxmax : xmax; ymin = (lymin < ymin) ? lymin : ymin; ymax = (lymax > ymax) ? lymax : ymax; if( PowPixToPos( xmin, ymin, ¤t_curve->WCS, &xmin, &ymin ) ) continue; if( PowPixToPos( xmax, ymax, ¤t_curve->WCS, &xmax, &ymax ) ) continue; if( PowPosToPix( xmin, ymin, BaseWCS, &xmin, &ymin ) ) continue; if( PowPosToPix( xmax, ymax, BaseWCS, &xmax, &ymax ) ) continue; if( xmin>xmax ) { tmp=xmax; xmax=xmin; xmin=tmp; } if( ymin>ymax ) { tmp=ymax; ymax=ymin; ymin=tmp; } } else { for (i = Xvec->offset, j = Yvec->offset ; i < Xvec->offset + current_curve->length ; i++, j++) { xdatum = PowExtractDatum(Xvec->dataptr,i); ydatum = PowExtractDatum(Yvec->dataptr,j); if( xdatum != DBL_MAX && ydatum != DBL_MAX ) { if( PowPixToPos( xdatum, ydatum, ¤t_curve->WCS, &xdatum, &ydatum ) ) continue; if( PowPosToPix( xdatum, ydatum, BaseWCS, &xdatum, &ydatum ) ) continue; xmin = (xdatum < xmin) ? xdatum : xmin; xmax = (xdatum > xmax) ? xdatum : xmax; ymin = (ydatum < ymin) ? ydatum : ymin; ymax = (ydatum > ymax) ? ydatum : ymax; } } } if( xmin < *xleft ) *xleft = xmin; if( ymin < *ybot ) *ybot = ymin; if( xmax > *xright ) *xright = xmax; if( ymax > *ytop ) *ytop = ymax; } ckfree((char *) curveArgv); return TCL_OK; } int PowFindImagesBBox(char *images, double *xleft, double *xright, double *ybot, double *ytop, WCSdata *BaseWCS) { PowImage *current_image; int image_index,imageArgc; const char **imageArgv; double xorigin,xotherend,yorigin,yotherend,xcorner,ycorner; if(images == NULL || strstr(images,"NULL") != NULL) return TCL_OK; if(Tcl_SplitList(interp,images,&imageArgc,&imageArgv) != TCL_OK) { return TCL_ERROR; } /* Search through image list for bounding box information */ /* Skip any images which raise errors, but don't abort! */ for (image_index = 0; image_index < imageArgc; image_index++) { current_image = PowFindImage(imageArgv[image_index]); /* Convert origin and otherend info into pixel coordinates */ if ( PowPosToPix( current_image->xorigin, current_image->yorigin, BaseWCS, &xorigin, &yorigin ) ) continue; if ( PowPosToPix( current_image->xotherend, current_image->yotherend, BaseWCS, &xotherend, &yotherend ) ) continue; /**************************************/ /* Test the images for consistency: */ /**************************************/ if ( BaseWCS->type[0] && !current_image->WCS.type[0] ) continue; /* We are in pixel coordinates, so they should */ /* ALWAYS go from left->right */ if ( xorigin > xotherend || yorigin > yotherend ) continue; /***************************************************/ /* Images must project to an unrotated rectangle */ /***************************************************/ if( PowPixToPos( -0.5, current_image->height-0.5, ¤t_image->WCS, &xcorner, &ycorner ) ) continue; if( PowPosToPix( xcorner, ycorner, BaseWCS, &xcorner, &ycorner ) ) continue; if( fabs( xcorner-xorigin ) > 1.0 || fabs( ycorner-yotherend ) > 1.0 ) { continue; } if( PowPixToPos( current_image->width-0.5, -0.5, ¤t_image->WCS, &xcorner, &ycorner ) ) continue; if( PowPosToPix( xcorner, ycorner, BaseWCS, &xcorner, &ycorner ) ) continue; if( fabs( xcorner-xotherend ) > 1.0 || fabs( ycorner-yorigin ) > 1.0 ) { continue; } /**************************************/ /* End of consistency tests */ /**************************************/ if ( xorigin < *xleft ) *xleft = xorigin; if ( yorigin < *ybot ) *ybot = yorigin; if ( xotherend > *xright ) *xright = xotherend; if ( yotherend > *ytop ) *ytop = yotherend; } ckfree( (char *)imageArgv); return TCL_OK; } int PowFindGraphBBox( PowGraph *graph, char *images, char *curves, double *xmin, double *xmax, double *ymin, double *ymax ) { /* xmin, etc, are initially in graph's "pixel" coordinates */ *xmin = DBL_MAX; *xmax = - DBL_MAX; *ymin = DBL_MAX; *ymax = - DBL_MAX; /* Test any curves that are present */ if( curves != NULL && strstr(curves,"NULL") == NULL ) { if( PowFindCurvesBBox( graph->graph_name, curves, xmin, xmax, ymin, ymax, &(graph->WCS) ) == TCL_ERROR ) { return TCL_ERROR; } } /* Test any images that are present */ if( images != NULL && strstr(images,"NULL") == NULL ) { if( PowFindImagesBBox( images, xmin, xmax, ymin, ymax, &(graph->WCS) ) == TCL_ERROR ) { return TCL_ERROR; } } else if( *xmin!=DBL_MAX ) { double xdim, ydim; /* Only plots in graph... expand by 10% for margins around points */ xdim = *xmax - *xmin; ydim = *ymax - *ymin; *xmin -= 0.05*xdim; *ymin -= 0.05*ydim; *xmax += 0.05*xdim; *ymax += 0.05*ydim; } /* Convert bounds back into graph coordinates */ if( *xmin!=DBL_MAX ) { PowPixToPos(*xmin, *ymin, &(graph->WCS), xmin, ymin ); PowPixToPos(*xmax, *ymax, &(graph->WCS), xmax, ymax ); } else { /* Failed to find any valid bounding box. Try just 1 pixel wide around reference pix */ PowPixToPos( graph->WCS.refPix[0]-1, graph->WCS.refPix[1]-1, &(graph->WCS), xmin, ymin); PowPixToPos( graph->WCS.refPix[0]+1, graph->WCS.refPix[1]+1, &(graph->WCS), xmax, ymax); } return TCL_OK; } int PowSortGraphMinMax( PowGraph *graph, double *xleft, double *xright, double *ybot, double *ytop, double *xdim, double *ydim) { double tmp; int len; char *idxStr; const char *graphType; int zoomed; int xCount, yCount; len = strlen(graph->graph_name)+15; idxStr = (char *) ckalloc( len*sizeof(char) ); sprintf(idxStr, "%s,%s", "graphType", graph->graph_name); graphType = Tcl_GetVar2(interp,"powPlotParam",idxStr,TCL_GLOBAL_ONLY); ckfree(idxStr); len = strlen(graph->graph_name)+15; idxStr = (char *) ckalloc( len*sizeof(char) ); sprintf(idxStr, "%s,%s", "zoomed", graph->graph_name); zoomed = atoi(Tcl_GetVar2(interp,"powPlotParam",idxStr,TCL_GLOBAL_ONLY)); ckfree(idxStr); xCount = atoi(Tcl_GetVar2(interp,"xCount",graph->graph_name,TCL_GLOBAL_ONLY)); yCount = atoi(Tcl_GetVar2(interp,"yCount",graph->graph_name,TCL_GLOBAL_ONLY)); if ( PowPosToPix(*xleft, *ybot, &graph->WCS, xleft, ybot) ) return TCL_ERROR; if ( PowPosToPix(*xright, *ytop, &graph->WCS, xright, ytop) ) return TCL_ERROR; if ( zoomed == 0 && strcmp(graphType, "binary") == 0 && xCount % 2 != 0 ) { } else { } if ( zoomed == 0 && strcmp(graphType, "binary") == 0 && yCount % 2 != 0 ) { } else { } if ( *xleft>*xright ) { tmp=*xleft; *xleft=*xright; *xright=tmp; } if ( *ybot >*ytop ) { tmp=*ybot; *ybot =*ytop; *ytop =tmp; } *xdim = *xright - *xleft; *ydim = *ytop - *ybot; /* Convert bounds back into graph coordinates and return */ if ( PowPixToPos(*xleft, *ybot, &graph->WCS, xleft, ybot) ) return TCL_ERROR; if ( PowPixToPos(*xright, *ytop, &graph->WCS, xright, ytop) ) return TCL_ERROR; return TCL_OK; } PowCurve * PowFindCurve(const char *curve_name) { Tcl_HashEntry *entry_ptr; PowCurve *curve_ptr; if(curve_name == NULL || strstr(curve_name,"NULL") != NULL) { return (PowCurve *) NULL; } entry_ptr = Tcl_FindHashEntry(&PowCurveTable,curve_name); if (entry_ptr == NULL) { return (PowCurve *) NULL; } curve_ptr = (PowCurve *) Tcl_GetHashValue(entry_ptr); return curve_ptr; } PowImage * PowFindImage(const char *image_name) { Tcl_HashEntry *entry_ptr; PowImage *image_ptr; if(image_name == NULL || strstr(image_name,"NULL") != NULL) { return (PowImage *) NULL; } entry_ptr = Tcl_FindHashEntry(&PowImageTable,image_name); if (entry_ptr == NULL) { return (PowImage *) NULL; } image_ptr = (PowImage *) Tcl_GetHashValue(entry_ptr); return image_ptr; } #ifdef __WIN32__ __int64 PowExtractDatumLong(PowData *data, int element) { __int64 datum; return *((__int64 *) data->data_array + element); } #else long long PowExtractDatumLong(PowData *data, int element) { return *((long long *) data->data_array + element); } #endif double PowExtractDatum(PowData *data, int element) { double datum; switch (data->data_type) { case BYTE_DATA : datum = (double) *((unsigned char *) data->data_array + element); if (datum == UCHAR_MAX) { datum = DBL_MAX;} break; case INT_DATA : datum = (double) *((int *) data->data_array + element); if (datum == INT_MAX) {datum = DBL_MAX;} break; case SHORTINT_DATA : datum = (double) *((short int *) data->data_array + element); if (datum == SHRT_MAX) {datum = DBL_MAX;} break; case REAL_DATA : datum = (double) *((float *) data->data_array + element); if (datum == FLT_MAX) {datum = DBL_MAX;} break; case DOUBLE_DATA : datum = *((double *) data->data_array + element); break; case STRING_DATA : /*don't use PowExtractDatum on string data */ datum = DBL_MAX; break; case LONGLONG_DATA: datum = DBL_MAX; break; } return datum; } int PowPutDatum(PowData *data, double datum, int element) { switch (data->data_type) { case BYTE_DATA : *((unsigned char *) data->data_array + element) = (unsigned char) datum; break; case INT_DATA : *((int *) data->data_array + element) = (int) datum; break; case SHORTINT_DATA : *((short int *) data->data_array + element) = (int) datum; break; case REAL_DATA : *((float *) data->data_array + element) = (float) datum; break; case DOUBLE_DATA : *((double *) data->data_array + element) = (double) datum; break; } return TCL_OK; } PowVector * PowFindVector(char *vector_name) { Tcl_HashEntry *entry_ptr; PowVector *vector_ptr; if(vector_name == NULL || strstr(vector_name,"NULL") != NULL) { return (PowVector *) NULL; } entry_ptr = Tcl_FindHashEntry(&PowVectorTable,vector_name); if (entry_ptr == NULL) { return (PowVector *) NULL; } vector_ptr = (PowVector *) Tcl_GetHashValue(entry_ptr); return vector_ptr; } PowData * PowFindData(char *data_name) { Tcl_HashEntry *entry_ptr; PowData *data_ptr; if(data_name == NULL || strstr(data_name,"NULL") != NULL) { return (PowData *) NULL; } entry_ptr = Tcl_FindHashEntry(&PowDataTable,data_name); if (entry_ptr == NULL) { return (PowData *) NULL; } data_ptr = (PowData *) Tcl_GetHashValue(entry_ptr); return data_ptr; } PowGraph * PowFindGraph(char *graph_name) { Tcl_HashEntry *entry_ptr; PowGraph *graph_ptr; if(graph_name == NULL || strstr(graph_name,"NULL") != NULL) { return (PowGraph *) NULL; } entry_ptr = Tcl_FindHashEntry(&PowGraphTable,graph_name); if (entry_ptr == NULL) { return (PowGraph *) NULL; } graph_ptr = (PowGraph *) Tcl_GetHashValue(entry_ptr); return graph_ptr; } const char *PowGetObjectOption(char *graph, const char *obj, char *option, char *objType) { char *idxStr, gn[255]; const char *res; int len; len = strlen(graph); if( len>5 && !strcmp(graph+len-5,"scope") ) { strncpy(gn,graph,len-5); gn[len-5]='\0'; } else { strcpy(gn,graph); } len = strlen(gn)+strlen(obj)+strlen(option)+10; idxStr = (char *) ckalloc( len*sizeof(char) ); if( !strcmp(objType,"curve") ) { sprintf(idxStr,"%s%s,%s",option,obj,gn); res = Tcl_GetVar2(interp,"powCurveParam",idxStr,TCL_GLOBAL_ONLY); if( res==NULL ) { sprintf(idxStr,"%s,powDef",option); res = Tcl_GetVar2(interp,"powCurveParam",idxStr,TCL_GLOBAL_ONLY); } } else if( !strcmp(objType,"image") ) { sprintf(idxStr,"%s%s,%s",option,obj,gn); res = Tcl_GetVar2(interp,"powImageParam",idxStr,TCL_GLOBAL_ONLY); if( res==NULL ) { sprintf(idxStr,"%s,powDef",option); res = Tcl_GetVar2(interp,"powImageParam",idxStr,TCL_GLOBAL_ONLY); } } else if( !strcmp(objType,"graph") ) { sprintf(idxStr,"%s%s,%s",option,obj,gn); res = Tcl_GetVar2(interp,"powPlotParam",idxStr,TCL_GLOBAL_ONLY); if( res==NULL ) { sprintf(idxStr,"%s,powDef",option); res = Tcl_GetVar2(interp,"powPlotParam",idxStr,TCL_GLOBAL_ONLY); } } ckfree(idxStr); return res; } int PowPosToPix( double xpos, double ypos, WCSdata *WCS, double *xpix, double *ypix ) { char powFitsHeader[14]="powFitsHeader"; char powFitsHeaderCnt[17]="powFitsHeaderCnt"; int i, relax, HDRcnt, ctrl, nreject=0, nwcs=0; const char *HDRstring; /* input */ int nelem; double pixcrd[NCOORD][4]; /* output */ double imgcrd[NCOORD][4], world[NCOORD][4]; double phi[NCOORD], theta[NCOORD]; int stat[NCOORD]; int statFix[NWCSFIX]; int coordSel; int useWCSInfo; const char *str = NULL; if ( WCS->graphName[0] != '\0' && strcmp(WCS->graphName, "NULL") != 0 ) { str = Tcl_GetVar2(interp,"useWCSInfo",WCS->graphName,TCL_GLOBAL_ONLY); } else if ( WCS->curveName[0] != '\0' && strcmp(WCS->curveName, "NULL") != 0 ) { str = Tcl_GetVar2(interp,"useWCSInfo",WCS->curveName,TCL_GLOBAL_ONLY); } /* str = Tcl_GetVar(interp,"useWCSInfo",TCL_GLOBAL_ONLY); */ if ( str != (char *)NULL ) { useWCSInfo = atoi(str); } else { useWCSInfo = 0; } /* useWCSInfo = 1; */ if ( useWCSInfo == 1 ) { /* using WCS information */ char errormsg[512]; Tcl_Obj *listObj; Tcl_Obj *wcsname[27]; int status; if ( WCS->haveWCSinfo == 0 ) { /* no wcs info yet */ if ( WCS->graphName[0] != '\0' && strcmp(WCS->graphName, "NULL") != 0 ) { HDRstring = Tcl_GetVar2(interp,powFitsHeader,WCS->graphName,TCL_GLOBAL_ONLY); HDRcnt = atoi(Tcl_GetVar2(interp,powFitsHeaderCnt,WCS->graphName,TCL_GLOBAL_ONLY)); } else if ( WCS->curveName[0] != '\0' && strcmp(WCS->curveName, "NULL") != 0 ) { HDRstring = Tcl_GetVar2(interp,powFitsHeader,WCS->curveName,TCL_GLOBAL_ONLY); HDRcnt = atoi(Tcl_GetVar2(interp,powFitsHeaderCnt,WCS->curveName,TCL_GLOBAL_ONLY)); } else { Tcl_SetResult(interp, "Can't construct WCS information." ,TCL_VOLATILE); Tcl_SetVar(interp,"powWCSTranslation", "1" ,TCL_GLOBAL_ONLY); return TCL_ERROR; } relax = WCSHDR_all; ctrl = 2; if (status = wcspih(HDRstring, HDRcnt, relax, ctrl, &nreject, &nwcs, &(WCS->wcs))) { sprintf (errormsg, "Couldn't construct WCS information: %s", WCSpih_Message[status]); Tcl_SetResult(interp, errormsg ,TCL_VOLATILE); Tcl_SetVar(interp,"powWCSTranslation", WCSpih_Message[status] ,TCL_GLOBAL_ONLY); return TCL_ERROR; } listObj = Tcl_NewObj(); for (i=0; iwcs[i].alt,-1); } /* This is just a debug statement */ /* powDebugDataPrint(HDRstring, HDRcnt, WCS, nwcs, WCS->graphName); */ Tcl_ListObjAppendElement( interp, listObj, Tcl_NewIntObj( nwcs ) ); Tcl_ListObjAppendElement( interp, listObj, Tcl_NewListObj(nwcs,wcsname) ); if ( WCS->graphName[0] != '\0' && strcmp(WCS->graphName, "NULL") != 0 ) { Tcl_SetVar2Ex(interp,"powWCSList", WCS->graphName, listObj, TCL_GLOBAL_ONLY); } else if ( WCS->curveName[0] != '\0' && strcmp(WCS->curveName, "NULL") != 0 ) { Tcl_SetVar2Ex(interp,"powWCSList", WCS->curveName, listObj, TCL_GLOBAL_ONLY); } WCS->haveWCSinfo = 1; } if ( WCS->graphName[0] != '\0' && strcmp(WCS->graphName, "NULL") != 0 ) { coordSel = atoi(Tcl_GetVar2(interp,"powWCSName",WCS->graphName,TCL_GLOBAL_ONLY)); } else if ( WCS->curveName[0] != '\0' && strcmp(WCS->curveName, "NULL") != 0 ) { coordSel = atoi(Tcl_GetVar2(interp,"powWCSName",WCS->curveName,TCL_GLOBAL_ONLY)); } WCS->wcs[coordSel].crpix[0] = WCS->refPix[0]; WCS->wcs[coordSel].crpix[1] = WCS->refPix[1]; /* fprintf(stdout, "---PosToPix graphName: <%s>, coordSel: <%d>\n", WCS->graphName, coordSel); fflush(stdout); */ nelem = 2; world[0][0] = xpos; world[0][1] = ypos; world[0][2] = 1.f; world[0][3] = 1.f; status = 0; status = wcsfix(7, 0, &(WCS->wcs[coordSel]), statFix); status = wcss2p(&(WCS->wcs[coordSel]), NCOORD, nelem, world, phi, theta, imgcrd, pixcrd, stat); if ( status ) { sprintf (errormsg, "Couldn't translate WCS coords to pixels: %s", WCStrans_Message[status]); Tcl_SetResult( interp, errormsg, TCL_VOLATILE ); Tcl_SetVar(interp,"powWCSTranslation", WCStrans_Message[status] ,TCL_GLOBAL_ONLY); return TCL_ERROR; } else { *xpix = pixcrd[0][0]; *ypix = pixcrd[0][1]; Tcl_SetVar(interp,"powWCSTranslation","0",TCL_GLOBAL_ONLY); } } else { xpos -= WCS->refVal[0]; ypos -= WCS->refVal[1]; *xpix = WCS->cdRvrs[0][0] * xpos + WCS->cdRvrs[0][1] * ypos; *ypix = WCS->cdRvrs[1][0] * xpos + WCS->cdRvrs[1][1] * ypos; Tcl_SetVar(interp,"powWCSTranslation","0",TCL_GLOBAL_ONLY); *xpix += WCS->refPix[0]; *ypix += WCS->refPix[1]; } return TCL_OK; } int PowPixToPos ( double xpix, double ypix, WCSdata *WCS, double *xpos, double *ypos ) { char powFitsHeader[14]="powFitsHeader"; char powFitsHeaderCnt[17]="powFitsHeaderCnt"; int i, relax, HDRcnt, ctrl, nreject=0, nwcs=0; const char *HDRstring; /* input */ int nelem; double pixcrd[NCOORD][4]; /* output */ double imgcrd[NCOORD][4], world[NCOORD][4]; double phi[NCOORD], theta[NCOORD]; int stat[NCOORD]; int statFix[NWCSFIX]; int coordSel; int useWCSInfo; const char *str = NULL; if ( WCS->graphName[0] != '\0' && strcmp(WCS->graphName, "NULL") != 0 ) { str = Tcl_GetVar2(interp,"useWCSInfo",WCS->graphName,TCL_GLOBAL_ONLY); } else if ( WCS->curveName[0] != '\0' && strcmp(WCS->curveName, "NULL") != 0 ) { str = Tcl_GetVar2(interp,"useWCSInfo",WCS->curveName,TCL_GLOBAL_ONLY); } if ( str != (char *)NULL ) { useWCSInfo = atoi(str); } else { useWCSInfo = 0; } /* useWCSInfo = 1; */ if ( useWCSInfo == 1 ) { /* using WCS information */ char errormsg[512]; Tcl_Obj *listObj; Tcl_Obj *wcsname[27]; int status; if ( WCS->haveWCSinfo == 0 ) { if ( WCS->graphName[0] != '\0' && strcmp(WCS->graphName, "NULL") != 0 ) { HDRstring = Tcl_GetVar2(interp,powFitsHeader,WCS->graphName,TCL_GLOBAL_ONLY); HDRcnt = atoi(Tcl_GetVar2(interp,powFitsHeaderCnt,WCS->graphName,TCL_GLOBAL_ONLY)); } else if ( WCS->curveName[0] != '\0' && strcmp(WCS->curveName, "NULL") != 0 ) { HDRstring = Tcl_GetVar2(interp,powFitsHeader,WCS->curveName,TCL_GLOBAL_ONLY); HDRcnt = atoi(Tcl_GetVar2(interp,powFitsHeaderCnt,WCS->curveName,TCL_GLOBAL_ONLY)); } else { Tcl_SetResult(interp, "Can't construct WCS information." ,TCL_VOLATILE); Tcl_SetVar(interp,"powWCSTranslation", "1" ,TCL_GLOBAL_ONLY); return TCL_ERROR; } relax = WCSHDR_all; ctrl = 2; if (status = wcspih(HDRstring, HDRcnt, relax, ctrl, &nreject, &nwcs, &(WCS->wcs))) { sprintf (errormsg, "Couldn't construct WCS information: %s", WCSpih_Message[status]); Tcl_SetResult(interp, errormsg ,TCL_VOLATILE); Tcl_SetVar(interp,"powWCSTranslation", WCSpih_Message[status] ,TCL_GLOBAL_ONLY); return TCL_ERROR; } listObj = Tcl_NewObj(); for (i=0; iwcs[i].alt,-1); } /* This is just a debug statement */ /* powDebugDataPrint(HDRstring, HDRcnt, WCS, nwcs, WCS->graphName); */ Tcl_ListObjAppendElement( interp, listObj, Tcl_NewIntObj( nwcs ) ); Tcl_ListObjAppendElement( interp, listObj, Tcl_NewListObj(nwcs,wcsname) ); if ( WCS->graphName[0] != '\0' && strcmp(WCS->graphName, "NULL") != 0 ) { Tcl_SetVar2Ex(interp,"powWCSList", WCS->graphName, listObj, TCL_GLOBAL_ONLY); } else if ( WCS->curveName[0] != '\0' && strcmp(WCS->curveName, "NULL") != 0 ) { Tcl_SetVar2Ex(interp,"powWCSList", WCS->curveName, listObj, TCL_GLOBAL_ONLY); } WCS->haveWCSinfo = 1; } if ( WCS->graphName[0] != '\0' && strcmp(WCS->graphName, "NULL") != 0 ) { coordSel = atoi(Tcl_GetVar2(interp,"powWCSName",WCS->graphName,TCL_GLOBAL_ONLY)); } else if ( WCS->curveName[0] != '\0' && strcmp(WCS->curveName, "NULL") != 0 ) { coordSel = atoi(Tcl_GetVar2(interp,"powWCSName",WCS->curveName,TCL_GLOBAL_ONLY)); } /* fprintf(stdout, "PixToPos graphName: <%s> coordSel: <%d>\n", WCS->graphName, coordSel); fprintf(stdout, " WCS->refPix[0]: <%20.15f> WCS->refPix[1]: <%20.15f>\n", WCS->refPix[0], WCS->refPix[1]); fflush(stdout); */ WCS->wcs[coordSel].crpix[0] = WCS->refPix[0]; WCS->wcs[coordSel].crpix[1] = WCS->refPix[1]; /* using WCS information */ nelem = 2; pixcrd[0][0] = xpix; pixcrd[0][1] = ypix; pixcrd[0][2] = 1.f; pixcrd[0][3] = 1.f; status = 0; status = wcsfix(7, 0, &(WCS->wcs[coordSel]), statFix); status = wcsp2s(&(WCS->wcs[coordSel]), NCOORD, nelem, pixcrd, imgcrd, phi, theta, world, stat); if ( status ) { sprintf (errormsg, "Couldn't translate pixels to WCS coords: %s", WCStrans_Message[status]); Tcl_SetResult( interp, errormsg, TCL_VOLATILE ); Tcl_SetVar(interp,"powWCSTranslation", WCStrans_Message[status] ,TCL_GLOBAL_ONLY); return TCL_ERROR; } *xpos = world[0][0]; *ypos = world[0][1]; Tcl_SetVar(interp,"powWCSTranslation", "0" ,TCL_GLOBAL_ONLY); } else { xpix -= WCS->refPix[0]; ypix -= WCS->refPix[1]; *xpos = WCS->cdFrwd[0][0] * xpix + WCS->cdFrwd[0][1] * ypix; *ypos = WCS->cdFrwd[1][0] * xpix + WCS->cdFrwd[1][1] * ypix; *xpos += WCS->refVal[0]; *ypos += WCS->refVal[1]; Tcl_SetVar(interp,"powWCSTranslation", "0" ,TCL_GLOBAL_ONLY); } return TCL_OK; } /* Routine to determine whether a point is in the region */ int PowIsInRegion( double* pos , double *parReg, int nParReg, char *shape, int* status) /* The pos and parReg list should be converted to pow pixel before passing into this routine */ { char tmp_shape[10]; char *ptr; double x,y,k,b,x1,y1; int i; double *polygon_vertex; int result; *status = 0; ptr = tmp_shape; strcpy(tmp_shape,shape); while(*ptr != '\0') { *ptr = tolower(*ptr); ptr++; } if (!strcmp(tmp_shape,"point")) { if(nParReg != 2) { *status = 1; return 0; } if (pos[0]==parReg[0] && pos[1] == parReg[1]) return 1; else return 0; } if (!strcmp(tmp_shape,"line")) { if(nParReg != 4) { *status = 1; return 0; } x = parReg[2] >= parReg[0]?parReg[2]:parReg[0]; if (pos[0] > x) return 0; x = parReg[2] <= parReg[0]?parReg[2]:parReg[0]; if (pos[0] < x) return 0; y = parReg[3] >= parReg[1]?parReg[3]:parReg[1]; if (pos[0] > x) return 0; y = parReg[3] <= parReg[1]?parReg[3]:parReg[1]; if (pos[0] < x) return 0; if(parReg[2] != parReg[0]) { k = (parReg[3] - parReg[1])/(parReg[2] - parReg[0]); b = parReg[1] - k * parReg[0]; y = k*pos[0] + b; if ( pos[1] == y) return 1; else return 0; } else { if (pos[0] == parReg[0]) return 1; return 0; } } if (!strcmp(tmp_shape,"polygon")) { polygon_vertex = (double *)malloc((nParReg + 1) * sizeof (double)); for (i=0; i < nParReg; i++) { polygon_vertex[i] = parReg[i]; } result = Pt_in_Poly(pos[0], pos[1], nParReg, polygon_vertex); free (polygon_vertex); return result; } if (!strcmp(tmp_shape,"circle")) { if(nParReg != 3) { *status = 1; return 0; } b = (pos[0]-parReg[0])*(pos[0]-parReg[0])+ (pos[1]-parReg[1])*(pos[1]-parReg[1]); if (b <= parReg[2]*parReg[2]) return 1; return 0; } if (!strcmp(tmp_shape,"box")) { if(nParReg != 5) { *status = 1; return 0; } /* The width and height of the box is in pixels! Ugly! */ x = pos[0] - parReg[0]; y = pos[1] - parReg[1]; b = parReg[4]/180.0*3.1415926; x1 = x*cos(b) + y * sin(b); y1 = -x*sin(b) + y* cos(b); if ( x1 >= parReg[2]/-2.0 && x1 <= parReg[2]/2.0 && y1 >= parReg[3]/-2.0 && y1 <= parReg[3]/2.0 ) return 1; return 0; } if (!strcmp(tmp_shape,"ellipse")) { if(nParReg != 5) { *status = 1; return 0; } x = pos[0] - parReg[0]; y = pos[1] - parReg[1]; b = parReg[4]/180.0*3.1415926; x1 = x*cos(b) + y * sin(b); y1 = -x*sin(b) + y* cos(b); k = x1*x1/parReg[2]/parReg[2] + y1*y1/parReg[3]/parReg[3]; if (k <= 1.0) return 1; return 0; } *status = 3; return 0; } /* Caculate statistics inside the region */ int PowCalRegion( PowImage* image_ptr, char *regionFile, int *rect, double *parReg, int nParReg, char *shape, char *sign, double* cent, double* cstd, double* flux, double* npix, double* mean, double* dmean, int* status) /* The pos and parReg list should be converted to sao pixel before passing into this routine */ { int i, j; double datum; double sx,sy; double sx1,sy1; double sx2,sy2; double sxx,syy; double flux2; int flag; int ix,iy; int regionInputFile; double pos[2]; double absflux; int statusN = 0; /* status must always be initialized = 0 */ SAORegion *Rgn; int xmin,ymin,xmax,ymax, signflag; regionInputFile = 0; if (strcmp(regionFile,"NONE") != 0) { fits_read_rgnfile(regionFile, 0, &Rgn, &statusN); regionInputFile = 1; if ( statusN ) { Tcl_SetResult( interp, "Could not read region file.\n", TCL_VOLATILE ); return TCL_ERROR; } } *npix = 0; if(strchr(sign,'+')!= NULL) { signflag = 1; xmin = rect[0]; ymin = rect[1]; xmax = rect[2]; ymax = rect[3]; } else { signflag = 0; xmin = 1; ymin = 1; xmax = image_ptr->width; ymax = image_ptr->height; } if ( regionInputFile == 1 ) { signflag = 0; xmin = 1; ymin = 1; xmax = image_ptr->width; ymax = image_ptr->height; } *flux = 0.0; flux2 = 0.0; absflux = 0.0; sx = 0.0; sy = 0.0; sxx = 0.0; syy = 0.0; sx1 = 0.0; sy1 = 0.0; sx2 = 0.0; sy2 = 0.0; cent[0] = 0.0; cent[1] = 0.0; if ( regionInputFile == 1 ) { for (j = ymin; j <= ymax; j++) { pos[1] = (double)j; iy = (int)(pos[1] - 1 + image_ptr->yoffset); for (i = xmin; i <= xmax; i++) { pos[0] = (double)i ; ix = (int)(pos[0] - 1 + image_ptr->xoffset); flag = fits_in_region(i, j, Rgn); *status = 0; if (flag) { datum = PowExtractDatum(image_ptr->dataptr, iy * image_ptr->width + ix); if ( datum==DBL_MAX ) { continue; } *flux += datum; flux2 += datum*datum; datum = datum >=0 ? datum : -datum; absflux += datum; sx += pos[0]*datum; sy += pos[1]*datum; sxx += pos[0]*pos[0]*datum; syy += pos[1]*pos[1]*datum; sx1 += pos[0]; sy1 += pos[1]; sx2 += pos[0]*pos[0]; sy2 += pos[1]*pos[1]; (*npix)++; } } } } else { for (j = ymin; j < ymax; j++) { pos[1] = (double)j; iy = (int)(pos[1] - 1 + image_ptr->yoffset); if (iy < 0 || iy >= image_ptr->height ) continue; for (i = xmin; i < xmax; i++) { pos[0] = (double)i ; ix = (int)(pos[0] - 1 + image_ptr->xoffset); if (ix < 0 || ix >= image_ptr->width ) continue; if(*status) *status = 0; flag = PowIsInRegion(pos,parReg,nParReg,shape,status); if (signflag && flag ) { datum = PowExtractDatum(image_ptr->dataptr, iy * image_ptr->width + ix); if ( datum==DBL_MAX ) { continue; } *flux += datum; flux2 += datum*datum; datum = datum >=0 ? datum : -datum; absflux += datum; sx += pos[0]*datum; sy += pos[1]*datum; sxx += pos[0]*pos[0]*datum; syy += pos[1]*pos[1]*datum; sx1 += pos[0]; sy1 += pos[1]; sx2 += pos[0]*pos[0]; sy2 += pos[1]*pos[1]; (*npix)++; } if (!signflag && !flag && *status == 0) { datum = PowExtractDatum(image_ptr->dataptr, ix * image_ptr->height + iy); if ( datum==DBL_MAX ) { continue; } *flux += datum; flux2 += datum*datum; datum = datum >=0 ? datum : -datum; absflux += datum; sx += pos[0]*datum; sy += pos[1]*datum; sxx += pos[0]*pos[0]*datum; syy += pos[1]*pos[1]*datum; sx1 += pos[0]; sy1 += pos[1]; sx2 += pos[0]*pos[0]; sy2 += pos[1]*pos[1]; (*npix)++; } } } } if (*npix == 0 ) { *status = 1; return 1; } if (absflux != 0.0) { cent[0] = sx/(absflux); cent[1] = sy/(absflux); cstd[0] = sqrt(fabs(sxx/(absflux) - cent[0]*cent[0])); cstd[1] = sqrt(fabs(syy/(absflux) - cent[1]*cent[1])); } else { cent[0] = sx1/(*npix); cent[1] = sy1/(*npix); cstd[0] = sqrt(fabs(sx2 - *npix*cent[0]*cent[0])/sqrt((*npix))); cstd[1] = sqrt(fabs(sy2 - *npix*cent[1]*cent[1])/sqrt((*npix))); } *mean = *flux/(*npix); if ( *npix==1 ) *dmean = 0.0; else *dmean = sqrt(flux2-*npix*(*mean)*(*mean))/sqrt((*npix-1)*(*npix)); return 0; } /*---------------------------------------------------------------------------*/ static int Pt_in_Poly( double x, double y, int nPts, double *Pts ) /* Internal routine for testing whether the coordinate x,y is within the */ /* polygon region traced out by the array Pts. */ /*---------------------------------------------------------------------------*/ { int i, j, flag=0; double prevX, prevY; double nextX, nextY; double dx, dy, Dy; nextX = Pts[nPts-2]; nextY = Pts[nPts-1]; for( i=0; iprevY && y>=nextY) || (yprevX && x>=nextX) ) continue; /* Check to see if x,y lies right on the segment */ if( x>=prevX || x>nextX ) { dy = y - prevY; Dy = nextY - prevY; if( fabs(Dy)<1e-10 ) { if( fabs(dy)<1e-10 ) return( 1 ); else continue; } dx = prevX + ( (nextX-prevX)/(Dy) ) * dy - x; if( dx < -1e-10 ) continue; if( dx < 1e-10 ) return( 1 ); } /* There is an intersection! Make sure it isn't a V point. */ if( y != prevY ) { flag = 1 - flag; } else { j = i+1; /* Point to Y component */ do { if( j>1 ) j -= 2; else j = nPts-1; } while( y == Pts[j] ); if( (nextY-y)*(y-Pts[j]) > 0 ) flag = 1-flag; } } return( flag ); } void powDebugDataPrint (char *header, int headerCnt, WCSdata *WCS, int nwcs, char *graphName) { int k = 0; int i; char currentStr[81]; char *ptr; ptr = header; fprintf(stdout, "graphName: <%s>, headerCnt: <%d>\n", graphName, headerCnt); fflush(stdout); for (i= 0; i< strlen(header); i+=80 ) { memset(currentStr, '\0', 81); strncpy(currentStr, ptr, 80); fprintf(stdout, "<%s>\n", currentStr); fflush(stdout); k++; ptr += 80; } fprintf(stdout, "final count: <%d>\n\nnumber of wcs: <%d>\nwcsname: ", k, nwcs ); fprintf(stdout, "wcsname: "); fflush(stdout); for (i= 0; i< nwcs; i++ ) { fprintf(stdout, "<%s>", WCS->wcs[i].alt); } fprintf(stdout, "\n"); fflush(stdout); } fv5.5/tcltk/pow/PowWCS.c0000644000220700000360000010767213224715127013752 0ustar birbylhea#include #include #include #include "pow.h" #define DEG2RAD 1.745329252e-2 #define NUM_WCS_TYPES 27 static char wcsProjections[NUM_WCS_TYPES][5] = {"-AZP", "-SZP", "-TAN", "-STG", "-SIN", "-ARC", "-ZPN", "-ZEA", "-AIR", "-CYP", "-CEA", "-CAR", "-MER", "-COP", "-COE", "-COD", "-COO", "-SFL", "-PAR", "-MOL", "-AIT", "-BON", "-PCO", "-TSC", "-CSC", "-QSC", "-HPX"}; void PowInitWCS( WCSdata *WCS, int n ) { int row, col; WCS->RaDecSwap = 0; WCS->nAxis = n; for( row=0; rowrefVal[row] = 0.0; WCS->refPix[row] = 0.0; for( col=0; colcdFrwd[row][col] = (row==col?1:0); WCS->cdRvrs[row][col] = (row==col?1:0); } } memset (WCS->type, '\0', 6); memset (WCS->graphName, '\0', 1024); memset (WCS->curveName, '\0', 1024); wcsini (1, n, WCS->graphName); WCS->haveWCSinfo = 0; } int FillinWCSStructure ( WCSdata *WCS ) { char powFitsHeader[14]="powFitsHeader"; char powFitsHeaderCnt[17]="powFitsHeaderCnt"; int i, relax, HDRcnt, ctrl, nreject=0, nwcs=0; const char *HDRstring; int status; int coordSel; Tcl_Obj *listObj; Tcl_Obj *wcsname[27]; /* no wcs info yet */ if ( WCS->graphName[0] != '\0' && strcmp(WCS->graphName, "NULL") != 0 ) { HDRstring = Tcl_GetVar2(interp,powFitsHeader,WCS->graphName,TCL_GLOBAL_ONLY); HDRcnt = atoi(Tcl_GetVar2(interp,powFitsHeaderCnt,WCS->graphName,TCL_GLOBAL_ONLY)); } else if ( WCS->curveName[0] != '\0' && strcmp(WCS->curveName, "NULL") != 0 ) { HDRstring = Tcl_GetVar2(interp,powFitsHeader,WCS->curveName,TCL_GLOBAL_ONLY); HDRcnt = atoi(Tcl_GetVar2(interp,powFitsHeaderCnt,WCS->curveName,TCL_GLOBAL_ONLY)); } else { Tcl_SetResult(interp, "Can't construct WCS information." ,TCL_VOLATILE); Tcl_SetVar(interp,"powWCSTranslation", "1" ,TCL_GLOBAL_ONLY); return TCL_ERROR; } relax = WCSHDR_all; ctrl = 2; if (status = wcspih(HDRstring, HDRcnt, relax, ctrl, &nreject, &nwcs, &(WCS->wcs))) { char errormsg[512]; sprintf(errormsg, "Can't construct WCS information: %s", WCSpih_Message[status]); Tcl_SetResult(interp, errormsg ,TCL_VOLATILE); Tcl_SetVar(interp,"powWCSTranslation", WCSpih_Message[status] ,TCL_GLOBAL_ONLY); return TCL_ERROR; } listObj = Tcl_NewObj(); for (i=0; iwcs[i].alt,-1); } Tcl_ListObjAppendElement( interp, listObj, Tcl_NewIntObj( nwcs ) ); Tcl_ListObjAppendElement( interp, listObj, Tcl_NewListObj(nwcs,wcsname) ); if ( WCS->graphName[0] != '\0' && strcmp(WCS->graphName, "NULL") != 0 ) { Tcl_SetVar2Ex(interp,"powWCSList", WCS->graphName, listObj, TCL_GLOBAL_ONLY); } else if ( WCS->curveName[0] != '\0' && strcmp(WCS->curveName, "NULL") != 0 ) { Tcl_SetVar2Ex(interp,"powWCSList", WCS->curveName, listObj, TCL_GLOBAL_ONLY); } if (nwcs > 0 ) { if ( WCS->graphName[0] != '\0' && strcmp(WCS->graphName, "NULL") != 0 ) { coordSel = atoi(Tcl_GetVar2(interp,"powWCSName",WCS->graphName,TCL_GLOBAL_ONLY)); } else if ( WCS->curveName[0] != '\0' && strcmp(WCS->curveName, "NULL") != 0 ) { coordSel = atoi(Tcl_GetVar2(interp,"powWCSName",WCS->curveName,TCL_GLOBAL_ONLY)); } WCS->wcs[coordSel].crpix[0] = WCS->refPix[0]; WCS->wcs[coordSel].crpix[1] = WCS->refPix[1]; } WCS->haveWCSinfo = 1; return TCL_OK; } int PowParseWCS( Tcl_Interp *interp, WCSdata *WCS, int argc, Tcl_Obj *const argv[] ) { /* Known coordinate types (from worldpos below) */ double xinc,yinc,rot; double refVal[MAX_WCS_DIMS],refPix[MAX_WCS_DIMS]; double cdFrwd[MAX_WCS_DIMS][MAX_WCS_DIMS],cdRvrs[MAX_WCS_DIMS][MAX_WCS_DIMS]; double norm; Tcl_Obj **listElems; int row, col, nElem, nDims, dim; char *type; int swap=0; PowInitWCS( WCS, MAX_WCS_DIMS ); if( argc>7 ) { Tcl_GetDoubleFromObj(interp,argv[0],refVal+0); Tcl_GetDoubleFromObj(interp,argv[1],refVal+1); Tcl_GetDoubleFromObj(interp,argv[2],refPix+0); Tcl_GetDoubleFromObj(interp,argv[3],refPix+1); Tcl_GetDoubleFromObj(interp,argv[4],&xinc); Tcl_GetDoubleFromObj(interp,argv[5],&yinc); Tcl_GetDoubleFromObj(interp,argv[6],&rot); type = Tcl_GetStringFromObj(argv[7],NULL); if( argc>8 ) Tcl_GetBooleanFromObj(interp,argv[8],&swap); cdFrwd[0][0] = xinc * cos( rot * DEG2RAD ); cdFrwd[0][1] = -yinc * sin( rot * DEG2RAD ); cdFrwd[1][0] = xinc * sin( rot * DEG2RAD ); cdFrwd[1][1] = yinc * cos( rot * DEG2RAD ); nDims = 2; } else { nDims = 1; Tcl_ListObjGetElements(interp,argv[0],&nElem,&listElems); if( nElem>MAX_WCS_DIMS ) nElem = MAX_WCS_DIMS; if( nDims < nElem ) nDims = nElem; for( row=0; rowMAX_WCS_DIMS ) nElem = MAX_WCS_DIMS; if( nDims < nElem ) nDims = nElem; for( row=0; rowMAX_WCS_DIMS ? MAX_WCS_DIMS : dim ); if( nDims < nElem ) nDims = nElem; for( row=0; rowRaDecSwap = swap; WCS->nAxis = nDims; if( *type && refVal[0]<0.0 ) refVal[0] += 360.0; for( row=0; rowrefVal[row] = refVal[row]; WCS->refPix[row] = refPix[row]; for( col=0; colcdFrwd[row][col] = cdFrwd[row][col]; WCS->cdRvrs[row][col] = cdRvrs[row][col]; } } if ( *type ) { strcpy(WCS->type,type); } /* PowDumpWCSstructure(WCS); */ return TCL_OK; } void PowDumpWCSstructure ( WCSdata *WCS ) { fprintf(stdout, "**********************************\n"); fprintf(stdout, "WCS->graphName : <%s>\n", WCS->graphName); fprintf(stdout, "WCS->curveName : <%s>\n", WCS->curveName); fprintf(stdout, "WCS->type : <%s>\n", WCS->type); fprintf(stdout, "WCS->RaDecSwap : <%d>\n", WCS->RaDecSwap); fprintf(stdout, "WCS->nAxis : <%d>\n", WCS->nAxis); fprintf(stdout, "WCS->refVal[0] : <%20.15f>\n", WCS->refVal[0]); fprintf(stdout, "WCS->refVal[1] : <%20.15f>\n", WCS->refVal[1]); fprintf(stdout, "WCS->refPix[0] : <%20.15f>\n", WCS->refPix[0]); fprintf(stdout, "WCS->refPix[1] : <%20.15f>\n", WCS->refPix[1]); fprintf(stdout, "WCS->cdFrwd[0] : <%20.15f,%20.15f>\n", WCS->cdFrwd[0][0], WCS->cdFrwd[0][1]); fprintf(stdout, "WCS->cdFrwd[1] : <%20.15f,%20.15f>\n", WCS->cdFrwd[1][0], WCS->cdFrwd[1][1]); fprintf(stdout, "WCS->cdRvrs[0] : <%20.15f,%20.15f>\n", WCS->cdRvrs[0][0], WCS->cdRvrs[0][1]); fprintf(stdout, "WCS->cdRvrs[1] : <%20.15f,%20.15f>\n", WCS->cdRvrs[1][0], WCS->cdRvrs[1][1]); fprintf(stdout, "WCS->rot : <%20.15f>\n", WCS->rot); fprintf(stdout, "WCS->haveWCSinfo: <%d>\n", WCS->haveWCSinfo); fprintf(stdout, "**********************************\n"); fflush(stdout); } int PowWCSInitImage( ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const argv[] ) { /* Fills in the origin, increment, and otherend fields in the specified image using the WCS info provided. This is mainly used by powCreateImage and by the callback proc for the trace on powWCS */ double xpos,ypos; char *imageName; PowImage *image_ptr; int n; if( argc < 6 || argc > 11 ) { Tcl_SetResult( interp, "usage: powWCSInitImage image xref yref xrefpix " "yrefpix xinc yinc rot type ?swap?\n" " or: powWCSInitImage image {refVal} {refPix} " "{matrix} {type} {proj}", TCL_VOLATILE ); return TCL_ERROR; } imageName = Tcl_GetStringFromObj(argv[1],NULL); image_ptr = PowFindImage( imageName ); if (image_ptr == (PowImage *) NULL) { Tcl_SetResult( interp, "Couldn't find image.", TCL_VOLATILE ); return TCL_ERROR; } PowParseWCS(interp, &image_ptr->WCS, argc-2, argv+2); /* add image name to WCS structure */ strcpy (image_ptr->WCS.graphName, imageName); image_ptr->WCS.haveWCSinfo = 0; for( n=0; nWCS.nAxis; ) { image_ptr->WCS.refPix[n++]--; /* Makes pixels zero-indexed */ } if( !image_ptr->WCS.type[0]) { /* Tcl_SetVar2(interp,"powWCS",imageName,"",TCL_GLOBAL_ONLY); */ } /* image_ptr->WCS.xref = (swap?yref:xref); image_ptr->WCS.yref = (swap?xref:yref); image_ptr->WCS.xrefpix = xrefpix - 1; image_ptr->WCS.yrefpix = yrefpix - 1; image_ptr->WCS.xinc = xinc; image_ptr->WCS.yinc = (swap?-yinc:yinc); image_ptr->WCS.rot = (swap?90-rot:rot); */ if( PowPixToPos( -0.5, -0.5, &image_ptr->WCS, &xpos, &ypos ) ) { Tcl_SetResult( interp, "Couldn't translate pixels to WCS coords for image " "initialization", TCL_VOLATILE ); return TCL_ERROR; } image_ptr->xorigin = xpos; image_ptr->yorigin = ypos; if( PowPixToPos( image_ptr->width-0.5, image_ptr->height-0.5, &image_ptr->WCS, &xpos, &ypos ) ) { Tcl_SetResult( interp, "Couldn't translate pixels to WCS coords for " "image initialization", TCL_VOLATILE ); return TCL_ERROR; } image_ptr->xotherend = xpos; image_ptr->yotherend = ypos; image_ptr->xinc = ( xpos - image_ptr->xorigin ) / image_ptr->width; image_ptr->yinc = ( ypos - image_ptr->yorigin ) / image_ptr->height; return TCL_OK; } int PowWCSInitCurve(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const argv[]) { /* Fills in the WCS structure if info exists. This is mainly used by powCreateCurve and by the callback proc for the trace on powWCS */ PowCurve *curve_ptr; char *curveName; int str_len; char *p; if( argc < 7 || argc > 11 ) { Tcl_SetResult( interp, "usage: powWCSInitCurve curve xref yref xrefpix " "yrefpix xinc yinc rot type ?swap?\n" " or: powWCSInitCurve curve {refVal} {refPix} " "{matrix} {type} {proj}", TCL_VOLATILE ); return TCL_ERROR; } curveName = Tcl_GetStringFromObj( argv[1], NULL ); curve_ptr = PowFindCurve( curveName ); if (curve_ptr == (PowCurve *) NULL) { Tcl_SetResult( interp, "Couldn't find curve.", TCL_VOLATILE ); return TCL_ERROR; } PowParseWCS( interp, &curve_ptr->WCS, argc-2, argv+2 ); /* add curve name to WCS structure */ strcpy (curve_ptr->WCS.curveName, curveName); p = strstr(curveName, "_contour"); if ( p != (char *)NULL ) { /* input is contour curve, grab its graph handler */ str_len = strlen(curve_ptr->WCS.curveName) - strlen(p); strncpy(curve_ptr->WCS.graphName, curve_ptr->WCS.curveName, str_len); curve_ptr->WCS.graphName[str_len] = '\0'; } if ( curve_ptr->WCS.type[0] == '\0' ) { /* for some reason, this has to be done for Windows. */ /* curve_ptr->WCS.refPix[0] = 0.0; curve_ptr->WCS.refPix[1] = 0.0; */ } FillinWCSStructure(&curve_ptr->WCS); if ( curve_ptr->WCS.type[0] == '\0' ) { const char *WCSstring; WCSstring = Tcl_GetVar2(interp, "powWCS", curveName,TCL_GLOBAL_ONLY); /* Tcl_SetVar2(interp,"powWCS", curveName, "", TCL_GLOBAL_ONLY); */ } return TCL_OK; } int PowWCSInitGraph( PowGraph *graph, char *curves, char *images, int x_points_right, int y_points_up) { PowCurve *current_curve; PowImage *current_image; int index,Argc; const char **Argv; char *p; graph->WCS.type[0] = '\0'; graph->xoff = 0.0; graph->yoff = 0.0; if(images != NULL && strstr(images,"NULL") == NULL ) { if(Tcl_SplitList(interp,images,&Argc,&Argv) != TCL_OK) { return TCL_ERROR; } for( index=0; indexWCS.type[0] ) { graph->WCS = current_image->WCS; ckfree( (char *)Argv ); return TCL_OK; } } /* Failed to find a WCS image. Grab first image's WCS structure anyway... It could still contain linear scaling. */ graph->WCS = PowFindImage( Argv[0] )->WCS; /* wcsini (1, 2, graph->WCS.wcs); */ p = strstr (images, "imgobj_"); if ( p != (char *)NULL ) { p += strlen("imgobj_"); strcpy(graph->WCS.graphName, p); } else { strcpy(graph->WCS.graphName, images); } strcpy(graph->WCS.curveName, "\0"); ckfree( (char *)Argv ); return TCL_OK; } if(curves != NULL && strstr(curves,"NULL") == NULL ) { if(Tcl_SplitList(interp,curves,&Argc,&Argv) != TCL_OK) { return TCL_ERROR; } for( index=0; indexWCS.type[0] ) { graph->WCS = current_curve->WCS; strcpy(graph->WCS.graphName, "\0"); strcpy(graph->WCS.curveName, curves); ckfree( (char *)Argv ); return TCL_OK; } } ckfree( (char *)Argv ); } PowInitWCS( &graph->WCS, 2 ); if( !x_points_right ) { graph->WCS.cdFrwd[0][0] = -1.0; } if( !y_points_up ) { graph->WCS.cdFrwd[1][1] = -1.0; } return TCL_OK; } int PowXYPx(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const argv[]) { /* Calls the pow_xypx WCS routine, returns list of 2 image pixels*/ double xpix,ypix,xpos,ypos; Tcl_Obj *res[2]; WCSdata WCS; if(argc < 11 ) { Tcl_SetResult( interp, "usage: powXYPx xpos ypos xref yref xrefpix yrefpix " "xinc yinc rot type", TCL_VOLATILE ); return TCL_ERROR; } Tcl_GetDoubleFromObj(interp,argv[1],&xpos); Tcl_GetDoubleFromObj(interp,argv[2],&ypos); PowParseWCS( interp, &WCS, argc-3, argv+3 ); if( PowPosToPix(xpos,ypos,&WCS,&xpix,&ypix) != 0 ) { Tcl_SetResult( interp, "Couldn't translate WCS coords to pixels", TCL_VOLATILE ); return TCL_ERROR; } res[0] = Tcl_NewDoubleObj( xpix ); res[1] = Tcl_NewDoubleObj( ypix ); Tcl_SetObjResult(interp, Tcl_NewListObj(2, res) ); return TCL_OK; } int PowWorldPos(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const argv[]) { /* Calls the pow_worldpos WCS routine, returns list of 2 graph coords*/ double xpix,ypix,xpos,ypos; Tcl_Obj *res[2]; WCSdata WCS; if(argc < 11 ) { Tcl_SetResult( interp, "usage: powWorldPos xpix ypix xref yref xrefpix " "yrefpix xinc yinc rot type", TCL_VOLATILE ); return TCL_ERROR; } Tcl_GetDoubleFromObj(interp,argv[1],&xpix); Tcl_GetDoubleFromObj(interp,argv[2],&ypix); PowParseWCS( interp, &WCS, argc-3, argv+3 ); if( PowPixToPos(xpix,ypix,&WCS,&xpos,&ypos) != 0 ) { Tcl_SetResult( interp, "Couldn't translate pixels to WCS coords", TCL_VOLATILE ); return TCL_ERROR; } res[0] = Tcl_NewDoubleObj( xpos ); res[1] = Tcl_NewDoubleObj( ypos ); Tcl_SetObjResult(interp, Tcl_NewListObj(2, res) ); return TCL_OK; } /*--------------------------------------------------------------------------*/ int pow_worldpos(double xpix, double ypix, double refVal[], double refPix[], double matrix[][MAX_WCS_DIMS], char *type, double *xpos, double *ypos) /* PDW 03/00: Add -CAR projection support */ /* PDW 02/00: Change interface to use more general matrix/vector notation */ /* LEB 11/97: change the name of the routine from 'ffwldp' to 'pow_worldpos' rexmoved 'status' argument, convert to (0,0) based images to match POW convention. */ /* WDP 1/97: change the name of the routine from 'worldpos' to 'ffwldp' */ /* worldpos.c -- WCS Algorithms from Classic AIPS. Copyright (C) 1994 Associated Universities, Inc. Washington DC, USA. This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This library 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 Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this library; if not, write to the Free Software Foundation, Inc., 675 Massachusetts Ave, Cambridge, MA 02139, USA. Correspondence concerning AIPS should be addressed as follows: Internet email: aipsmail@nrao.edu Postal address: AIPS Group National Radio Astronomy Observatory 520 Edgemont Road Charlottesville, VA 22903-2475 USA -=-=-=-=-=-=- These two ANSI C functions, worldpos() and xypix(), perform forward and reverse WCS computations for 8 types of projective geometries ("-SIN", "-TAN", "-ARC", "-NCP", "-GLS", "-MER", "-AIT" and "-STG"): worldpos() converts from pixel location to RA,Dec xypix() converts from RA,Dec to pixel location where "(RA,Dec)" are more generically (long,lat). These functions are based on the WCS implementation of Classic AIPS, an implementation which has been in production use for more than ten years. See the two memos by Eric Greisen ftp://fits.cv.nrao.edu/fits/documents/wcs/aips27.ps.Z ftp://fits.cv.nrao.edu/fits/documents/wcs/aips46.ps.Z for descriptions of the 8 projective geometries and the algorithms. Footnotes in these two documents describe the differences between these algorithms and the 1993-94 WCS draft proposal (see URL below). In particular, these algorithms support ordinary field rotation, but not skew geometries (CD or PC matrix cases). Also, the MER and AIT algorithms work correctly only for CRVALi=(0,0). Users should note that GLS projections with yref!=0 will behave differently in this code than in the draft WCS proposal. The NCP projection is now obsolete (it is a special case of SIN). WCS syntax and semantics for various advanced features is discussed in the draft WCS proposal by Greisen and Calabretta at: ftp://fits.cv.nrao.edu/fits/documents/wcs/wcs.all.ps.Z -=-=-=- The original version of this code was Emailed to D.Wells on Friday, 23 September by Bill Cotton , who described it as a "..more or less.. exact translation from the AIPSish..". Changes were made by Don Wells during the period October 11-13, 1994: 1) added GNU license and header comments 2) added testpos.c program to perform extensive circularity tests 3) changed float-->double to get more than 7 significant figures 4) testpos.c circularity test failed on MER and AIT. B.Cotton found that "..there were a couple of lines of code [in] the wrong place as a result of merging several Fortran routines." 5) testpos.c found 0h wraparound in xypix() and worldpos(). 6) E.Greisen recommended removal of various redundant if-statements, and addition of a 360d difference test to MER case of worldpos(). */ /*-----------------------------------------------------------------------*/ /* routine to determine accurate position for pixel coordinates */ /* returns 0 if successful otherwise: */ /* 1 = angle too large for projection; */ /* (WDP 1/97: changed the return value to 501 instead of 1) */ /* does: -SIN, -TAN, -ARC, -NCP, -GLS, -MER, -AIT projections */ /* anything else is linear */ /* Input: */ /* f xpix x pixel number (RA or long without rotation) */ /* f ypiy y pixel number (dec or lat without rotation) */ /* d xref x reference coordinate value (deg) */ /* d yref y reference coordinate value (deg) */ /* f xrefpix x reference pixel */ /* f yrefpix y reference pixel */ /* f xinc x coordinate increment (deg) */ /* f yinc y coordinate increment (deg) */ /* f rot rotation (deg) (from N through E) */ /* c *type projection type code e.g. "-SIN"; */ /* Output: */ /* d *xpos x (RA) coordinate (deg) */ /* d *ypos y (dec) coordinate (deg) */ /*-----------------------------------------------------------------------*/ { double dx, dy, dz, x, y, z; double sins, coss, dect, rat, dt, l, m, mg, da, dd, cos0, sin0; double dec0, ra0; double geo1, geo2, geo3; double pi = 3.14159265358979323846; double cond2r= pi/180.0; double deps = 1.0e-5; int itype; /* Apply Transform Matrix */ dx = matrix[0][0] * (xpix-refPix[0]) + matrix[0][1] * (ypix-refPix[1]); dy = matrix[1][0] * (xpix-refPix[0]) + matrix[1][1] * (ypix-refPix[1]); /* find type */ /* WDP 1/97: removed support for default type for better error checking */ for( itype=0; itype1.0) return( 501); coss = sqrt (1.0 - sins); dt = sin0 * coss + cos0 * m; if ((dt>1.0) || (dt<-1.0)) return(501); dect = asin(dt); rat = cos0 * coss - sin0 * m; if ((rat==0.0) && (l==0.0)) return(501); rat = atan2(l, rat) + ra0; break; case 1: /* -TAN tan */ x = cos0*cos(ra0) - l*sin(ra0) - m*cos(ra0)*sin0; y = cos0*sin(ra0) + l*cos(ra0) - m*sin(ra0)*sin0; z = sin0 + m* cos0; rat = atan2( y, x ); dect = atan( z / sqrt(x*x+y*y) ); break; case 2: /* -ARC Arc*/ if (sins>=pi*pi) return(501); sins = sqrt(sins); coss = cos(sins); if (sins!=0.0) sins = sin(sins) / sins; else sins = 1.0; dt = m * cos0 * sins + sin0 * coss; if ((dt>1.0) || (dt<-1.0)) return(501); dect = asin(dt); da = coss - dt * sin0; dt = l * sins * cos0; if ((da==0.0) && (dt==0.0)) return(501); rat = ra0 + atan2(dt, da); break; case 3: /* -NCP North celestial pole*/ dect = cos0 - m * sin0; if (dect==0.0) return(501); rat = ra0 + atan2(l, dect); dt = cos(rat-ra0); if (dt==0.0) return(501); dect = dect / dt; if ((dect>1.0) || (dect<-1.0)) return(501); dect = acos(dect); if (dec0<0.0) dect = -dect; break; case 4: /* -GLS global sinusoid */ dect = dec0 + m; if (fabs(dect)>pi/2.0) return(501); coss = cos(dect); if (fabs(l)>pi*coss) return(501); rat = ra0; if (coss>deps) rat = rat + l / coss; break; case 5: /* -MER mercator */ /* dt = yinc * cosr + xinc * sinr; */ /* Calculate the declination change for a (1,1) offset from refpix */ dt = matrix[1][0] + matrix[1][1]; if (dt==0.0) dt = 1.0; dy = (refVal[1]*0.5 + 45.0) * cond2r; dx = dy + dt / 2.0 * cond2r; dy = log (tan(dy)); dx = log (tan(dx)); geo2 = dt * cond2r / (dx - dy); geo3 = geo2 * dy; geo1 = cos(refVal[1]*cond2r); if (geo1<=0.0) geo1 = 1.0; rat = l / geo1 + ra0; if (fabs(rat - ra0) > pi+pi) return(501); dt = 0.0; if (geo2!=0.0) dt = (m + geo3) / geo2; dt = exp (dt); dect = 2.0 * atan(dt) - pi / 2.0; break; case 6: /* -AIT Aitoff */ /* dt = yinc * cosr + xinc * sinr; */ /* Calculate the declination change for a (1,1) offset from refpix */ dt = matrix[1][0] + matrix[1][1]; if (dt==0.0) dt = 1.0; dt = dt * cond2r; dy = dec0; dx = sin(dy+dt)/sqrt((1.0+cos(dy+dt))/2.0) - sin(dy)/sqrt((1.0+cos(dy))/2.0); if (dx==0.0) dx = 1.0; geo2 = dt / dx; /* Calculate the right ascension change for a (1,1) offset from refpix */ /* dt = xinc*cosr - yinc* sinr; */ dt = matrix[0][0] + matrix[0][1]; if (dt==0.0) dt = 1.0; dt = dt * cond2r; dx = 2.0 * cos(dy) * sin(dt/2.0); if (dx==0.0) dx = 1.0; geo1 = dt * sqrt((1.0+cos(dy)*cos(dt/2.0))/2.0) / dx; geo3 = geo2 * sin(dy) / sqrt((1.0+cos(dy))/2.0); rat = ra0; dect = dec0; if ((l==0.0) && (m==0.0)) break; dz = 4.0 - l*l/(4.0*geo1*geo1) - ((m+geo3)/geo2)*((m+geo3)/geo2); if ((dz>4.0) || (dz<2.0)) return(501); dz = 0.5 * sqrt (dz); dd = (m+geo3) * dz / geo2; if (fabs(dd)>1.0) return(501); dd = asin(dd); if (fabs(cos(dd))1.0) return(501); da = asin(da); rat = ra0 + 2.0 * da; dect = dd; break; case 7: /* -STG Sterographic*/ dz = (4.0 - sins) / (4.0 + sins); if (fabs(dz)>1.0) return(501); dect = dz * sin0 + m * cos0 * (1.0+dz) / 2.0; if (fabs(dect)>1.0) return(501); dect = asin(dect); rat = cos(dect); if (fabs(rat)1.0) return(501); rat = asin(rat); mg = 1.0 + sin(dect) * sin0 + cos(dect) * cos0 * cos(rat); if (fabs(mg)deps) rat = pi - rat; rat = ra0 + rat; break; case 8: /* -CAR Cartesian */ rat = ra0 + l; dect = dec0 + m; /* Should do some sperical wrapping, but can't get it to work, yet if( dect > 0.5*pi ) { dect = pi - dect; rat += pi; } if( dect < -0.5*pi ) { dect = -pi - dect; rat += pi; } */ break; default: /* fall through to here on error */ return(504); } /* return ra in range */ /* Oh let's not. LEB */ /* if (rat-ra0> pi) rat -= pi + pi; if (rat-ra0<-pi) rat += pi + pi; if (rat < 0.0) rat += pi + pi; // added by DCW 10/12/94 */ /* correct units back to degrees */ *xpos = rat / cond2r; *ypos = dect / cond2r; /* Do bounds check in degree space since values are exact */ if ( *xpos < 0.0 ) *xpos += 360.0; else if( *xpos >= 360.0 ) *xpos -= 360.0; return 0; } /* End of worldpos */ /*--------------------------------------------------------------------------*/ int pow_xypx(double xpos, double ypos, double refVal[], double refPix[], double matrixF[][MAX_WCS_DIMS], double matrixR[][MAX_WCS_DIMS], char *type, double *xpix, double *ypix) /* PDW 03/00: Add -CAR projection support */ /* PDW 02/00: Change interface to use more general matrix/vector notation */ /* LEB 11/97: change the name of the routine from 'ffxypx' to 'pow_xypx' removed 'status' argument, convert to (0,0) based images to match POW convention. */ /* WDP 1/97: changed name of routine from xypix to ffxypx */ /*-----------------------------------------------------------------------*/ /* routine to determine accurate pixel coordinates for an RA and Dec */ /* returns 0 if successful otherwise: */ /* 1 = angle too large for projection; */ /* 2 = bad values */ /* WDP 1/97: changed the return values to 501 and 502 instead of 1 and 2 */ /* does: -SIN, -TAN, -ARC, -NCP, -GLS, -MER, -AIT projections */ /* anything else is linear */ /* Input: */ /* d xpos x (RA) coordinate (deg) */ /* d ypos y (dec) coordinate (deg) */ /* d xref x reference coordinate value (deg) */ /* d yref y reference coordinate value (deg) */ /* f xrefpix x reference pixel */ /* f yrefpix y reference pixel */ /* f xinc x coordinate increment (deg) */ /* f yinc y coordinate increment (deg) */ /* f rot rotation (deg) (from N through E) */ /* c *type projection type code e.g. "-SIN"; */ /* Output: */ /* f *xpix x pixel number (RA or long without rotation) */ /* f *ypiy y pixel number (dec or lat without rotation) */ /*-----------------------------------------------------------------------*/ { double dx, dy, ra0, dec0, ra, dec, coss, sins, dt, da, dd, sint; double cos0, sin0, dRA; double l, m, geo1, geo2, geo3; double deps=1.0e-5; double pi = 3.14159265358979323846; double cond2r= pi/180.0; int itype; /* find type */ /* WDP 1/97: removed support for default type for better error checking */ for( itype=0; itype pi ) dRA -= pi + pi; else if( dRA <= -pi ) dRA += pi + pi; /* compute direction cosine */ coss = cos(dec); sins = sin(dec); cos0 = cos(dec0); sin0 = sin(dec0); l = sin(dRA) * coss; sint = sins * sin0 + coss * cos0 * cos(dRA); /* process by case */ switch (itype) { case 0: /* -SIN sin*/ if (sint<0.0) return(501); m = sins * cos(dec0) - coss * sin(dec0) * cos(dRA); break; case 1: /* -TAN tan */ if (sint<=0.0) return(501); if( cos0<0.001 ) { /* Do a first order expansion around pole */ m = (coss * cos(dRA)) / (sins * sin0); m = (-m + cos0 * (1.0 + m*m)) / sin0; } else { m = ( sins/sint - sin0 ) / cos0; } if( fabs(sin(ra0)) < 0.3 ) { l = coss*sin(ra)/sint - cos0*sin(ra0) + m*sin(ra0)*sin0; l /= cos(ra0); } else { l = coss*cos(ra)/sint - cos0*cos(ra0) + m*cos(ra0)*sin0; l /= -sin(ra0); } break; case 2: /* -ARC Arc*/ m = sins * sin(dec0) + coss * cos(dec0) * cos(dRA); if (m<-1.0) m = -1.0; if (m>1.0) m = 1.0; m = acos(m); if (m!=0) m = m / sin(m); else m = 1.0; l = l * m; m = (sins * cos(dec0) - coss * sin(dec0) * cos(dRA)) * m; break; case 3: /* -NCP North celestial pole*/ if (dec0==0.0) return(501); /* can't stand the equator */ else m = (cos(dec0) - coss * cos(dRA)) / sin(dec0); break; case 4: /* -GLS global sinusoid */ if (fabs(dec) >pi*0.5) return(501); if (fabs(dec0)>pi*0.5) return(501); m = dec - dec0; l = dRA * coss; break; case 5: /* -MER mercator */ /* dt = yinc * cosr + xinc * sinr; */ /* Calculate the declination change for a (1,1) offset from refpix */ dt = matrixF[1][0] + matrixF[1][1]; if (dt==0.0) dt = 1.0; dy = (dec0 + 90.0 * cond2r) * 0.5; dx = dy + (dt * 0.5) * cond2r; dy = log (tan(dy)); dx = log (tan(dx)); geo2 = dt * cond2r / (dx - dy); geo3 = geo2 * dy; l = dRA * cos(dec0); dt = dec * 0.5 + pi * 0.25; dt = tan(dt); if (dtpi) return(501); /* Calculate the declination change for a (1,1) offset from refpix */ /* dt = yinc * cosr + xinc * sinr; */ dt = matrixF[1][0] + matrixF[1][1]; if (dt==0.0) dt = 1.0; dt = dt * cond2r; dy = dec0; dx = sin(dy+dt)/sqrt((1.0+cos(dy+dt))/2.0) - sin(dy)/sqrt((1.0+cos(dy))/2.0); if (dx==0.0) dx = 1.0; geo2 = dt / dx; /* Calculate the RA change for a (1,1) offset from refpix */ /* dt = xinc*cosr - yinc* sinr; */ dt = matrixF[0][0] + matrixF[0][1]; if (dt==0.0) dt = 1.0; dt = dt * cond2r; dx = 2.0 * cos(dy) * sin(dt/2.0); if (dx==0.0) dx = 1.0; geo1 = dt * sqrt((1.0+cos(dy)*cos(dt/2.0))/2.0) / dx; geo3 = geo2 * sin(dy) / sqrt((1.0+cos(dy))/2.0); dt = sqrt ((1.0 + cos(dec) * cos(da))/2.0); if (fabs(dt)0.5*pi) return(501); dd = 1.0 + sins * sin(dec0) + coss * cos(dec0) * cos(dRA); if (fabs(dd) The POW Print Control

    The POW Print Control

    When Print button is selected, POW will create a preview image of the entire POW main image screen. There are several button choices available on the top the preview window:

  • Print: Brings up the print dialog window (see Print Dialog)
  • Fit to Page (or Original Size): Zoom the image to fit the desire paper size or unzoom the image back to original fize
  • Page Setup: Bring up the output page setup window (see Page Setup)

    Print Dialog

    Select the destination of output

    Printer

      Printer Command: specify the command to send the image to printer. In Windows, this field is been updated with WinPrint.exe package that came with the installation.

    File

      File Name: specify the output file name of the saved image. The extension of the file will change via the selection from the pull down menu next to the word format:

      format: specify the format of the file of the saved image. The extension in the file name will change via the selection from pull down menu

      Directory: specify the destination directory for the image file to be saved. User can type in the directory or use Browse button to bring up a directory nagivation window to choose the destination directory.

      Print/Save Range: specify the range of pages to be saved or print. Choices are All pages, Current Page, or Page No.

    Note: if selection is File and there are more than one page to be saved, the files will be saved in manner of

      <File Name>_0.<format extension>,
      <File Name>_1.<format extension>,
      <File Name>_2.<format extension>, etc.
    Page Setup

    Select the paper type as well as orientation of the image on the paper.

      Paper Size: Select from the pull down menu of available paper size to output.
      Orientation Size: Select either Portrait or LandScape orientation of image on the output.
      Placement: determine way of output. Choices are
      • Fit on one page: Fit every image/plot into one page.
      • Best Fit on multiple pages: Allow system to determine the best way to fit images/plots onto muliple pages. This is a good choice if the user is concerning about saving paper.
      • One graph per page: Just output one image/plot per pages.
    fv5.5/tcltk/pow/Probe.html0000644000220700000360000000572113224715127014411 0ustar birbylhea Image probe

    Image Probe

    Overview

    Given a probe, this tool calculates the its centroid coordinates and region statistics such as total number of pixels, total sum of the pixel values (flux) and mean pixel value (mean flux). When the image probe dialog box is open, POW is in the "probe" mode. To go back to the normal mode, user can just simply press the Exit button and return to the normal mode.

    Creating and manipulating probe

    A probe basically is a region. Its shape can be selected by clicking the Probe Shape button. The available shapes are Circle, Box, Ellipse, and Polygon. To create a new probe, place the mouse at the desired location in the graph and click-and-drag with the right mouse button down (Command-Click on Mac-OS). For Circle and Ellipses, the initial mouse location is the center of the probe and the final location is its radius or width and/or height. For Boxes, the mouse movements traces out opposite corner of the rectangle. For Polygon, the mouse locations determines its verteces. To add extra segments to the Polygon, let up on the mouse button, press it again without moving, and drag it to the next vertex.

    To move a probe, simply put cursor inside the probe, and click-and- drag it to the new position with the left mouse. The left mouse is also used for changing and rotating probe. To change the shape, click- and-drag the "change" handle (a small green box) on the probe. To rotate the probe, click-and-drag the "rotation" handle (a small green triangle). The rotation only applies to the shape of ellipse and box.

    For details of creating and manipulating the probe, please refer to the Regions help file.

    Calculating the coordinates of centroid and statistics

    Whenever the probe is created, changed, moved or rotated, the coordinates of centroid and statistics are calculated and shown in the Image Probe dialog box.

    The coordinates of centroid are presented in two ways, in pixel in the Pixel field, and in the graphical coordinate in the Coordinate field. The format of graphical coordinate is either in decimal or hms, determined by the Coord. Format button.

    The statistics of a probe includes total number of pixels ( the N Pixels field), total flux (the Total Flux field) and mean flux (the Mean Flux field). The mean flux is defined as the average flux per pixel inside the probe.

    Saving the coordinates of centroid and statistics

    To save the coordinates of centroid and statistics of current probe to a disk log file, click the Record button. For the first recording or after closing the current log file, you have chance to enter the log file name through a opened file dialog box. To close the current log file, press the Close Log button.

    fv5.5/tcltk/pow/Profile.html0000644000220700000360000000351013224715127014734 0ustar birbylhea Drawing Profile

    Drawing Profile

    Overview

    The Profile tool can display the cross-section of pixel intensity values (the "Profile") along any line (baseline) across an image. When the profile dialog box is open, POW is in the "profile" mode. In this mode, the user can create, move, rotate, and stretch the baseline with the mouse, and the corresponding "Profile" plot is displayed in the separate panel. The coordinates of the starting and stopping points of the profile are also displayed in the dialog box.

    Creating profile

    The Baseline can be drawn on the image by placing the mouse at the desired starting location and click-and-drag with the right mouse button held down to the end location. When the mouse button is released, a "profile" plot will appear in the separate panel.

    Manipulating profile

    The position of the current profile can be manipulated using the mouse by grabbing and moving either of the end point handles, or the baseline itself.

    To rotate and stretch the baseline, position the mouse over the endpoint you want to move. Press either mouse button, drag it to the desired new position, and release it. The profile plot will be updated.

    To move the whole baseline, position the mouse over any part of the baseline except two ends. Press the left mouse button, drag it to the new position, and release it. The profile plot will be updated.

    Saving profile

    By clicking the "Record" button on the dialog box, one can save the coordinates of the profile plot to an ASCII text file. The data in the saved file contains 4 elements per line: the X and Y graph coordinates of each point, the Pixel Index number (starting with 1), and the intensity value of the image at that position.

    fv5.5/tcltk/pow/ROI.html0000644000220700000360000000401113224715127013762 0ustar birbylhea Pow ROI Zooming

    Pow ROI Zooming

    To look more closely at a section of a graph, you need to pick a region of interest (ROI) for that graph. The current region of interest is shown by a blue box in the scope window. If there is no blue box, the ROI is an area large enough to display all of the elements (curves and images) of the selected graph and coincides with the enclosing black box in the scope.

    There are four ways to change your region of interest:

      Right click (Command-click on MacOS) and drag in the scope to create a new ROI.
      Left clicking and dragging in the scope will "drag" the current ROI box. The main graph will be replotted using the new ROI when you release the left mouse button.
      Use the Zoom option buttons (see Zoom).
      Right click (Command-click on MacOS) and drag in the main POW window.
    If the ROI does not overlap the current graph (ie, you are dragging out an ROI on an unselected graph), the ROI selection will be applied to the top graph overlapping the ROI. If the ROI does not overlap any graph, the ROI will be applied to the current graph.

    Right double click (Command-double click on MacOS) in the main POW window or scope window. This will replot the graph and undo any previous zooming.

    Zoom Option

    Allow user to zoom in/out on the image/plot.

      Zoom in (2x): Zoom in on the current perspective of the image by factor of 2.
      Zoom out (2x): Zoom out on the current perspective of the image by factor of 2.
      Zoom in 1x (2x, 4x, 8x, 16x, 32x): Zoom in on the original image size by factor of 1 (2, 4, 8, 16 or 32).
      Invert X Axis: Flip the image on its X axis.
      Invert Y Axis: Flip the image on its Y axis.
      Invert Both: Flip the image on its X and Y axis.
      Undo Invert: Un-flip the image.
    fv5.5/tcltk/pow/Region.tcl0000644000220700000360000004765613224715127014420 0ustar birbylhea######################################################################## # # class: Region superclass: Shape # # purpose: Assign a shape to a graph and perform coordinate transforms # between SAO region descriptions and the canvas. # # usage: Create a new region normally through the RegionList class # which allows the user to draw regions using the mouse. # # To create a region programmaticly: # set rgn [gRegion graph canvas] # Once created, the region's graph and canvas cannot be # changed. The essential parameters for a region are its # sign, geometric shape, shape descriptor, and rotation. # Set these individually using Shape's setShape and # setRotation and Region's setGraphCoords and setSign. Or, # if you have the SAO representation in a list, use # setFunction. # # To obtain the coords of a region, use "getGraphCoords" for # a list of points on the graph making up the shape. Typically # the format is "X0 Y0 X1 Y1" where (X0,Y0) is the object center # and (X1,Y1) is a corner point. Rotation is obtained separately # through "getRotation". Use "getFunction" to get the SAO # region parameters... center, width, rotation. # # The user can move and resize a region. When this occurs, # the region notifies its "owner", via the Shape superclass. # Become the owner of a region using Shape's "setOwner" method. # # WARNING: The setFunction/getFunction routines may change a Circle # region to an Ellipse region if the pixel->graph translation # is asymetric (ie, pixel scale is different on the two # axes)... the shape must be converted to an ellipse to # retain its proper dimensions. # ######################################################################## itcl::class Region { inherit Shape constructor { graph canvas } {Shape::constructor $canvas} {} destructor {} public { method setSign { sign } method getSign { } { return $itsSign } method setSignColors { pos neg } { set signColors [list $pos $neg] } method setOutlineColor { color } { setColor $color } method setBoundaryColor { color } { setBoundaryClr $color } method setHandleColor { color } { setHandleClr $color } method setLineWidth { width } { setLineW $width } method getOutlineColor {} { return [getColor] } method getBoundaryColor {} { return [getBoundaryClr] } method getHandleColor {} { return [getHandleClr] } method getLineWidth {} { return [getLineW] } method setStaticFlag { axis } { set static_axis $axis ; setStatic $axis} method getGraph { } { return $itsGraph } method getFunction { units } method setFunction { units descr } method getPropertyOrder { } { return $propertyOrder } method setPropertyOrder { order } { set propertyOrder $order } method notify { obj msg opts } # Override Shape's implementations to handle new coord system method getCoords { } method setCoords { coords } method setGraphCoords { coords } method getGraphCoords { } method draw {} method finishModification { } method click {} } private { variable itsSign "+" variable itsGraph variable grphCoords {} variable coordState "" variable signColors [list lightblue red] variable static_axis "" variable propertyOrder "Source" method processParameters { shape descr units } } } ######################################################################## # # gRegion graph canvas # # Create a new region in the global namespace. # ######################################################################## proc gRegion { args } { return [uplevel #0 Region #auto $args] } ######################################################################## # # # ######################################################################## itcl::body Region::constructor { graph canvas } { global powPlotParam global powRotation set itsGraph $graph if { [powWCSexists $itsGraph] } { if { [info exists itsGraph] && [info exists powRotation($itsGraph)] } { setRotation $powRotation($itsGraph) } } eval setClip [$itsCanvas coords ${itsGraph}box] setScale $powPlotParam(xmagstep,$itsGraph) $powPlotParam(ymagstep,$itsGraph) addTags [list ${itsGraph}region] set NC [gNotifications default] $NC addObserver $this notify $itsGraph graphHasResized $NC addObserver $this notify $itsGraph graphHasMoved $NC addObserver $this notify $itsGraph graphHasFinishedDrawing $NC addObserver $this notify $itsGraph graphHasBeenSelected $itsCanvas bind "$itsTag" <> [itcl::code $this click] } itcl::body Region::destructor {} { [gNotifications default] removeObserver $this } itcl::body Region::notify { obj msg opts } { global powPlotParam switch -- $msg { "graphHasBeenSelected" { # Redraw graph handles in new locations if { $isSelected } select $itsCanvas raise $itsTag } "graphHasMoved" { # Must force recalculation of canvas coordinates set coordState "graph" $itsCanvas move $itsTag [lindex $opts 0] [lindex $opts 1] $itsCanvas move rgnHandle$itsTag [lindex $opts 0] [lindex $opts 1] } "graphHasFinishedDrawing" - "graphHasResized" { # Must force recalculation of canvas coordinates set coordState "graph" setScale $powPlotParam(xmagstep,$itsGraph) \ $powPlotParam(ymagstep,$itsGraph) draw # Redraw graph handles in new locations if { $isSelected } select } } } itcl::body Region::draw {} { if { !$ignoreClip } { eval setClip [$itsCanvas coords ${itsGraph}box] } Shape::draw } itcl::body Region::click {} { #puts "itsGraph: $itsGraph" #puts "currentGraph: [powGetCurrentGraph]" #puts "allTags: $allTags" # If region is dragable without activating the graph, don't if { $itsGraph != [powGetCurrentGraph] && [lsearch $allTags DragAble]==-1 } { powSelectGraph $itsGraph } if { [lsearch $allTags DragAble]!=-1 } { select } } itcl::body Region::setSign { sign } { if { $static_axis == "" } { if { $sign=="+" } { setColor [lindex $signColors 0] } elseif { $sign=="-"} { setColor [lindex $signColors 1] } } set itsSign $sign } itcl::body Region::finishModification { } { # Make sure grphCoords are up-to-date getGraphCoords Shape::finishModification } ##################################################################### # # Convert Coordinates between various formats # ##################################################################### itcl::body Region::getCoords { } { if { $coordState == "graph" } { # Convert graph to canvas coords set canvCoords {} foreach [list X Y] $grphCoords { foreach {x y} [powGraphToCanvas $itsGraph $X $Y] {} lappend canvCoords $x $y } Shape::setCoords $canvCoords set coordState "" } return [Shape::getCoords] } itcl::body Region::getGraphCoords { } { if { $coordState == "canvas" } { # Convert canvas to graph coords set grphCoords {} foreach [list x y] [Shape::getCoords] { foreach [list X Y] [powCanvasToGraph $itsGraph $x $y] {} lappend grphCoords $X $Y } set coordState "" } return $grphCoords } itcl::body Region::setCoords { coords } { Shape::setCoords $coords set coordState "canvas" } itcl::body Region::setGraphCoords { coords } { set nelem [llength $coords] if { [expr $nelem%2] } { error "Shape coordinates must contain an even number of elements" } set grphCoords $coords set coordState "graph" } ######################################################################## # # Convert between shape-specific functions and internal graph coords # ######################################################################## itcl::body Region::getFunction { units } { # Convert parameters to the shape specific graph-based description. global powPlotParam global powRotation global regionParam if { [llength $units]==1 } { switch -- $units { "pixels" - "image" { set posUnits "pixels" set sizUnits "pixels" } "linear" { set posUnits "linear" set sizUnits "linear" } "saotng" { set posUnits "degrees" set sizUnits "pixels" } "pixel2pos" { set posUnits "degrees" set sizUnits "degrees" } default { set posUnits "degrees" set sizUnits "pixels" } } } else { set posUnits [lindex $units 0] set sizUnits [lindex $units 1] } set cnt 0 foreach [list x y] [getCoords] [list X Y] [getGraphCoords] { set x$cnt $x set y$cnt $y set X$cnt $X set Y$cnt $Y incr cnt } set dx [expr abs($x1-$x0)/$xScale] set dy [expr abs($y1-$y0)/$yScale] if { [info exists itsGraph] && [info exist powRotation($itsGraph)] } { set rot [expr [getRotation] - $powRotation($itsGraph)] } else { set rot [getRotation] } set shape [getShape] set descr [list $X0 $Y0] switch $shape { Box { lappend descr [expr $dx+$dx] [expr $dy+$dy] $rot } Circle { lappend descr [expr sqrt($dx*$dx+$dy*$dy)] } Ellipse { lappend descr [expr 1.41421356*$dx] [expr 1.41421356*$dy] \ $rot } Polygon { for {set i 1} {$i<$cnt} {incr i} { eval lappend descr \$X$i \$Y$i } } Line { lappend descr $X1 $Y1 } Point { } } # # descr is now in the Graph's prefered decimal coordinate system # ... graph positions, pixel sizes, degree rotations # #################################################################### # # Convert description to desired coordinate system if necessary # if { [powWCSexists $itsGraph] } { set WCS 1 } else { set WCS 0 } set wcsObj $powPlotParam(currimg,$itsGraph) if { $wcsObj=="NULL" } { set wcsObj [lindex $powPlotParam(curves,$itsGraph) 0] } set newD {} if { $shape=="Line" || $shape=="Polygon" || $shape=="Point" } { # These objects consist of just pairs of coordinates foreach [list x y] $descr { if { $posUnits=="pixels" } { foreach [list x y] [powGraphToPixel $wcsObj $x $y] {} set x [expr $x + 1] set y [expr $y + 1] if { [info exists regionParam(format)] && $regionParam(format) == "Physical (Pixels)" } { set result [powConvertImage2Physical $x $y] set x [lindex $result 0] set y [lindex $result 1] } } elseif { $posUnits=="degrees" && !$WCS } { error "Cannot code region in degrees, since graph\ lacks WCS information." } lappend newD $x $y } } else { # Remaining objects consist of center, sizes, and rotations # Parse the center position foreach [list x y] [lrange $descr 0 1] { if { $posUnits=="pixels" } { foreach [list x y] [powGraphToPixel $wcsObj $x $y] {} set x [expr $x + 1] set y [expr $y + 1] set image_x $x set image_y $y if { [info exists regionParam(format)] && $regionParam(format) == "Physical (Pixels)" } { set result [powConvertImage2Physical $x $y] set x [lindex $result 0] set y [lindex $result 1] } } elseif { $posUnits=="degrees" && !$WCS } { error "Cannot code region in degrees, since graph\ lacks WCS information." } lappend newD $x $y } # Parse remaining size parameters (given in image pixel coords) if { $shape=="Circle" } { set radius [lindex $descr 2] if { [info exists regionParam(format)] && $regionParam(format) == "Physical (Pixels)" } { set radius [powConvertRadiusImage2Physical $image_x $image_y $x $radius] } if { $radius == 0.0 } { } elseif { ($sizUnits=="degrees" && $WCS) || ($sizUnits=="linear") } { foreach [list dx dy] [powPixelVToGraphV $wcsObj $radius 0] {} set degWidth [expr sqrt($dx*$dx+$dy*$dy)] foreach [list dx dy] [powPixelVToGraphV $wcsObj 0 $radius] {} set degHeight [expr sqrt($dx*$dx+$dy*$dy)] set ratio [expr abs($degWidth/$degHeight-1.0)] if { $ratio > 0.1 } { # Degree Height and Width aren't the same... change to # and ellipse... set shape "Ellipse" setShape $shape lappend newD $degWidth $degHeight # Set radius to rotation value, 0.0 set radius 0.0 } else { set radius [expr 0.5*($degWidth+$degHeight)] } } elseif { $sizUnits=="degrees" && !$WCS } { error "Cannot code region in degrees, since graph\ lacks WCS information." } lappend newD $radius } else { set width [lindex $descr 2] set height [lindex $descr 3] set rot [lindex $descr 4] if { ($sizUnits=="degrees" && $WCS) || ($sizUnits=="linear") } { foreach [list dx dy] [powPixelVToGraphV $wcsObj $width 0] {} set width [expr sqrt($dx*$dx+$dy*$dy)] foreach [list dx dy] [powPixelVToGraphV $wcsObj 0 $height] {} set height [expr sqrt($dx*$dx+$dy*$dy)] } elseif { $sizUnits=="degrees" && !$WCS } { error "Cannot code region in degrees, since graph\ lacks WCS information." } lappend newD $width $height $rot } } set descr $newD return $descr } # descr must consist of pure numbers; no unit/formatting allowed itcl::body Region::setFunction { units descr } { global powRotation set shape [getShape] foreach [list shape descr] \ [processParameters $shape $descr $units] {} if { $shape != [getShape] } { setShape $shape } # # descr is now in the Graph's prefered decimal coordinate system # ... graph positions, pixel sizes, degree rotations # #################################################################### # # Convert the shape specific description to standard 2n parameters # rot & x0 y0 x1 y1 (... xn yn for polygons) in *canvas* coords # Must use canvas coords because widths/heights of objects cannot # be calculated simply in degree space set cnt 0 foreach p $descr { incr cnt set p$cnt $p } set rot 0.0 foreach {x0 y0} [powGraphToCanvas $itsGraph $p1 $p2] {} if {$cnt>2} { set dx [expr $p3*$xScale] if {$cnt>3} { set dy [expr $p4*$yScale] if {$cnt==5} { set rot $p5 if { [powWCSexists $itsGraph] } { if { [info exists itsGraph] && [info exists powRotation($itsGraph)] } { set rot [expr $powRotation($itsGraph) + $rot] } } } } } set newParams [list $x0 $y0] switch $shape { Box { lappend newParams [expr $x0+0.5*$dx] [expr $y0+0.5*$dy] } Circle { lappend newParams [expr $x0+$dx/1.41421356] \ [expr $y0+$p3*$yScale/1.41421356] } Ellipse { lappend newParams [expr $x0+$dx/1.41421356] \ [expr $y0+$dy/1.41421356] } Polygon { foreach {x y} [lrange $descr 2 end] { foreach {x y} [powGraphToCanvas $itsGraph $x $y] {} lappend newParams $x $y } } Line { foreach {x1 y1} [powGraphToCanvas $itsGraph $p3 $p4] {} lappend newParams $x1 $y1 } Point { lappend newParams $x0 $y0 } } setRotation $rot setCoords $newParams } itcl::body Region::processParameters { shape descr units } { global powPlotParam if { [llength $units]==1 } { switch -- $units { "pixels" - "image" { set posUnits "pixels" set sizUnits "pixels" } "linear" { set posUnits "linear" set sizUnits "linear" } "saotng" { set posUnits "degrees" set sizUnits "pixels" } default { set posUnits "degrees" set sizUnits "degrees" } } } else { set posUnits [lindex $units 0] set sizUnits [lindex $units 1] } # Convert description to the graph's coordinate system if necessary if { [powWCSexists $itsGraph] } { set WCS 1 } else { set WCS 0 } set wcsObj $powPlotParam(currimg,$itsGraph) if { $wcsObj=="NULL" } { set wcsObj [lindex $powPlotParam(curves,$itsGraph) 0] } set newD {} if { $shape=="Line" || $shape=="Polygon" || $shape=="Point" } { # These objects consist of just pairs of coordinates foreach [list x y] $descr { if { $posUnits=="pixels" } { foreach [list x y] [powPixelToGraph $wcsObj \ [expr $x-1] [expr $y-1]] {} } elseif { $posUnits=="degrees" && !$WCS } { error "Region coded in degrees, but graph lacks WCS information." } lappend newD $x $y } } else { # Remaining objects consist of center, sizes, and rotations # Parse the center position foreach [list x y] [lrange $descr 0 1] { if { $posUnits=="pixels" } { foreach [list x y] [powPixelToGraph $wcsObj \ [expr $x-1] [expr $y-1]] {} } elseif { $posUnits=="degrees" && !$WCS } { error "Region coded in degrees, but graph lacks WCS information." } lappend newD $x $y } # Parse remaining size parameters... to current image's pixel dims if { $shape=="Circle" } { set radius [lindex $descr 2] if { $radius == 0.0 } { # Do nothing (prevent divide by zero in next block) } elseif { ($sizUnits=="degrees" && $WCS) || ($sizUnits=="linear") } { foreach [list dx dy] [powPixelVToGraphV $wcsObj 1 0] {} set pixWidth [expr $radius/sqrt($dx*$dx+$dy*$dy)] foreach [list dx dy] [powPixelVToGraphV $wcsObj 0 1] {} set pixHeight [expr $radius/sqrt($dx*$dx+$dy*$dy)] set ratio [expr abs($pixWidth/$pixHeight-1.0)] if { $ratio > 0.1 } { # Pixel Height and Width aren't the same... change to # an ellipse... set shape "Ellipse" lappend newD $pixWidth $pixHeight # Set radius to rotation value, 0.0 set radius 0.0 } else { set radius [expr 0.5*($pixWidth+$pixHeight)] } } elseif { $sizUnits=="degrees" && !$WCS } { error "Region coded in degrees, but graph lacks WCS information." } lappend newD $radius } else { set width [lindex $descr 2] set height [lindex $descr 3] set rot [lindex $descr 4] if { ($sizUnits=="degrees" && $WCS) || ($sizUnits=="linear") } { foreach [list dx dy] [powPixelVToGraphV $wcsObj 1 0] {} set width [expr $width/sqrt($dx*$dx+$dy*$dy)] foreach [list dx dy] [powPixelVToGraphV $wcsObj 0 1] {} set height [expr $height/sqrt($dx*$dx+$dy*$dy)] } elseif { $sizUnits=="degrees" && !$WCS } { error "Region coded in degrees, but graph lacks WCS information." } lappend newD $width $height $rot } } return [list $shape $newD] } fv5.5/tcltk/pow/RegionList.tcl0000644000220700000360000012124013224715127015232 0ustar birbylhea######################################################################## # # class: RegionList # # purpose: Manage a collection of regions and allow drawing of new # regions on a graph. # # usage: To create a region list: # set rgnLst [gRegionList graph canvas] # The region list will overlay a polygon on the graph which # will capture right-mouse clicks which will create a new # region. Use "setDefault" to assign the default sign and # shape to use for new user-created objects. # # To create regions through code, use "addRegion". # # To access information about the region list, use "count" # (number of regions in list), "selected" (index of selected # region), "rgnAtIndex" (an individual region in list), and # "regions" (the full list of regions). # # To delete a region, use "deleteRegion" with the index of # the region to be deleted. # # To disallow drawing of additional regions by the user, # use "setIsDrawable" with a 1 or 0 value. # # To allow only a single region to exist at a time, use # "setAllowsMultiple" with a value of 0. # # To learn when the region list changes, make yourself the # owner of the list using "setOwner", passing the function # name or object and method to be called after a change. # The function or method should accept 2 arguments: obj and # msg. The former is a reference object (either the region # list object or a region object) and the latter is a one- # word string describing the change. See the "notify" method # for the messages passed to the owner. # ######################################################################## itcl::class RegionList { constructor { graph canvas } {} destructor {} public { method selected {} { return $selected } method count {} { return [llength $itsRegions] } method rgnAtIndex { i } { return [lindex $itsRegions $i] } method indexOfRgn { r } { return [lsearch $itsRegions \ [namespace tail $r]]} method regions { } { return $itsRegions } method filename { } { return $filename } method bfilename { } { return $bfilename } method determineIfToDraw { x y flag } method createNewRegion { x y flag } method regionProperty { } method dragNewRegion { x y } method finishNewRegion { } method changeShape { shape } { set defaultShape $shape } method setOutlineColor { color } { set outlineColor $color } method setBoundaryColor { color } { set boundaryColor $color } method setHandleColor { color } { set handleColor $color } method setLineWidth { width } { set lineWidth $width } method setStaticFlag { axis } { set static_axis $axis } method addRegion { sign shape descr fmt } method modifyRegion { sign shape descr fmt } method createRegion { sign shape descr fmt } method deleteAll { } method deleteRegion { i } method selectRegion { i } method drawAll { } method setOwner { owner } { set itsOwner $owner } method getOwner { } { return $itsOwner } method getObj { } { return $this } method notify { obj msg args } method setDefault { sign shape } method writeToFile { fName fmt property } method readFromFile { fName } method readFromStr { fileContents } method parseRegionStr { descr {defUnits "default"} } method buildRegionStr { rgn degFormat } method drawOverlay { } method setIsDrawable { flag } method setAllowsMultiple { flag } { set allowsMultiple $flag } method activate { } method deactivate { } method setCoordSys { coordSys } method getCoordSys { } method getAllFormats { } { return $availFormats } method getPlainFormats { } { return $plainFormats } method flushBufferedRegions { buffer defUnits } method setValueFormat { format } { set valueFormat $format } } private { variable itsCanvas variable itsGraph variable itsOwner "" variable itsRegions {} variable selected -1 variable isDrawable 1 variable isActive 1 variable allowsMultiple 1 variable drawId "" variable static_axis "" variable donotDrawDeletePortion "false" variable filename "" variable bfilename "" variable defaultSign "+" variable defaultShape "Circle" variable defaultSys "FK5 (J2000)" variable outlineColor "blue" variable handleColor "green" variable boundaryColor "red" variable lineWidth 1.0 common availFormats [list \ "Image (Pixels)" \ "Physical (Pixels)" \ "Linear" \ "FK4 (B1950)" \ "FK5 (J2000)" \ "Galactic" \ "Ecliptic" \ "ICRS" \ "Degrees (SAOtng)" ] common plainFormats [list \ "image" \ "physical" \ "linear" \ "fk4" \ "fk5" \ "galactic" \ "ecliptic" \ "icrs" \ "saotng" ] common unitsFormats [list \ "pixels" \ "pixels" \ "linear" \ "degrees" \ "degrees" \ "degrees" \ "degrees" \ "degrees" \ "degrees pixels" ] variable valueFormat "%.7g" method setupBindings { } method requestNewFormat { possibleFmts rgnDescr } method guessFormat { shape descr units fmt } method parseSize { size } method parsePosition { xPos yPos } } } ######################################################################## # # gRegionList graph canvas # # Create a RegionList object and attach it to "graph" on "canvas" # ######################################################################## proc gRegionList { args } { return [uplevel #0 RegionList #auto $args] } ######################################################################## # # # ######################################################################## itcl::body RegionList::constructor { graph canvas } { global powRegionListGlobal global currentRegionObj set powRegionListGlobal [linsert $powRegionListGlobal 0 $this] set currentRegionObj $this #puts "this: $this, powRegionListGlobal: $powRegionListGlobal" set itsGraph $graph set itsCanvas $canvas catch { activate } err catch { setupBindings } err [gNotifications default] addObserver \ $this notify $itsGraph graphHasFinishedDrawing } itcl::body RegionList::destructor {} { global powRegionListGlobal global currentRegionObj set idx [lsearch $powRegionListGlobal $this] if { $idx >= 0 } { set powRegionListGlobal [lreplace $powRegionListGlobal $idx $idx] } if { [llength $powRegionListGlobal] > 0 } { set currentRegionObj [lindex $powRegionListGlobal 0] # event delete <> powBindBtn <> "$itsCanvas bind DrawRegion" \ "global currentRegionObj ; [itcl::code $currentRegionObj createNewRegion %x %y false] ; " \ "[itcl::code $currentRegionObj dragNewRegion %x %y] ; set_tracker_info %x %y $itsCanvas ; " \ "[itcl::code $currentRegionObj finishNewRegion]" powBindBtn <> "$itsCanvas bind DrawRegion" \ "global currentRegionObj ; [itcl::code $currentRegionObj createNewRegion %x %y true] ; " \ "[itcl::code $currentRegionObj dragNewRegion %x %y] ; set_tracker_info %x %y $itsCanvas ; " \ "[itcl::code $currentRegionObj finishNewRegion]" } else { set currentRegionObj "" } #puts "pop top is currentRegionObj: $currentRegionObj" foreach rgn $itsRegions { catch { itcl::delete object $rgn } } if { [winfo exists $itsCanvas] } { catch { $itsCanvas delete $drawId } } [gNotifications default] removeObserver $this } itcl::body RegionList::setIsDrawable { flag } { if { $flag } { if { !$isDrawable } { set isDrawable 1 drawOverlay foreach rgn [regions] { $rgn addTags DrawRegion } } } else { set isDrawable 0 $itsCanvas delete $drawId foreach rgn [regions] { $rgn removeTags DrawRegion } } } itcl::body RegionList::drawOverlay { } { if { $isDrawable && $isActive && [$itsCanvas find withtag $drawId] == "" } { foreach {x1 y1 x2 y2} [$itsCanvas coords ${itsGraph}box] {} set drawId [$itsCanvas create polygon $x1 $y1 $x1 $y2 $x2 $y2 $x2 $y1 \ -fill {} -tags "$itsGraph DrawRegion"] } $itsCanvas raise $drawId $itsGraph $itsCanvas raise shape $itsGraph } itcl::body RegionList::setupBindings { } { global currgn currimg global powLutButton powROIButton global powLutButton_old powROIButton_old tcl_platform global currentRegionObj # set powLutButton_old $powLutButton # set powROIButton_old $powROIButton powBindBtn <> "$itsCanvas bind DrawRegion" \ "global currentRegionObj ; [itcl::code $currentRegionObj createNewRegion %x %y false] ; " \ "[itcl::code $currentRegionObj dragNewRegion %x %y] ; set_tracker_info %x %y $itsCanvas ; " \ "[itcl::code $currentRegionObj finishNewRegion]" powBindBtn <> "$itsCanvas bind DrawRegion" \ "global currentRegionObj ; [itcl::code $currentRegionObj createNewRegion %x %y true] ; " \ "[itcl::code $currentRegionObj dragNewRegion %x %y] ; set_tracker_info %x %y $itsCanvas ; " \ "[itcl::code $currentRegionObj finishNewRegion]" #powBindBtn <> "$itsCanvas bind DrawRegion" \ # "global currentRegionObj ; [itcl::code $currentRegionObj regionProperty] ; " \ # {} \ # {} powBindBtn <> "$itsCanvas bind DrawRegion" \ "powSelectImage $currgn $currimg" \ "powBoundDiddleLut $currgn $currimg %x %y" \ {} } ######################################################################## # # (de)activate: Make region (de)active following graph (de)selection # ######################################################################## itcl::body RegionList::activate { } { drawOverlay foreach rgn [regions] { if { $isDrawable } { $rgn addTags [list DragAble DrawRegion] } else { $rgn addTags DragAble } } if { $selected!=-1 } { [rgnAtIndex $selected] select } set isActive 1 catch { setupBindings } err } itcl::body RegionList::deactivate { } { $itsCanvas delete $drawId foreach rgn [regions] { $rgn removeTags [list DrawRegion DragAble] } if { $selected!=-1 } { [rgnAtIndex $selected] deselect } set isActive 0 } ######################################################################## itcl::body RegionList::setDefault { sign shape } { set defaultSign $sign set defaultShape $shape } itcl::body RegionList::deleteAll { } { global currentRegionObj set allRgns $itsRegions set itsRegions {} set selected -1 foreach rgn $allRgns { itcl::delete object $rgn } if { $itsOwner != "" } { $itsOwner $currentRegionObj regionsHaveChanged } } itcl::body RegionList::deleteRegion { i } { if { $i < 0 } return set rgn [lindex $itsRegions $i] itcl::delete object $rgn if { $i<$selected } { incr selected -1 } selectRegion $selected } itcl::body RegionList::selectRegion { i } { set nRgns [count] if { !$nRgns } { set selected -1 return } if { $i >= $nRgns } { set i [expr $nRgns-1] } elseif { $i < 0 } { set i 0 } [lindex $itsRegions $i] select } itcl::body RegionList::drawAll { } { foreach rgn $itsRegions { $rgn draw } if { $selected != -1 } { [lindex $itsRegions $selected] select } } itcl::body RegionList::notify { obj msg args } { global currentRegionObj global CpowXRangeX0 CpowXRangeX1 CpowXRangeY0 CpowXRangeY1 global TpowXRangeX0 TpowXRangeX1 TpowXRangeY0 TpowXRangeY1 if { $itsOwner == "powXRangeOwner" } { set CpowXRangeX0 $TpowXRangeX0 set CpowXRangeX1 $TpowXRangeX1 set CpowXRangeY0 $TpowXRangeY0 set CpowXRangeY1 $TpowXRangeY1 } else { catch { unset CpowXRangeY0 } err } switch $msg { "graphHasFinishedDrawing" { drawOverlay } "shapeHasChanged" - "shapeIsBeingModified" { set idx [lsearch $itsRegions [namespace tail $obj]] if { $idx==-1 } return if { $itsOwner != "" } { $itsOwner $obj $msg } } "shapeHasDied" { set idx [lsearch $itsRegions [namespace tail $obj]] if { $idx==-1 } return set itsRegions [lreplace $itsRegions $idx $idx] if { $itsOwner != "" } { $itsOwner $currentRegionObj regionsHaveChanged } } "shapeIsSelected" { set idx [lsearch $itsRegions [namespace tail $obj]] if { $idx==-1 } return if { $selected != $idx } { if { $selected != -1 && $selected<[count] } { [lindex $itsRegions $selected] deselect } set selected $idx if { $itsOwner != "" } { $itsOwner $obj "selectionHasChanged" } } } } } itcl::body RegionList::modifyRegion { sign shape descr fmt } { if { $selected == -1 } { set rgn [addRegion $sign $shape $descr $fmt] } else { set rgn [lindex $itsRegions $selected] $rgn setSign $sign $rgn setShape $shape $rgn setFunction $fmt $descr $rgn finishModification $rgn setStaticFlag $static_axis } } itcl::body RegionList::addRegion { sign shape descr fmt } { global regionParam if { ! $allowsMultiple && [count] } { deleteAll } if { [info exists regionParam] && [info exists regionParam(format)] \ && $regionParam(format) == "Physical (Pixels)" } { set tokenList [split $descr " "] set phy_x [lindex $tokenList 0] set phy_y [lindex $tokenList 1] set phy_radius [lindex $tokenList 2] set result [powConvertPhysical2Image $phy_x $phy_y] set img_x [lindex $result 0] set img_y [lindex $result 1] set img_radius [powConvertRadiusPhysical2Image $phy_x $phy_y $img_x $phy_radius] set descr [format "%s %s %s" $img_x $img_y $img_radius] } set rgn [createRegion $sign $shape $descr $fmt] lappend itsRegions $rgn $rgn finishModification return $rgn } itcl::body RegionList::createRegion { sign shape descr fmt } { global currentRegionObj global powRotation set rgn [gRegion $itsGraph $itsCanvas] if [info exists powRotation($itsGraph)] { catch {$rgn setRotation $powRotation($itsGraph)} err } catch {$rgn addTags [list DrawRegion]} err catch {$rgn setOwner [itcl::code $currentRegionObj notify]} err catch {$rgn setSign $sign} err catch {$rgn setShape $shape} err catch {$rgn setFunction $fmt $descr} err catch {$rgn setStaticFlag $static_axis} err catch {$rgn setOutlineColor $outlineColor} err catch {$rgn setBoundaryColor $boundaryColor } err catch {$rgn setHandleColor $handleColor } err catch {$rgn setLineWidth $lineWidth } err return $rgn } ######################################################################## # # The following routines display region property # ######################################################################## itcl::body RegionList::regionProperty { } { global regionParam set rgnIdx [$regionParam(rgns) selected] set rgn [$regionParam(rgns) rgnAtIndex $rgnIdx] #puts "[$rgn getSign]" #puts "$regionParam(currSign)$regionParam(currShape)$regionParam(currDescr)" } ######################################################################## # # The following 3 routines handle dragging out a new region # ######################################################################## itcl::body RegionList::createNewRegion { x y flag } { global currentRegionObj global insideExistGraph set donotDrawDeletePortion false if { $flag == "true" } { if ![info exists insideExistGraph] { set donotDrawDeletePortion true return } else { if { $insideExistGraph == "false" } { set donotDrawDeletePortion true return } } } set x [$itsCanvas canvasx $x] set y [$itsCanvas canvasy $y] if { ! $allowsMultiple && [count] } { set rgn [lindex $itsRegions end] } else { set rgn [gRegion $itsGraph $itsCanvas] $rgn addTags [list DrawRegion] $rgn setOwner [itcl::code $currentRegionObj notify] lappend itsRegions $rgn } $rgn setDrawDeleteFlag $flag $rgn setSign $defaultSign $rgn setShape $defaultShape $rgn setOutlineColor $outlineColor $rgn setBoundaryColor $boundaryColor $rgn setHandleColor $handleColor $rgn setLineWidth $lineWidth $rgn setStaticFlag $static_axis $rgn setCoords [list $x $y $x $y] $rgn beginModification } itcl::body RegionList::dragNewRegion { x y } { if { $donotDrawDeletePortion == "true" } return [lindex $itsRegions end] adjustPt 1 $x $y } itcl::body RegionList::finishNewRegion { } { if { $donotDrawDeletePortion == "true" } return [lindex $itsRegions end] finishModification if { ! $allowsMultiple } { while { [count]>1 } { deleteRegion 0 } } } ######################################################################## # # These two regions Read/Write regions from the given file # ######################################################################## itcl::body RegionList::writeToFile { fName degFmt property } { global powRotation if { $property == "Source" } { set filename $fName } else { set bfilename $fName } set writeFile $fName set base [string tolower [lindex $defaultSys 0]] set freg [open $writeFile w+] puts $freg "# Region created by POW [clock format [clock seconds]], $property" puts $freg "# filename: $itsGraph" if { $base=="degrees" } { # Writing SAOtng format if { [string tolower $degFmt] == "hhmmss" } { puts $freg "# format: hms" } else { puts $freg "# format: degrees" } } elseif { $base=="pixels" } { # Writing SAOtng format puts $freg "# format: pixels" } else { # Writing DS9 format puts $freg $base } for {set i 0} {$i<[count]} {incr i} { set rgn [rgnAtIndex $i] set propertyOrder [$rgn getPropertyOrder] if { $propertyOrder == $property } { foreach [list sign shape descr] [buildRegionStr $rgn $degFmt] {} set rot [lindex $descr end] if { [string first "(pixels)" [string tolower $defaultSys]] > 0 && \ [info exists itsGraph] && [info exists powRotation($itsGraph)] } { if { ([string tolower $shape] == "box" || [string tolower $shape] == "ellipse") && [llength $descr] >= 5 } { set rot [expr $rot + $powRotation($itsGraph)] set descr [lreplace $descr end end $rot] } } set descr [join $descr ", "] puts $freg "$sign[string tolower $shape]($descr)" } } close $freg } itcl::body RegionList::readFromFile { fName } { global readRegionFile set readRegionFile true # Read contents of file set filename $fName set freg [open $filename r] set fileContents [read $freg] close $freg readFromStr $fileContents set readRegionFile false } itcl::body RegionList::readFromStr { fileContents } { global regionParam # Identify what formats are possible for this graph if { [powWCSexists $itsGraph] } { set fmt [list image fk5 saotng] set defaultUnits "unknown" } else { set wcsObj $::powPlotParam(currimg,$itsGraph) if { $wcsObj=="NULL" } { set wcsObj [lindex $::powPlotParam(curves,$itsGraph) 0] } foreach [list x y] [powPixelToGraph $wcsObj 3 5] {} set diff1 [expr abs($x-4) + abs($y-6)] # Do it again for a different point in case we just happened # to hit an intersection of pixels and scale with first point foreach [list x y] [powPixelToGraph $wcsObj 4 6] {} set diff2 [expr abs($x-5) + abs($y-7)] if { $diff1 > 0.0001 || $diff2 > 0.0001 } { # Image scale is not the identity set fmt [list image linear] set defaultUnits "unknown" } else { # Only pixel values allowed set fmt [list image] set defaultUnits "pixels" } } set bufferedRegions {} set newregions [split $fileContents "\n\r|;"] foreach reg $newregions { if { [string index $reg 0] == "#" } { # Handle leading comments... property (source/background) and format are supported here set reg [string tolower $reg] set tokenList [split $reg " "] set property [lindex $tokenList end] if { [string first "format:" $reg]!=-1 } { if { [string first "degrees" $reg]!=-1 } { set fmt "saotng" } elseif { [string first "pixels" $reg]!=-1 } { set fmt "image" } elseif { [string first "hhmmss" $reg]!=-1 } { set fmt "saotng" } elseif { [string first "hms" $reg]!=-1 } { set fmt "saotng" } if { [llength $fmt]==1 } { set idx [lsearch $plainFormats $fmt] set defaultSys [lindex $availFormats $idx] set defaultUnits [lindex $unitsFormats $idx] } } } elseif { [string length $reg] != 0 } { set idx [string first # $reg] if { $idx != -1 } { incr idx -1 set reg [string range $reg 0 $idx] } set parts [split $reg {;}] foreach part $parts { set part [string tolower $part] set idx [lsearch $plainFormats $part] if { $idx != -1 } { # Is a format specifier set fmt $part set regionParam(format) [lindex $availFormats $idx] set defaultUnits [lindex $unitsFormats $idx] set defaultSys [lindex $availFormats $idx] } else { if { [string first = $part]!=-1 } continue if { [catch {\ set newDescr [parseRegionStr $part $defaultUnits]\ } errMsg] } { error "Could not decipher $part\n$errMsg" } lappend bufferedRegions $newDescr if { [llength $fmt]!=1 } { # Format not found yet... try to guess format foreach {sign shape descr units} $newDescr {} set fmt [guessFormat $shape $descr $units $fmt] if { [llength $fmt]==1 } { set idx [lsearch $plainFormats $fmt] set defaultSys [lindex $availFormats $idx] set defaultUnits [lindex $unitsFormats $idx] } } if { [llength $fmt]==1 } { flushBufferedRegions $bufferedRegions $defaultUnits set bufferedRegions {} } } } } } # # If we never identified the file format, ask user for help # if { [llength $fmt]!=1 && [llength $bufferedRegions] } { set newFmt [requestNewFormat $fmt $fileContents] if { $newFmt==-1 } return set fmt [lindex $plainFormats $newFmt] set defaultSys [lindex $availFormats $newFmt] set defaultUnits [lindex $unitsFormats $newFmt] } # Flush any remaining buffered regions flushBufferedRegions $bufferedRegions $defaultUnits } itcl::body RegionList::flushBufferedRegions { buffer defUnits } { foreach d $buffer { foreach [list aSign aShape aDescr aUnits] $d {} # Need to apply default units to this region if { [lindex $aUnits 0]=="unknown" } { set aUnits [lreplace $aUnits 0 0 \ [lindex $defUnits 0]] } if { [lindex $aUnits 1]=="unknown" } { set aUnits [lreplace $aUnits 1 1 \ [lindex $defUnits end]] } if { $itsOwner == "powRegionOwner" } { if { $aSign == "+" } { set outlineColor blue set handleColor green } elseif { $aSign == "-" } { set outlineColor red set handleColor yellow } powRegionResetPanelColor $outlineColor $handleColor } addRegion $aSign $aShape $aDescr $aUnits } } itcl::body RegionList::guessFormat { shape descr units fmts } { set posUnit [lindex $units 0] set sizUnit [lindex $units end] if { $posUnit=="unknown" || $sizUnit=="unknown" } { if { $posUnit=="unknown" } { if { $shape=="Line" || $shape=="Polygon" } { set posArgs $descr } else { set posArgs [lrange $descr 0 1] } foreach [list x y] $posArgs { if { $y<-90.0 || $y>90.0 || $x<-360.0 || $x>360.0 } { # Coords should be in degrees, but x/y out of range. # Parameters must be in pixel coordinates. set fmts [removeElements $fmts [list saotng fk5]] } } } if { $sizUnit=="unknown" } { switch $shape { "Circle" { set rad [lindex $descr 2] if { $rad > 90 } { # Radius cannot be this big and be in degrees set fmts [removeElements $fmts [list fk5]] } } "Ellipse" - "Box" { set dx [expr abs([lindex $descr 2])] set dy [expr abs([lindex $descr 3])] if { $dx > 90 || $dy > 90 } { # Sizes cannot be this big and be in degrees set fmts [removeElements $fmts [list fk5]] } } } } } elseif { $posUnit=="degrees" && $sizUnit=="degrees" } { set fmts "fk5" } elseif { $posUnit=="degrees" && $sizUnit=="pixels" } { set fmts "saotng" } return $fmts } itcl::body RegionList::requestNewFormat { possibleFmts rgnDescr } { global powDWP set w ${powDWP}rgnFmt ::iwidgets::dialogshell $w -title "Region Format" -modality application \ -background $::powbg $w add OK -text "OK" -command "$w deactivate OK" $w add Cancel -text "Cancel" -command "$w deactivate Cancel" $w default OK set wc [$w childsite] label $wc.msg -bg $::powbg -justify left -wraplength 300 -text \ "Region file lacks explicit degree/pixel designation.\ Please select the default format in which to interpret\ the following regions:" ::iwidgets::scrolledtext $wc.rgn -visibleitems 40x4 -background $::powbg \ -wrap none -textbackground white $wc.rgn insert end $rgnDescr $wc.rgn configure -state disabled set allFmts [list image fk5 saotng linear] set allFmtStrs [list \ "Pixel Positions and Sizes" \ "Degree Positions and Sizes" \ "Degree Positions, Pixel Sizes" \ "Linearly Scaled Positions and Sizes" ] ::iwidgets::optionmenu $wc.fmt -labeltext "Format:" -labelpos w \ -background $::powbg eval $wc.fmt insert 0 $allFmtStrs if { [llength $possibleFmts]==0 } { set possibleFmts $allFmts } set idx 0 foreach fmt $allFmts { if { [lsearch $possibleFmts $fmt]==-1 } { $wc.fmt disable $idx } incr idx } $wc.fmt select 0 pack $wc.msg -pady 5 pack $wc.rgn -pady 10 -expand 1 -fill both pack $wc.fmt -pady 5 $w center set btn [$w activate] set ans [$wc.fmt index select] itcl::delete object $w if { $btn == "Cancel" } { set idx -1 } else { set idx [lsearch $plainFormats [lindex $allFmts $ans]] } return $idx } itcl::body RegionList::setCoordSys { coordSys } { set idx [lsearch $availFormats $coordSys] if { $idx != -1 } { set defaultSys $coordSys } else { set idx [lsearch $plainFormats $coordSys] if { $idx != -1 } { set defaultSys [lindex $availFormats $idx] } else { error "Unrecognized coordinate system: $coordSys" } } } itcl::body RegionList::getCoordSys { } { return $defaultSys } ######################################################################## # # Take a string representing a region and parse it into # sign shape params units # ######################################################################## itcl::body RegionList::parseRegionStr { descr {defUnits "default"} } { global powRotation global regionParam set sign $defaultSign set shape $defaultShape if { $defUnits=="default" } { set idx [lsearch $availFormats $defaultSys] set defUnits [lindex $unitsFormats $idx] } set defPosUnits [lindex $defUnits 0] set defSizUnits [lindex $defUnits end] # Split description up into its various parameters set items {} foreach item [split $descr "(), "] { if { $item != "" && $item != "\t" } { lappend items $item } } set idx 0 # Look for shape/sign in first 1 or 2 elements set item [lindex $items $idx] set firstChar [string index $item 0] set firstIsAlpha [string is alpha $firstChar] set firstIsSign [string first $firstChar {+-!}] # After this block, idx should point to first numerical value if { $firstIsAlpha } { set sign "+" set shape $item incr idx } elseif { $firstIsSign!=-1 } { if { [string length $item]==1 } { # Standalone sign; next item must be the shape incr idx set sign $item set shape [lindex $items $idx] incr idx } else { # Is sign part of shape or first value? set tail [string range $item 1 end] if { [string is alpha $tail] } { # It is a shape; set sign and shape set sign $firstChar set shape $tail incr idx } } if { $sign=="-" || $sign=="!" } { set sign "-" } else { set sign "+" } } set shape [string totitle $shape] set descr [lrange $items $idx end] # Make sure there are the correct number of elements in descr set nelem [llength $descr] switch $shape { Box {set nparam 5} Ellipse {set nparam 5} Circle {set nparam 3} Polygon {set nparam [expr 2*int($nelem/2)]} Line {set nparam 4} Point {set nparam 2} default {error "Unrecognized shape: $shape" } } if {$nelem!=$nparam} { error "Wrong number of parameters for $shape!" } # Parse any unit formatting of parameters and identify units. # Raise error if a degree format is used for a nonWCS graph if { [powWCSexists $itsGraph] } { set WCS 1 } else { set WCS 0 } set newDescr {} set allUnits "" if { $shape=="Line" || $shape=="Polygon" || $shape=="Point" } { # These objects consist of just pairs of coordinates foreach [list x y] $descr { foreach [list xVal yVal unts] [parsePosition $x $y] {} if { $unts=="unknown" } { set unts $defPosUnits } if { !$WCS && $unts=="degrees" } { error "Region coded in degrees, but graph lacks WCS information." } elseif { $WCS && $unts=="linear" } { error "Graph coded in degrees,\ but region specified in linear coordinates" } if { $allUnits=="" } { set allUnits $unts } elseif { $unts != $allUnits } { error "All position parameters do not use the same units" } lappend newDescr $xVal $yVal } } else { # Remaining objects consist of center, sizes, and rotations # Parse the center position foreach [list x y] [lrange $descr 0 1] { foreach [list xVal yVal unts] [parsePosition $x $y] {} if { $unts=="unknown" } { set unts $defPosUnits } if { !$WCS && $unts=="degrees" } { error "Region coded in degrees, but graph lacks WCS information." } elseif { $WCS && $unts=="linear" } { error "Graph coded in degrees,\ but region specified in linear coordinates" } set allUnits $unts lappend newDescr $xVal $yVal } # Parse sizes/rotations if { $shape=="Circle" } { set radius [lindex $descr 2] foreach [list radius unts] [parseSize $radius] {} if { $unts=="unknown" } { set unts $defSizUnits } if { !$WCS && $unts=="degrees" } { error "Region coded in degrees, but graph lacks WCS information." } elseif { $WCS && $unts=="linear" } { error "Graph coded in degrees,\ but region specified in linear coordinates" } lappend newDescr $radius lappend allUnits $unts } else { set width [lindex $descr 2] set height [lindex $descr 3] set rot [lindex $descr 4] if { [string first "(pixels)" [string tolower $defaultSys]] > 0 && \ [info exists itsGraph] && [info exists powRotation($itsGraph)] } { if { ([string tolower $shape] == "box" || [string tolower $shape] == "ellipse") && [llength $descr] >= 5 } { set rot [expr $rot - $powRotation($itsGraph)] } } foreach [list newWidth wUnits] [parseSize $width ] {} foreach [list newHeight hUnits] [parseSize $height] {} if { $wUnits != $hUnits } { error "Size arguments have mixed formatting: $width $height" } if { $wUnits=="unknown" } { set wUnits $defSizUnits } if { !$WCS && $wUnits=="degrees" } { error "Region coded in degrees, but graph lacks WCS information." } elseif { $WCS && $wUnits=="linear" } { error "Graph coded in degrees,\ but region specified in linear coordinates" } lappend newDescr $newWidth $newHeight lappend allUnits $wUnits foreach [list rot unts] [parseSize $rot] {} if { $unts=="unknown" } { set unts "degrees" } if { $unts != "degrees" } { error "Rotation coded in something other than degrees: $rot" } lappend newDescr $rot } } if { [lsearch $allUnits "linear"]!=-1 \ && [lsearch $allUnits "degrees"]!=-1 } { error "Cannot mix linear and degree formats" } if { [info exists regionParam(format)] && $regionParam(format) == "Physical (Pixels)" } { return [list $sign $shape $descr $allUnits] } return [list $sign $shape $newDescr $allUnits] } itcl::body RegionList::buildRegionStr { rgn degFmt } { global currgn currimg set units [lindex $unitsFormats [lsearch $availFormats $defaultSys]] set posUnits [lindex $units 0] set sizUnits [lindex $units end] set descr [$rgn getFunction [list $posUnits $sizUnits]] set shape [$rgn getShape] set sign [$rgn getSign] set newD {} if { $shape=="Line" || $shape=="Polygon" || $shape=="Point" } { # These objects consist of just pairs of coordinates foreach [list x y] $descr { if { $posUnits=="degrees" && $degFmt=="hhmmss" } { lappend newD [powHourRA $x "%d:%02d:%05.2f"] [powDegDec $y] } else { lappend newD [format $valueFormat $x] [format $valueFormat $y] } } } else { # Remaining objects consist of center, sizes, and rotations # Parse the center position foreach [list x y] [lrange $descr 0 1] {} #set coord [powGraphToPixel $currimg $x $y] #set icoord [powPixelToGraph $currimg [lindex $coord 0] [lindex $coord 1]] #set x [lindex $icoord 0] #set y [lindex $icoord 1] if { $posUnits=="degrees" && $degFmt=="hhmmss" } { lappend newD [powHourRA $x "%d:%02d:%05.2f"] [powDegDec $y] } else { lappend newD [format $valueFormat $x] [format $valueFormat $y] } # Parse remaining size parameters (given in image pixel coords) if { $shape=="Circle" } { set radius [lindex $descr 2] if { $sizUnits=="degrees" } { if { [expr abs($radius)]<1.0 } { set radius [expr $radius*60.0] if { [expr abs($radius)]<1.0 } { set radius [expr $radius*60.0] lappend newD "[format $valueFormat $radius]\"" } else { lappend newD "[format $valueFormat $radius]'" } } else { lappend newD "[format $valueFormat $radius]d" } } else { lappend newD [format $valueFormat $radius] } } else { set width [lindex $descr 2] set height [lindex $descr 3] set rot [lindex $descr 4] if { $sizUnits=="degrees" } { foreach p [list $width $height] { if { [expr abs($p)]<1.0 } { set p [expr $p*60.0] if { [expr abs($p)]<1.0 } { set p [expr $p*60.0] lappend newD "[format $valueFormat $p]\"" } else { lappend newD "[format $valueFormat $p]'" } } else { lappend newD "[format $valueFormat $p]d" } } } else { lappend newD [format $valueFormat $width] \ [format $valueFormat $height] } lappend newD [format $valueFormat $rot] } } set descr $newD return [list $sign $shape $descr] } itcl::body RegionList::parseSize { size } { set lastChar [string index $size end] if { [string first $lastChar {drpi'"}]!=-1 } { # in [num]x format set size [string range $size 0 end-1] set foundUnits "degrees" if { $lastChar=="d" } { set val $size } elseif { $lastChar=="r" } { set val [expr $size * 180.0 / 3.1415926535] } elseif { $lastChar=="'" } { set val [expr $size / 60.0 ] } elseif { $lastChar=="\"" } { set val [expr $size / 3600.0 ] } else { set val $size set foundUnits "pixels" } } else { # Use default set val $size set foundUnits "unknown" } return [list $val $foundUnits] } itcl::body RegionList::parsePosition { xPos yPos } { foreach axis [list x y] { set pos [subst \$${axis}Pos] ##### # Strip off and record the sign of the position ##### set sign 1.0 if { [string index $pos 0] == "-" } { set sign -1.0 set pos [string range $pos 1 end] } ##### # Parse position ##### set lastChar [string index $pos end] if { [string first : $pos]!=-1 || $lastChar=="s" } { set parts [split [string trimright $pos s] {dhms:}] if { [llength $parts]!=3 } { error "Bad format for position: $pos" } foreach [list d m s] $parts {} set d [string trimleft $d 0]; if { $d=="" } { set d 0 } set m [string trimleft $m 0]; if { $m=="" } { set m 0 } set s [string trimleft $s 0]; if { $s=="" } { set s 0 } set val [expr $d + $m/60.0 + $s/3600.0] if { $axis=="x" } { # RA needs to be scaled to proper degrees set val [expr $val * 15.0] } set foundUnits "degrees" } elseif { [string first $lastChar "drpi"]!=-1 } { # in [num]x format set pos [string range $pos 0 end-1] if { $lastChar=="d" } { set val $pos set foundUnits "degrees" } elseif { $lastChar=="r" } { set val [expr $pos * 180.0 / 3.1415926535] set foundUnits "degrees" } else { set val $pos set foundUnits "pixels" } } else { # Use default set val $pos set foundUnits "unknown" } set ${axis}Val [expr $sign * $val] set ${axis}Unt $foundUnits } if { $xUnt != $yUnt } { error "Size arguments have mixed formatting: $xPos $yPos" } return [list $xVal $yVal $xUnt] } proc removeElements { mainList removeList } { foreach l $removeList { set idx [lsearch $mainList $l] if { $idx!=-1 } { set mainList [lreplace $mainList $idx $idx] } } return $mainList } fv5.5/tcltk/pow/Regions.html0000644000220700000360000002040713224715127014746 0ustar birbylhea Pow Region Manipulation

    Pow Region Manipulation

    Overview

    POW provides the user with the ability to create and edit standard region files through the Region File menu item under POW's     Tools menu. The Region File dialog window consists of a list of regions available for manipulation; a set of buttons and an entry box which are used to modify the currently selected region; and, at the bottom, buttons which open/save regions in a file and delete all the regions. Region types supported are Box, Circle, Ellipse, Polygon, Line, and Point.

    Creating Regions

    When the region dialog box is open, a new region can be created by placing the mouse at the desired location in the graph and click-and-drag with the left mouse button down (Command-Click on Mac OS). The shape of the region created is determined by the current shape button in the dialog box. For Circles, and Ellipses, the initial mouse location will be the center of the region and the final location its radius or width and/or height, as appropriate. For Boxes, the mouse movement traces out opposite corners of the rectangle. For Polygons and Lines, the mouse movement locations define the start and end of a line segment. To add extra segments to the Polygon, let up on the mouse button then press it again, without moving, then drag out the next side of the polygon, repeating as necessary. For a Point shape, the final mouse position defines its location. When the mouse button is released, the new region is appended to the list of available regions and made the current region.

    Current Region and Manipulation

    The current region is the one highlighted in the dialog's list of regions and "tagged" on the graph (see below). Upon selection (clicking the left mouse button on a region in the list or on the graph itself) or creation, the definition of the current region is placed in the current region portion of the dialog box.

    A region consists of 3 parts: a sign indicating whether it defines a region to be added (source) or subtracted (background) from the data (these are indicated on the graph with blue or red region outlines, respectively); a shape; and the parameters defining its location, size, and possible rotation. The sign and shape of the current region are represented by a pair of buttons. The sign button toggles between "+" and "-" and the shape button brings up a popup menu of the 6 available shapes to choose from. The region parameters are placed in a final text entry box and can be modified by hand. When changing shapes, POW does its best to translate the current parameters into appropriate values and format for the new shape. For example, in going from a circle to polygon, the parameters change from a circle's (X,Y,R) format to a list of points tracing out the circle's outline. Changing the current region information in the dialog box does not actually affect the current region until the Apply button is pressed. Prior to pressing Apply, the region information can be restored by reselecting the current region. (Note: the values initially placed in the entry box are rounded off after 6 significant digits, so pressing Apply may result in minor changes in the shape's size and location even though the values were not modified.)

    Although the sign and shape of a region can only be modified via the dialog box, the location, size, and rotation of regions can be changed either in the dialog box (yuck!) or through direct manipulation of the region on the graph with the mouse. The current region is "tagged" with 2 types of handles: a rotation handle (green triangle) and one or more resize handles (green squares). Circles, Polygons, and Lines cannot be rotated, so they have only one or more (as appropriate) resize handles. Boxes and Ellipses have one of each type, but Points have neither. A shape is rotated or resized (for Polygons and Lines, it is more a matter of repositioning points) by clicking the relevant handle with the left mouse button and dragging it to a new location. When the mouse cursor is over one of the handles, the cursor changes to a double-arrow, indicating that point can be dragged. When the mouse button is released the dialog's list of regions and current region information are updated with the new information. On the polygon, to drag a vertex, use Shife-Left Mouse button to drag the intended vertex to new location.

    To move a region, simply click the left mouse button inside the region and drag it to the new location. Because clicking on a region makes it the current region, moving a region can be performed on any region, not just the current one. When inside a region, the cursor changes to a 4-sided arrow and the region's outline thickens. The current region can also be moved via the keyboard. When the POW window is in the foreground, shift-arrow will move the current shape one screen pixel in the arrow's direction. Control-arrow moves the shape 10 pixels.

    Polygons can be modified in two additional ways. Points can be deleted by dragging a point onto one of its adjacent points. A point can also be inserted by clicking and dragging one of the handles with the left mouse button (Command-Click on Mac OS). This inserts the new point before the one clicked. If this is incorrect, immediately drag the new point back onto the first to delete it (no need to release the mouse button) and then click and drag on the next point. Vertex can be dragged by click and drag with right mouse button.

    The Delete button in the Region dialog deletes the current region, and the next region in the list (or previous region if deleting the last region) becomes the current region. All the regions can be deleted with the Clear All button.

    Coordinate Systems

    Region parameters can be displayed in one of several formats selectable by a popup menu just below the list of regions in the Region dialog. The first is Image format wherein positions and size parameters are reported in the pixel coordinates of the image. If the image has a linear scaling, the Linear format will report coordinates in this scaled coordinate system instead of pixels. If WCS information is available for the graph, region parameters can be displayed in celestial coordinates as degrees. The formats FK4, FK5, Galactic, Ecliptic, and ICRS each report region positions and sizes as degrees, but POW currently does not convert between these formats; the user must specify the appropriate system which will then be written to the region file when saved. Finally, the Degrees format signifies a mixed style used by SAOtng wherein positions are in degrees, but sizes are in pixels.

    The final 2 elements of the popup menu select the formatting to use when displaying degree values. Decimal Degrees format shows values as ordinary decimals with RA ranging over 0-360 and Declination over -90 to +90. HHMMSS Degrees instead displays decimals in hour:minute:second format.

    Statistics Calculation

    3 entries indicate the statistics of a region selected (or combine of regions). The statistics include number of pixel enclosed, total flux and mean flux in the region(s).

    For statistic of 2 or more regions on the image, number of pixels is determined by several factors, such as if a region intersects with one another, the sign of region (+: include, -: exclude). Pow calls CFITSIO routine and pass the region(s) descriptions to determine if a given pixel is part of the ROI (region of interests). And if so, that pixel's value is been recorded to be part of calculation of total flux and mean flux of the ROI.

    Saving/Opening Region Files

    At the bottom of the Region dialog are a pair of Open and Save buttons which will read and write region files in the standard format, compatible with SAOtng. If regions already exist when opening a region file, the user will have the option of deleting the old regions or appending the new ones to the list. When saving regions, the parameters will be written in the coordinate system currently selected in the Region dialog.

    fv5.5/tcltk/pow/Release_Notes0000644000220700000360000000210613224715127015121 0ustar birbylhea November 9, 2000: Release of POW (as part of fv3.0) * Scripting: added delete, remove, graph, contour, remote, wcs, init, cursor, and "colormap add"; expanded curve command to allow setting default parameters for curves not yet plotted/created. * Printing: fixed printing of line plots in color; image printing on Windows and Mac OS fixed with upgrade to tcl/tk 8.3.2; background no longer printed (was printed as white) and UI elements no longer obscure graph contents. * Tools: Added Ruler, Probe, and Profile tools... Ruler: Measures the distance between to points on a graph Probe: Calculates flux and centroid values for a region of an image Profile: Extracts an image cross-section and plots its intensity. * Redesigned region file handling to support new DS9 formats. * Make use of WCS transform matrices. * Added user-selectable default graph size and made this argument optional for powCreateGraph function. * Tick labels on graphs with celestial coordinates adjust their precision according to current range. fv5.5/tcltk/pow/Ruler.html0000644000220700000360000000134313224715130014421 0ustar birbylhea Measure the distance

    Measure the distance

    User can use this simple tool to measure the distance between two points in pixels or angle. When the measure dialog box is open, POW is in the "Ruler" mode. The user can place the mouse at the first point and click-and-drag to the second point with the right mouse button down. When the mouse button is released, the measured values will be shown on the dialog box. The user can also change the position of either end or move the whole ruler by click-and-drag the middle mouse with the left mouse. When the dialog box is closed, pow will return to the normal mode. fv5.5/tcltk/pow/Scripting.html0000644000220700000360000006031413224715130015275 0ustar birbylhea POW Scripting

    POW Scripting Guide

    Because fv and POW are written in Tcl, they are inherently scriptable. So long as one knows the necessary data structures and function calls, everything POW does can be controlled by a user-created Tcl script running inside of POW. This, however, is a formidable task. Plus, POW's internal behavior and data are subject to change with each new release.

    To make scripting possible, then, a simplified (and hence limited) script interface has been added to POW. It consists of a small set of commands which perform the basic operations of creating and modifying graphs. Future versions should contain more capabilities.

    Operational Summary

    There are several ways to access POW's scripting commands. The simplest is to write a Tcl script which uses the commands directly and then execute it within POW's powCmds namespace. As POW has no file capabilities nor command console of its own, this currently can be done only if implemented within an application containing POW, such as fv. (See fv's Scripting Guide for details on executing POW commands within fv.) This scripting method is useful for implementing macros which can perform certain common operations at the user's request, such as setting specific graph options.

    Alternatively, POW can be scripted by other programs, allowing those programs to make use of POW's capabilities remotely. These programs, however, do not need to be written in Tcl so long as they can communicate with POW. Currently POW supports XPA on unix platforms and AppleScript on MacOS for communication:

    The XPA messaging system (http://hea-www.harvard.edu/RD/xpa/) developed by the SAO/HEAD R&D group implements a method of communicating between two programs running on unix platforms. Communication occurs either through standalone programs (ie, xpaget and xpaset), a C subroutine library, or a Tcl extension. POW uses the Tcl extension to make its scripting commands available, but the calling program can use any of the XPA methods to access the commands. The XPA software is not distributed with POW or fv and must be obtained and built by the user.

    AppleScript (http://www.apple.com/applescript), the English-like language on all Macintosh computers (circa MacOS 7.5 and up), can also be used to control POW remotely. (Actually, any program on the Mac can control POW through the use of Apple Events.) Using the do script command, Tcl code can be passed to POW. Due to how Tcl's do script command and POW's scripting commands are implemented, POW commands must be prefixed with the powCmds:: namespace specifier.

    POW's scripting capabilities closely mimic the interface described in POW's Developer's Guide. In general, one first creates a data object from which either a curve or image is produced. One then creates a graph onto which a series of curves and/or images is placed. The graph size, position, and viewing region can then be modified as needed. Once plotted in a graph, curves and images can be displayed using different point shapes, line styles, or colormaps. In most cases, commands operate on the currently selected object (as appropriate).

    Many scripting commands also can be used as inquiries. Inquiries and commands are implemented using the same syntax, differing only in that commands supply the necessary parameters to perform an action, whereas inquiries leave them off indicating POW should return the current settings. When used with XPA, inquiries must use the xpaget tool and commands the xpaset tool.

    Command Summary

    add curve|image objName
    Add a curve or image to the current graph.
    array channel dataName bitpix ?byteOrder?
    Imports data into POW from a TCL channel. When run using XPA, channel is dropped and the data is read form stdin. bitpix indicates the data format of the binary data (eg., 8, -32, INT, DOUBLE, etc) and byteOrder indicates whether the data is stored in bigEndian or littleEndian format. The default value of byteOrder is whichever is native for the platform. FITS and IEEE are synonyms for bigEndian. If bitpix has the string value LIST, the data is read treated as an ASCII stream with double values. If dataName has a singular element, all values in the table are placed into a single data object with the supplied name. If dataName is instead a list, the stream will be considered as a columnar table with each column going into a corresponding data element of dataName.
    axes xscale ?yscale?
    Sets axes as log or linear. If only one value applied it will be applied to both axes.
    bounds xLft yBtm xRgt yTop ?wcs|pixel?
    Set the bounding box of the current graph in either wcs (default) or pixel coordinates.
    bounds reset
    Reset the current graph's bounding box to its default values.
    bounds zoom xMag ?yMag?
    Increase or decrease the bounding box by the given magnification factors.
    calculate newDataName expression
    Perform a calculation on existing data objects
    close
    Close/Exit POW
    colorbar create
    create a colorbar of the current graph
    colorbar delete
    delete a colorbar of the current graph
    colormap cmap
    Set the colormap of images in the current graph
    colormap add cmap R G B R G B ...
    Add a custom colormap named cmap. The RGB values are given in triplets of integer values ranging over 0 to 255. Any number of triplets can be provided and will be scaled to the number of colors available on screen.
    colormap invert Yes|No
    Invert colormap of images
    colormap scale ?mode? ?min max?
    Set the colormap scaling mode and range of images
    contour ?-res n? ?-image imgName? crvName level1 ?level2 ...?
    Create a contour map of the current (or imgName) image. The result is a single curve object named crvName outlining regions of the image with intensities level1 etc. If -image is used to specify the image, the image does not need to be plotted in the current (or any other) graph. The -res option gives the image resolution to use in calculating the contour (default is 1); the image will be smoothed over this number of pixels square. The curve contour will not be plotted automatically; use add curve crvName to add it to the current graph.
    create data dataName dataList
    Create a data object with the supplied values.
    Note: to avoid hitting the limit on the command line length, use piped stdout command:
    echo dataList | create data dataName
    create curve curveName xDataName ?xeDataName? yDataName ?yeDataName?
    Create an X/Y curve object with or without errors from the supplied data objects.
    create image imageName dataName width height
    Create an image object of given dimensions and data object.
    create graph graphName curveList imageList ?width height?
    Create a graph with the given curves and images. width and height give the screen size of the graph in pixels (default is set in the Preferences panel). Either of the lists can have a value of NULL if no objects of that type are being used.
    cursor
    Wait for the user to click on the current graph then return the graph coordinates and mouse button pressed: x y button. A keypress will also be captured and returned in the place of button as its negative ASCII value (ie, -65 for A).
    curve ?-name crvName? param value ?param value? ...
    Set curve options. The currently-selected curve will be used if the -name option isn't specified; otherwise set options for the indicated curve. The curve crvName does not have to exist prior to executing this command, so options can be set before a curve is created and drawn. If crvName is "default", the value will apply to all curves not yet plotted. The available parameters and value types are: 
           pDisp     -->  boolean  -->  Display Points?
       pShape    -->  string   -->  Point shape (Cross, Diamond, Box,
                                       Octagon, Triangle, "Inv. Triangle")
       pSizeErr  -->  boolean  -->  Draw point the size of errorbars?
       pSize     -->  integer  -->  Size of point
       pFill     -->  boolean  -->  Fill in point, if an outline
       pColor    -->  color    -->  Color of points (any color name
                                       or #RRGGBB value)
   	       	             	  
       lDisp     -->  boolean  -->  Display line?
       lStyle    -->  dash     -->  Dash style of line (" " is solid, 
                                       "20" is 20-pixel dashes,
                                       "15 10 4 10" is Dash-dot, etc)
       lWidth    -->  integer  -->  Width of line
       lStep     -->  boolean  -->  Draw line as histogram?
       lBoxFill  -->  boolean  -->  Fill histogram boxes?
       lColor    -->  color    -->  Color of line (any color name
                                       or #RRGGBB value)
    delete ?-propogate? graph|image|curve|data objName
    Delete an object from POW, freeing any memory it occupied. Deleted curves and images will be removed from all graphs in which they are displayed. With the -propogate option, the contents of the object are also deleted, meaning all the curves and images in a graph, and the original data within an image or curve. Data which is still being used by a curve or image object, however, will not be deleted.
    graph ?-name graphName? param value ?param value? ...
    Set graph options. The currently-selected graph will be used if the -name option isn't specified; otherwise set options for the indicated graph. The graph graphName does not have to exist prior to executing this command, so options can be set before a graph is created and drawn. If graphName is "default", the value will apply to all future graphs. The available parameters and value types are: 
           bgcolor         -->  color     -->  Color behind graph (any color
                                              name or #RRGGBB value)
       xmargin         -->  integer   -->  Intergraph spacing; affects
       ymargin         -->  integer   -->     placement of new graphs
       xdimdisp        -->  integer   -->  Screen dimensions of graph;
       ydimdisp        -->  integer   -->     affects size of new graphs
       FixedAspect     -->  boolean   -->  Force identical horizontal
                                              and vertical scales for graph
                                              (defaults to yes if any
                                               images present)

       xlabel          -->  string    -->  Label for X axis
       ylabel          -->  string    -->  Label for Y axis
       xunits          -->  string    -->  Optional unit value for X axis
       yunits          -->  string    -->  Optional unit value for Y axis
       titleString     -->  string    -->  Title for graph
       titlePosition   -->  direction -->  Position around graph to place
                                              title... value is a string
                                              containing the letters n, e,
                                              w, s (for north, east, etc)
       titleAnchor     -->  direction -->  Position in title to place at
                                              the titlePosition... value is
                                              a string containing n, e, w, s.

       xNumTicks       -->  integer   -->  Scaling parameter for number of
       yNumTicks       -->  integer   -->     tick marks on each axis
                                              (default, 3; not 1-to-1)
       xTickScal       -->  string    -->  Scaling of tick marks along
       yTickScal       -->  string    -->     each axis: "linear" or "log".
                                              Graphs with WCS information
                                              ignore this and use ra/dec.
       xTickLength     -->  list      -->  Length of tick marks for each
       yTickLength     -->  list      -->     axis on each side of graph.
                                              Order is [lft rgt top bot]
                                              (default: "10 10 10 10")
       xLabelTicks     -->  list      -->  Boolean indicating whether ticks
       yLabelTicks     -->  list      -->     should be labels for each
                                              axis on each side of graph.
                                              Order is [lft rgt top bot]
                                              (default: "Yes No No Yes")
       tickLabels      -->  string    -->  Format for labeling ticks on
                                              graphs with WCS information:
                                              "degrees" or "decimal"
       tickFormatCmdX  -->  string    -->  Tcl command used in formatting
       tickFormatCmdY  -->  string    -->     tick values into labels
                                              (default: "format %.6lg")

       GridLines       -->  boolean   -->  Draw grid lines?
       GridColor       -->  color     -->  Grid color (any color name
                                              or #RRGGBB value)
       GridDash        -->  dash      -->  Grid dash pattern
                                              (" " is solid, "20" is
                                              20-pixel dashes, "15 10 4 10"
                                              is Dash-dot, etc)
    helpPage ?file?
    Open and display help file in html format. Two ways to do this: 
            1. xpaset -p pow helpPage file 
                - if file is not a full path file name, then it is assumed to be one
                  of the installed POW help file.
                - else, user needs to supply the full path name to the file.
        2. cat file | xpaset pow helpPage
    init ?nColors? ?cMode?
    Open and initialize pow's graphing window. If the window is already open, this does nothing.
    print ?-file filename? ?-landscape? ?-stretch? ?-multipage?
    Send all images on POW canvas to printer. Save all images if -file is supplied. 
            -file        : result file name. The extension of file name should indicates valid saved format
                       (i.e. filename.jpg).  Current valid formats are bmp, jpg, ps, ppm, png, pnm, and tiff.
        -landscape   : print/save result in landscape mode (default is portrait). 
        -stretch     : stretch the image to fit the page (default is no).
        -multipage   : one image per page (default is print/save on the same page/file)

        Note: The image needs to be displayed in POW in order to print or save.
    position ?offset? x y
    Moves current graph around the canvas. When offset is present, x and y are relative offsets from the current position.
    refresh
    Redraws current graph
    regionName region file name
    Set output region name, should be used after Region Edit Panel is opened.
    regionTool ?-open? ?-close? ?-wait?
    Open the Region Edit Panel on POW. 
              -open  : open the region edit panel
          -close : close the region edit panel
          -wait  : wait for region edit panel to close. Return save means data has been saved.
                                                        Return unsave means otherwise
    regions
    Open Region Edit Panel (if not opened already), displays input Region of Interest (ROI) on POW image and update entry in the Region Edit Panel. 
            example of usage: 
           cat file | xpaset pow regions
    remote ?clientXPA?
    Set the XPA access point of a client POW session to which all subsequent commands should be sent. Send an empty clientXPA to have commands executed locally. If the environment variable POW_LIBRARY is defined, its value will be used for clientXPA.
    remove ?-name graphName? curve|image objName
    Remove an object from the current graph or graphName.
    scope width ?height?
    Sets scope window size. If only one value is given, the scope window will be a square.
    select curve|image|graph objName
    Select a curve/image/graph for manipulation
    size width height
    Set graph size
    size stretch ?to? xMag ?yMag?
    Stretch graph size by the given magnification either relative to current magnification or an absolute magnification.
    tcl
    Execute tcl code read from stdin (XPA support only).
    version
    Return POW version number
    xrangeName file name
    Set output file name to save x axis ranges, should be used after X axis Range Edit Panel is opened.
    xrangeTool ?-open? ?-close? ?-wait?
    Open the X axis Range Edit Panel on POW. 
              -open  : open the x axis range edit panel
          -close : close the x axis range edit panel
          -wait  : wait for x axis range edit panel to close. Return save means data has been saved.
                                                              Return unsave means otherwise
    xranges
    Open X axis Range Edit Panel (if not opened already), displays input X axis Ranges of Interest (XROI) on POW image and update entry in the X axis Range Edit Panel. 
            example of usage: 
           cat file | xpaset pow xranges
    wcs objName wcsData
    Set (or get) WCS information for the given object (can be a curve or image). The wcsData is a list of the form of either
    • xrval yrval xrpix yrpix xinc yinc rot ctype ?swap?
    • refVals refPix matrix types projections
    If WCS information has not already been provided for objName the "get" version of this command will return an empty string. (See fitsTcl documention for more information.)

    Examples

    The following commands will create a graph in pow and plot 2 curves in it. 

      create data d1 1 2 3 4 5 6 5 4 3 2 1     # Create data object d1
  create data d2 1 4 9 16 20 16 9 4 2 1 1  # Create data object d2
  create curve c1 d1 d2                    # Create curve of d1 vs d2
  create graph g1 c1 NULL                  # Draw graph containing curve
  size 200 150                             # Resize graph to 200x150
  calculate d3 'd1*2'                      # Calculate new data object
  create curve c2 d3 d2                    # Create curve of d3 vs d2
  add curve c2                             # Add curve to graph
  bounds reset                             # Reset bounding box
  select curve c1                          # Select first curve
  curve pFill Yes pColor Blue lDisp No     # Set display options
  select curve c2                          # Select second curve
  curve pDisp No lColor Red lStyle 20      # Set display options

    Using XPA from a Unix shell, one would execute the above commands by doing the following: 

      xpaset -p pow create data d1 1 2 3 4 5 6 5 4 3 2 1
  xpaset -p pow create data d2 1 4 9 16 20 16 9 4 2 1 1
  xpaset -p pow create curve c1 d1 d2
  xpaset -p pow create graph g1 c1 NULL
  xpaset -p pow size 200 150
  xpaset -p pow calculate d3 d1*2
  xpaset -p pow create curve c2 d3 d2
  xpaset -p pow add curve c2
  xpaset -p pow bounds reset
  xpaset -p pow select curve c1
  xpaset -p pow curve pFill Yes pColor Blue lDisp No
  xpaset -p pow select curve c2
  xpaset -p pow curve pDisp No lColor Red lStyle 20
    The -p option tells xpaset to not read any data from stdin. One can instead use stdin to send a series of Tcl commands en masse by putting all the POW commands into a text file and pass them to POW, using the command... 
      cat commands.txt | xpaset pow tcl
    This second method allows one to insert real TCL commands (providing access to the entire POW API) into the command sequence, whereas the individual xpaget/xpaset calls are restricted to the specific scripting commands.

    Alternatively, if using AppleScript, the commands are... 

      tell application "fv"
    activate
    -- Because POW is available only as part of POW on Macs, the following
    -- line is needed to open POW's window, if it doesn't already exist
    do script "if { ![winfo exist .pow.pow] } { powInit .dummy }"
    do script "powCmds::create data d1 1 2 3 4 5 6 5 4 3 2 1"
    do script "powCmds::create data d2 1 4 9 16 20 16 9 4 2 1 1"
    do script "powCmds::create curve c1 d1 d2"
    do script "powCmds::create graph g1 c1 NULL"
    do script "powCmds::size 200 150"
    do script "powCmds::calculate d3 d1*2"
    do script "powCmds::create curve c2 d3 d2"
    do script "powCmds::add curve c2"
    do script "powCmds::bounds reset"
    do script "powCmds::select curve c1"
    do script "powCmds::curve pFill Yes pColor Blue lDisp No"
    do script "powCmds::select curve c2"
    do script "powCmds::curve pDisp No lColor Red lStyle 20"
  end tell
    Note that AppleScript will actually start fv if it isn't already running.

    Now that the graph is created, one can make inquiries with the following commands using XPA... 

      xpaget pow bounds         # Get the bounding box of current graph
  xpaget pow select graph   # Get name of the currently selected graph
  xpaget pow position       # Get position of the graph
  xpaget pow curve          # Get display options of current curve
  xpaget pow version        # Get pow version number
    ... or, using AppleScript... 
      set x to (do script "powCmds::bounds")
  set x to (do script "powCmds::select graph")
  set x to (do script "powCmds::position")
  set x to (do script "powCmds::curve")
  set x to (do script "powCmds::version")
    ... or, using an as-yet-missing interactive console... 
      bounds
  select graph
  position
  curve
  version

    Additional examples of scripting can be found in the sample_scripts directory within the fv distribution.

    fv5.5/tcltk/pow/Shape.tcl0000644000220700000360000011262513224715130014214 0ustar birbylhea######################################################################## # # class: Shape # # purpose: Draw a geometric shape on the canvas and allow the user # to drag or reshape it. # # usage: To create a shape on a canvas: # gShape canvas # To set its options use "setShape", "setCoords", "setColor", # and "setRotation", or the convience method "setFullShape". # # To have the shape use additional tags to which you can bind, # use "addTags". # # Messages will be passed to the shape's owner (via a callback) # when the shape changes. Become the shape's owner with the # "setOwner" method. Messages currently passed are: # shapeIsBeingModified (when user changes shape/coord/rot) # shapeHasChanged (when a series of changes ends) # shapeIsSelected (when a shape becomes selected) # ######################################################################## itcl::class Shape { constructor { canvas } {} destructor {} public { method draw {} method select {} method deselect {} method clippedPolygon {} method beginModification { {x 0} {y 0} } method finishModification {} method setClip { x1 y1 x2 y2 } method setScale { mx my } method setFullShape { shp crds rot} method setCoords { coords } method setShape { shape } method setRotation { rot } method setColor { clr } { set itsColor $clr } method setBoundaryClr { clr } { set itsBoundaryColor $clr } method setHandleClr { clr } { set itsHandleColor $clr } method setLineW { width } { set itsLineWidth $width } method getTag {} { return $itsTag } method getCanvas {} { return $itsCanvas } method getColor {} { return $itsColor } method getBoundaryClr {} { return $itsBoundaryColor } method getHandleClr {} { return $itsHandleColor } method getLineW {} { return $itsLineWidth } method setOwner { owner } { set itsOwner $owner } method getItsOwner {} { return $itsOwner } method getShape { } { return $itsShape } method getCoords { } { return $itsParams } method getRotation { } { return $itsRotation } method setStatic { axis } { if { $axis != "" } { set ${axis}StaticFlag "true" } } method addBoundaryLine { coords } method setDrawDeleteFlag { flag } { set drawDeleteRegionFlag $flag } method insertPt { index } method adjustPt { index x y } method rotatePt { x y } method shift { dx dy } method drag { x y } method setStartPoint { x y } method getPolygon { } method drawHandles { } method addTags { tags } method removeTags { tags } method notifyOwner { args } method enterLeaveShape { mode } } protected { variable itsParams {} variable itsRotation 0.0 variable itsShape "Circle" variable itsCanvas variable bumpDetect "false" variable drawDeleteRegionFlag "false" variable reverseFlag "false" variable xScale 1.0 variable yScale 1.0 variable itsBoundTag "" variable itsTag "" variable allTags "" variable itsOwner "" variable itsColor "black" variable itsBoundaryColor "red" variable itsHandleColor "green" variable itsLineWidth 1.0 variable itsIds {} variable isSelected 0 variable isBeingModified 0 variable itsRotationOffset variable clipRect {} variable ignoreClip 0 variable startX 0.0 variable startY 0.0 variable tmpIds {} variable yStaticFlag "false" method CircleToPoly { x0 y0 dx dy } method EllipseToPoly { x0 y0 dx dy angle } method BoxToPoly { x0 y0 dx dy angle } method PolyToPoly { descr } method PointToPoly { x0 y0 } } private { variable tmpAdjustPoint -1 method checkPolygonPoint { index } } } ######################################################################## # # gShape canvas # ######################################################################## proc gShape { args } { return [uplevel #0 Shape #auto $args] } ######################################################################## # # # ######################################################################## itcl::body Shape::constructor { canvas } { set itsCanvas $canvas set itsTag shp[namespace tail $this] $itsCanvas bind "$itsTag && DragAble" \ [itcl::code $this enterLeaveShape Enter] $itsCanvas bind "$itsTag && DragAble" \ [itcl::code $this enterLeaveShape Leave] $itsCanvas bind rgnHandle$itsTag \ "$itsCanvas configure -cursor sizing" $itsCanvas bind rgnHandle$itsTag \ "$itsCanvas configure -cursor \$powcursor" powBindBtn <> "$itsCanvas bind \"$itsTag && DragAble\"" \ [itcl::code $this beginModification %x %y] \ [itcl::code $this drag %x %y] \ [itcl::code $this finishModification] set allTags [list $itsTag shape DragAble] } itcl::body Shape::enterLeaveShape { mode } { global powLutButton powROIButton insideExistGraph if { $isBeingModified } return if { $mode=="Enter" } { set insideExistGraph true for { set i 0 } {$i < [llength $itsIds]} {incr i} { set currId [lindex $itsIds $i] set width [$itsCanvas itemcget $currId -width] if { $width == 1.0 } { $itsCanvas itemconfig $currId -width 1.9 } else { $itsCanvas itemconfig $currId -width $width } } $itsCanvas configure -cursor fleur event delete <> event delete <> set shape [getShape] if { $shape == "Polygon" } { event add <> } else { event add <> } event add <> event add <> event add <> event add <> } else { set insideExistGraph false for { set i 0 } {$i < [llength $itsIds]} {incr i} { set currId [lindex $itsIds $i] set width [$itsCanvas itemcget $currId -width] if { $width == 1.9 } { $itsCanvas itemconfig $currId -width 1.0 } else { set width [$itsCanvas itemcget $currId -width] } } if { $yStaticFlag == "true" } { set drawDeleteRegionFlag false } $itsCanvas configure -cursor $::powcursor event add <> event add <> # event delete <> # event delete <> # event delete <> event delete <> event add <> event add <> event add <> event add <> } } itcl::body Shape::destructor {} { if { [winfo exists $itsCanvas] } { if { [llength $itsIds] } { $itsCanvas delete $itsTag $itsCanvas delete boundary1$itsTag $itsCanvas delete boundary2$itsTag } if { $isSelected } { $itsCanvas delete rgnHandle$itsTag } } notifyOwner shapeHasDied } itcl::body Shape::notifyOwner { args } { if { $itsOwner!="" } { eval $itsOwner $this $args } } itcl::body Shape::clippedPolygon { } { set coords [getPolygon] if { ![llength $coords] } { return "" } if { $ignoreClip || ![llength $clipRect] } { return [list $coords] } # Find bounding box of polygon set xMin [lindex $coords 0] set yMin [lindex $coords 1] set xMax $xMin set yMax $yMin foreach [list x y] [lrange $coords 2 end] { if { $x < $xMin } { set xMin $x } elseif { $x > $xMax } { set xMax $x } if { $y < $yMin } { set yMin $y } elseif { $y > $yMax } { set yMax $y } } # Is polygon clipped by clipRect? foreach [list x1 y1 x2 y2] $clipRect {} if { $xMin > $x2 || $xMax < $x1 || $yMin > $y2 || $yMax < $y1 } { # poly is fully outside rectangle so is fully clipped return "" } elseif { $xMin >= $x1 && $xMax <= $x2 && $yMin >= $y1 && $yMax <= $y2 } { # poly is fully inside rectangle so no need to clip return [list $coords] } else { # poly overlaps rectangle bounds, so needs to be clipped set clipPoly [list $x1 $y1 $x1 $y2 $x2 $y2 $x2 $y1 $x1 $y1] return [powClipPolys $coords $clipPoly] } } itcl::body Shape::draw {} { global staticY regionParam set coords [clippedPolygon] if { $coords=="" } { catch { $itsCanvas delete boundary1$itsTag } err catch { $itsCanvas delete boundary2$itsTag } err $itsCanvas delete $itsTag set itsIds {} return } set newIds {} for { set i 0 } { $i < [llength $coords] } { incr i } { set coord [lindex $coords $i] set id [lindex $itsIds $i] if { $yStaticFlag == "true" } { incr i 3 set coord [lreplace $coord 1 1 $staticY] set coord [lreplace $coord 3 3 $staticY] if { [llength $coord] > 4 } { set coord [lreplace $coord 4 4 [lindex $coord 0]] set coord [lreplace $coord 5 5 $staticY] } } if { $id == "" || [$itsCanvas find withtag $id]=="" } { if { $yStaticFlag == "true" } { lappend newIds [eval $itsCanvas create line \ $coord -fill $itsColor -width $itsLineWidth \ -joinstyle miter -tags \$allTags] } else { lappend newIds [eval $itsCanvas create polygon \ $coord -outline $itsColor -fill {{}} -width $itsLineWidth \ -tags \$allTags] } } else { set width [$itsCanvas itemcget $id -width] eval $itsCanvas coords $id $coord catch { $itsCanvas itemconfigure $id -outline $itsColor } lappend newIds $id } } while { $i<[llength $itsIds] } { set id [lindex $itsIds $i] catch { $itsCanvas itemconfig $id -outline {} } lappend tmpIds $id incr i } set itsIds $newIds } itcl::body Shape::addTags { tags } { foreach t $tags { if { [lsearch $allTags $t]==-1 } { lappend allTags $t if { [llength $itsIds] } { $itsCanvas addtag $t withtag $itsTag } } } } itcl::body Shape::removeTags { tags } { foreach t $tags { set idx [lsearch $allTags $t] if { $idx != -1 } { set allTags [lreplace $allTags $idx $idx] if { [llength $itsIds] } { $itsCanvas dtag $itsTag $t } } } } itcl::body Shape::deselect {} { $itsCanvas delete rgnHandle$itsTag set isSelected 0 } itcl::body Shape::select {} { global currentRegionObj global currentSelectXRange global regionParam global propertyOrder drawHandles $itsCanvas raise $itsTag $itsCanvas raise rgnHandle$itsTag if { ! $isSelected } { set isSelected 1 notifyOwner shapeIsSelected if { [$currentRegionObj getOwner] == "powRegionOwner" } { powRegionResetPanelColor [getColor] [getHandleClr] } } else { if { [$currentRegionObj getOwner] == "powXRangeOwner" } { if {[info exists currentSelectXRange] && \ [getShape] != "Point" && $currentSelectXRange == [powGetCurrXRange] } { powXRangeResetPanelColor [getColor] [getHandleClr] [getBoundaryClr] [getLineW] unset currentSelectXRange } } else { } } if { [$currentRegionObj getOwner] == "powRegionOwner" } { set rgnIdx [$regionParam(rgns) selected] if { $rgnIdx >= 0 } { set rgn [$regionParam(rgns) rgnAtIndex $rgnIdx] set propertyOrder "Source" catch { set propertyOrder [$rgn getPropertyOrder] } } else { set propertyOrder "UNDEFINED" } if { $propertyOrder == "Background" } { $itsCanvas itemconfigure $itsIds -dash - } else { $itsCanvas itemconfigure $itsIds -dash {} } } } itcl::body Shape::drawHandles { } { global staticY handleColor global powRotation currimg readRegionFile $itsCanvas delete rgnHandle$itsTag set coords [getCoords] set shape [getShape] set rot [getRotation] if { $shape == "Point" } return if { $shape=="Polygon" || $shape == "Line" } { if { [info exists currimg] && [info exists powRotation($currimg)] } { if { ([info exists readRegionFile] && $readRegionFile == "true") || \ ([info exists itsRotationOffset] && $itsRotationOffset == "on") } { set itsRotationOffset "on" } else { set rot [expr $rot - $powRotation($currimg)] } } } if { $shape=="Line" || $shape=="Polygon" } { set start 0 set end [expr [llength $coords]-1] } else { set start 2 set end 3 } set x0 [lindex $coords 0] set y0 [lindex $coords 1] if { !$ignoreClip && [llength $clipRect] } { foreach [list bx1 by1 bx2 by2] $clipRect {} } else { foreach [list bx1 by1 bx2 by2] [list -32000 -32000 32000 32000] {} } # Create Move Point Handles if { $yStaticFlag == "true" } { set coords [lreplace $coords 1 1 $staticY] set coords [lreplace $coords 3 3 $staticY] if { [llength $coords] > 4 } { set coords [lreplace $coords 4 4 [lindex $coords 0]] set coords [lreplace $coords 5 5 $staticY] } setCoords $coords } set ptNum [expr $start/2] foreach {x y} [lrange $coords $start $end] { foreach {x y} [poly_rotate $x0 $y0 $rot [list $x $y] ] {} if { $x<$bx2 && $x>$bx1 && $y<$by2 && $y>$by1 } { set x1 [expr $x-2] set y1 [expr $y-2] set x2 [expr $x+2] set y2 [expr $y+2] set id [$itsCanvas create polygon $x1 $y1 $x1 $y2 $x2 $y2 $x2 $y1 \ -outline $itsHandleColor -fill {} \ -tags "rgnHandle$itsTag rgnMovePt rgnHandle"] powBindBtn <> "$itsCanvas bind $id" \ [itcl::code $this beginModification %x %y] \ [itcl::code $this adjustPt $ptNum %x %y] \ [itcl::code $this finishModification] powBindBtn <> "$itsCanvas bind $id" \ "[itcl::code $this beginModification %x %y]; [itcl::code $this insertPt $ptNum]" \ [itcl::code $this adjustPt $ptNum %x %y] \ [itcl::code $this finishModification] } incr ptNum } # Create Rotate Region Handle... only for Box and Ellipse if { $shape=="Box" || $shape=="Ellipse" } { set dx [expr [lindex $coords 2]-$x0] if { $shape=="Ellipse" } {set dx [expr 1.41421356*$dx]} set x [expr $x0+$dx] set y [lindex $coords 1] foreach {x y} [poly_rotate $x0 $y0 $rot [list $x $y] ] {} if { $x<$bx2 && $x>$bx1 && $y<$by2 && $y>$by1 } { set x1 [expr $x-2] set y1 [expr $y-2] set x2 [expr $x+2] set y2 [expr $y+2] set id [$itsCanvas create polygon $x1 $y2 $x2 $y2 $x $y1 \ -outline $itsHandleColor -fill {} \ -tags "rgnHandle$itsTag rgnRotate rgnHandle"] powBindBtn <> "$itsCanvas bind $id" \ [itcl::code $this beginModification %x %y] \ [itcl::code $this rotatePt %x %y] \ [itcl::code $this finishModification] } } if { $shape=="Polygon" } { event delete <> event add <> } else { event delete <> event add <> } } itcl::body Shape::setClip { x1 y1 x2 y2 } { if { $x1 > $x2 } { set tmp $x1 set x1 $x2 set x2 $tmp } if { $y1 > $y2 } { set tmp $y1 set y1 $y2 set y2 $tmp } set clipRect [list $x1 $y1 $x2 $y2] } itcl::body Shape::setScale { mx my } { set xScale $mx set yScale $my } itcl::body Shape::setShape { shape } { set itsShape $shape if { $isBeingModified } { notifyOwner shapeIsBeingModified } } itcl::body Shape::setRotation { rot } { set itsRotation $rot if { $isBeingModified } { notifyOwner shapeIsBeingModified } } itcl::body Shape::setCoords { coords } { global powDrawOriginalFlag set nelem [llength $coords] if { [expr $nelem%2] } { error "Shape coordinates must contain an even number of elements" } set itsParams $coords if { $isBeingModified } { # Pan, prevent infinit nesting via powDrawOriginalFlag if { ![info exists powDrawOriginalFlag] || $powDrawOriginalFlag != "true" } { notifyOwner shapeIsBeingModified } else { set powDrawOriginalFlag "false" } } } itcl::body Shape::setFullShape { shp crds rot } { setShape $shp setRotation $rot setCoords $crds } itcl::body Shape::insertPt { index } { # Can only insert points into a Polygon. Ignore all others if { [getShape] == "Polygon" } { set start [expr $index*2] set coords [getCoords] foreach {x y} [lrange $coords $start [expr $start+1] ] {} setCoords [linsert $coords $start $x $y] } } itcl::body Shape::adjustPt { index x y } { global xrangeList_onG staticY currentRegionObj bumpList bumpSelf splitList global powRotation currimg if { $bumpDetect == "true" && $drawDeleteRegionFlag == "false" } { return } set tmpAdjustPoint $index set origX [$itsCanvas canvasx $x] set origY [$itsCanvas canvasy $y] set start [expr $index*2] set end [expr $start+1] set coords [getCoords] set rot [getRotation] if { abs($rot)>1e-10 } { set x0 [lindex $coords 0] set y0 [lindex $coords 1] if { [getShape] =="Polygon" || [getShape] =="Line" } { if { [info exists currimg] && [info exists powRotation($currimg)] } { set rot [expr $rot - $powRotation($currimg)] } } foreach {x y} [poly_rotate $x0 $y0 \ [expr -$rot] [list $origX $origY]] {} } else { set x $origX set y $origY } switch [getShape] { "Point" { set coords [list $x $y $x $y] } "Box" { # Drawn/Sized to keep one corner fixed, so becomes complicated foreach {x0 y0 x2 y2} $coords {} set x1 [expr $x0-$x2+$x0] set y1 [expr $y0-$y2+$y0] if { abs($rot)>1e-10 } { foreach {x1 y1} [poly_rotate $x0 $y0 \ $rot [list $x1 $y1]] {} } set x0 [expr 0.5*($x1+$origX)] set y0 [expr 0.5*($y1+$origY)] if { abs($rot)>1e-10 } { foreach {x y} [poly_rotate $x0 $y0 \ [expr -$rot] [list $origX $origY]] {} } set coords [list $x0 $y0 $x $y] } "Circle" { # Need to set second point at 45 deg angle set x0 [lindex $coords 0] set y0 [lindex $coords 1] set dX [expr ($x0-$x)/$xScale] set dY [expr ($y0-$y)/$yScale] set dR [expr sqrt( 0.5*($dX*$dX + $dY*$dY) )] set x [expr $x0 + $dR*$xScale] set y [expr $y0 + $dR*$yScale] set coords [lreplace $coords 2 3 $x $y] } default { set coords [lreplace $coords $start $end $x $y] if { $yStaticFlag == "true" } { if { $start == 4 } { set coords [lreplace $coords 0 1 $x $y] } if { $start == 0 } { catch { set coords [lreplace $coords 4 5 $x $y] } } } } } set currMin [lindex $coords 0] set currMax [lindex $coords 2] set currDirection toRight if { $currMin > $currMax } { set currDirection toLeft set tmp $currMin set currMin $currMax set currMax $tmp } set bumpDetect false if { [info exists xrangeList_onG] && [$currentRegionObj getOwner] == "powXRangeOwner" } { set n 0 foreach checkRgnList $xrangeList_onG { set checkRgn [lindex $checkRgnList 1] set checkMin [lindex $checkRgn 0] set checkMax [lindex $checkRgn 2] set checkDirection toRight if { $checkMin > $checkMax } { set checkDirection toLeft set tmp $checkMin set checkMin $checkMax set checkMax $tmp } if { [llength $coords] <= 4 } { set coords [lappend coords [lindex $coords 0] [lindex $coords 1]] } if { $checkMin < $currMin && $checkMax > $currMax } { set bumpDetect true # even though we are using bumpSelf variable, the value is actually the one that is been bump into. set bumpSelf [list $n $checkRgn] set splitList $coords } elseif { $checkMin < $currMin && $checkMax > $currMin && $checkMax < $currMax } { # case 3: the new region is portion overlapping boundary of any previous region if { $drawDeleteRegionFlag == "true" } { set coords [lreplace $coords 2 2 $checkMax] set coords [lreplace $coords 5 5 $checkMax] set bumpSelf [list $n $checkRgn] set splitList $coords } else { if { $currDirection == "toRight" } { set coords [lreplace $coords 0 0 $checkMin] set coords [lreplace $coords 4 4 $checkMin] } else { set coords [lreplace $coords 2 2 $checkMin] set coords [lreplace $coords 5 5 $checkMin] } } lappend bumpList [lindex $checkRgnList 0] set bumpDetect true } elseif { $checkMin > $currMin && $checkMax > $currMax && $checkMin < $currMax } { # case 4: the new region is portion overlapping boundary of any previous region if { $drawDeleteRegionFlag == "true" } { set coords [lreplace $coords 2 2 $checkMin] set coords [lreplace $coords 5 5 $checkMin] set bumpSelf [list $n $checkRgn] set splitList $coords } else { if { $currDirection == "toRight" } { set coords [lreplace $coords 2 2 $checkMax] set coords [lreplace $coords 5 5 $checkMax] } else { set coords [lreplace $coords 0 0 $checkMin] set coords [lreplace $coords 4 4 $checkMin] } } lappend bumpList [lindex $checkRgnList 0] set bumpDetect true } incr n if { $bumpDetect == "true" } break } } setCoords $coords draw } itcl::body Shape::checkPolygonPoint { index } { set coords [getCoords] set npts [llength $coords] # Keep at least 2 points if { $npts <= 4 } return set start1 [expr $index*2] foreach [list x1 y1] [lrange $coords $start1 [expr $start1+1] ] {} set start0 [expr $start1-2] if {$start0<0} {set start0 [expr $npts-2]} foreach [list x0 y0] [lrange $coords $start0 [expr $start0+1] ] {} set dx [expr $x1-$x0] set dy [expr $y1-$y0] set r [expr $dx*$dx+$dy*$dy] if { $r<16 } { setCoords [lreplace $coords $start1 [expr $start1+1] ] } else { set start0 [expr $start1+2] if {$start0>=$npts} {set start0 0} foreach [list x0 y0] [lrange $coords $start0 [expr $start0+1] ] {} set dx [expr $x1-$x0] set dy [expr $y1-$y0] set r [expr $dx*$dx+$dy*$dy] if { $r<16 } { setCoords [lreplace $coords $start1 [expr $start1+1] ] } } } itcl::body Shape::beginModification { {x 0} {y 0} } { global xrangeList_onG bumpSelf currentRegionObj global currentSelectXRange set reverseFlag false if { $drawDeleteRegionFlag == "true" } { set color $itsColor set itsColor $itsHandleColor set itsHandleColor $color set reverseFlag true } set coords_b [getCoords] set currMin [lindex $coords_b 0] set currMax [lindex $coords_b 2] set currDirection toRight if { $currMin > $currMax } { set currDirection toLeft set tmp $currMin set currMin $currMax set currMax $tmp } set x [$itsCanvas canvasx $x] set y [$itsCanvas canvasy $y] if { [info exists xrangeList_onG] && [$currentRegionObj getOwner] == "powXRangeOwner" } { set n 0 foreach checkRgnList $xrangeList_onG { set checkRgn [lindex $checkRgnList 1] set checkMin [lindex $checkRgn 0] set checkMax [lindex $checkRgn 2] set checkDirection toRight if { $checkMin > $checkMax } { set checkDirection toLeft set tmp $checkMin set checkMin $checkMax set checkMax $tmp } if { $checkMin < $x && $x < $checkMax } { set currentSelectXRange [powGetCurrXRange] } if { $checkMin < $currMin && $checkMax > $currMax } { set bumpDetect true set bumpSelf [list "new" $coords_b] } incr n } } set startX $x set startY $y set ignoreClip 1 set isBeingModified 1 } itcl::body Shape::addBoundaryLine { coords } { global CpowXRangeY0 CpowXRangeY1 global CpowXRangeX0 CpowXRangeX1 if [info exists CpowXRangeY0] { catch { $itsCanvas delete boundary1$itsTag } catch { $itsCanvas delete boundary2$itsTag } set x0 [lindex $coords 0] set x1 [lindex $coords 2] if { $x0 > $CpowXRangeX0 && $x0 < $CpowXRangeX1 } { set idX0 [$itsCanvas create line $x0 $CpowXRangeY0 $x0 $CpowXRangeY1 \ -fill $itsBoundaryColor -tags boundary1$itsTag -width 1.0] lappend itsBoundTag $idX0 } if { $x1 > $CpowXRangeX0 && $x1 < $CpowXRangeX1 } { set idX1 [$itsCanvas create line $x1 $CpowXRangeY0 $x1 $CpowXRangeY1 \ -fill $itsBoundaryColor -tags boundary2$itsTag -width 1.0] lappend itsBoundTag $idX1 } } $itsCanvas raise rgnHandle$itsTag } itcl::body Shape::finishModification { } { global CpowXRangeY0 CpowXRangeY1 bumpList bumpSelf xrangeList_onG splitList currgn staticY global currentRegionObj if { $tmpAdjustPoint != -1 && [getShape]=="Polygon" } { # If adjusted point is too close to an adjacent point, delete it checkPolygonPoint $tmpAdjustPoint } if { $yStaticFlag == "true" } { set coords [getCoords] if { [lindex $coords 0] > [lindex $coords 2] } { set tmp [lindex $coords 0] set coords [lreplace $coords 0 0 [lindex $coords 2]] set coords [lreplace $coords 2 2 $tmp] setCoords $coords } if { [lindex $coords 0] == [lindex $coords 2] } { # one click set drawDeleteRegionFlag "false" if { $reverseFlag == "true" } { set color $itsColor set itsColor $itsHandleColor set itsHandleColor $color } set bumpSelf [list "new" $coords] set bumpDetect true } } set tmpAdjustPoint -1 set ignoreClip 0 draw select foreach id $tmpIds { $itsCanvas delete $id } set tmpIds {} set isBeingModified 0 catch { notifyOwner shapeHasChanged } err if { [info exists splitList] && $drawDeleteRegionFlag == "true" } { set currentRegion [lindex [$currentRegionObj regions] end] powDeleteCurrXRange $currentRegion set coords [lindex $bumpSelf 1] catch { unset bumpList } catch { unset bumpSelf } set drawDeleteRegionFlag false set x0 [lindex $coords 0] if { [lindex $splitList 0] > [lindex $splitList 2] } { set x1 [lindex $splitList 2] } else { set x1 [lindex $splitList 0] } set x0_onG [lindex [powCanvasToGraph $currgn $x0 $staticY $itsCanvas] 0] set x1_onG [lindex [powCanvasToGraph $currgn $x1 $staticY $itsCanvas] 0] set firstList [format "%s %s" $x0_onG $x1_onG] catch { xrangeReadDataStr $firstList } err if { [lindex $splitList 0] > [lindex $splitList 2] } { set x0 [lindex $splitList 0] } else { set x0 [lindex $splitList 2] } set x1 [lindex $coords 2] set x0_onG [lindex [powCanvasToGraph $currgn $x0 $staticY $itsCanvas] 0] set x1_onG [lindex [powCanvasToGraph $currgn $x1 $staticY $itsCanvas] 0] set secondList [format "%s %s" $x0_onG $x1_onG] catch { xrangeReadDataStr $secondList } err # get rid of the original x range set n [lsearch -glob $xrangeList_onG [list * $coords]] if { $n >= 0 } { powDeleteCurrXRange [lindex [lindex $xrangeList_onG $n] 0] } catch { unset splitList } set currentRegion [lindex [$currentRegionObj regions] end] set n [lsearch -glob $xrangeList_onG [list $currentRegion "*"]] powSelectXRange $n } else { if { [info exists bumpList] && $drawDeleteRegionFlag == "false" } { for {set i 0} {$i < [llength $bumpList]} {incr i} { powDeleteCurrXRange [lindex $bumpList $i] catch { $itsCanvas delete boundary1shp[lindex $bumpList $i]} catch { $itsCanvas delete boundary2shp[lindex $bumpList $i]} } unset bumpList } set bumpDetect false if { [info exists bumpSelf] && $drawDeleteRegionFlag == "false" } { powDeleteCurrXRange -1 set coords [lindex $bumpSelf 1] if [info exists xrangeList_onG] { set n [lsearch -glob $xrangeList_onG [list * $coords]] if { $n >= 0 } { powSelectXRange $n } } unset bumpSelf } else { if { $yStaticFlag == "true" && $drawDeleteRegionFlag == "false" } { set coords [getCoords] addBoundaryLine $coords } if [info exists xrangeList_onG] { set coords [getCoords] set n [lsearch -glob $xrangeList_onG [list * $coords]] powSelectXRange $n } } } if { $reverseFlag == "true" } { set color $itsColor set itsColor $itsHandleColor set itsHandleColor $color for {set i 0} {$i <[llength $itsIds]} {incr i} { catch { $itsCanvas itemconfigure [lindex $itsIds $i] -outline $itsColor } err } catch { $itsCanvas itemconfigure rgnHandle$itsTag -outline $itsHandleColor } err } } itcl::body Shape::drag { x y } { set x [$itsCanvas canvasx $x] set y [$itsCanvas canvasy $y] set dx [expr $x - $startX] set dy [expr $y - $startY] shift $dx $dy set startX $x set startY $y set drawDeleteRegionFlag "false" } itcl::body Shape::setStartPoint { x y } { set startX $x set startY $y } itcl::body Shape::shift { dx dy } { global xrangeList_onG staticY currentRegionObj bumpList if { $bumpDetect == "true" } { return } set newParams {} set prevParams [getCoords] foreach [list x y] [getCoords] { set x [expr $x + $dx] set y [expr $y + $dy] lappend newParams $x $y } set currMin [lindex $newParams 0] set currMax [lindex $newParams 2] set currDirection toRight if { $currMin > $currMax } { set currDirection toLeft set tmp $currMin set currMin $currMax set currMax $tmp } set bumpDetect false if { [info exists xrangeList_onG] && [$currentRegionObj getOwner] == "powXRangeOwner" } { set selfIdx [lsearch -glob $xrangeList_onG [list * $prevParams]] set n 0 foreach checkRgnList $xrangeList_onG { # xrangeList_onG has the format of [list [list of coords]] set checkRgn [lindex $checkRgnList 1] set checkMin [lindex $checkRgn 0] set checkMax [lindex $checkRgn 2] set checkDirection toRight if { $checkMin > $checkMax } { set checkDirection toLeft set tmp $checkMin set checkMin $checkMax set checkMax $tmp } if { [llength $newParams] <= 4 } { set newParams [lappend newParams [lindex $newParams 0] [lindex $newParams 1]] } if { $selfIdx == $n } { set newRegionList [lindex $xrangeList_onG $n] set newRegionList [lreplace $newRegionList 1 1 $newParams] set xrangeList_onG [lreplace $xrangeList_onG $n $n $newRegionList] } elseif { ($checkMin < $currMin && $checkMax > $currMin && $checkMax < $currMax) } { # case 3: the new region is portion overlapping boundary of any previous region if { $currDirection == "toRight" } { set newParams [lreplace $newParams 0 0 $checkMin] set newParams [lreplace $newParams 4 4 $checkMin] } else { set newParams [lreplace $newParams 2 2 $checkMax] set newParams [lreplace $newParams 5 5 $checkMax] } lappend bumpList [lindex $checkRgnList 0] set bumpDetect true } elseif { $checkMin > $currMin && $checkMax > $currMax && $checkMin < $currMax } { # case 4: the new region is portion overlapping boundary of any previous region if { $currDirection == "toRight" } { set newParams [lreplace $newParams 2 2 $checkMax] set newParams [lreplace $newParams 5 5 $checkMax] } else { set newParams [lreplace $newParams 0 0 $checkMin] set newParams [lreplace $newParams 4 4 $checkMin] } lappend bumpList [lindex $checkRgnList 0] set bumpDetect true } incr n if { $bumpDetect == "true" } break } } setCoords $newParams draw } itcl::body Shape::rotatePt { x y } { set x [$itsCanvas canvasx $x] set y [$itsCanvas canvasy $y] set coords [getCoords] set dx [expr $x-[lindex $coords 0]] set dy [expr $y-[lindex $coords 1]] setRotation [expr -atan2($dy,$dx)*180.0/3.1415926535] draw } itcl::body Shape::getPolygon { } { set cnt 0 set coords [getCoords] foreach {x y} $coords { set x$cnt $x set y$cnt $y incr cnt } if { $cnt==0 } { return {} } if {$cnt>1} { set dx [expr $x1-$x0] set dy [expr $y1-$y0] } set rot [getRotation] switch [getShape] { Box { set coords [BoxToPoly $x0 $y0 $dx $dy $rot] } Circle { set coords [CircleToPoly $x0 $y0 $dx $dy] } Ellipse { set coords [EllipseToPoly $x0 $y0 [expr 1.41421356*$dx] \ [expr 1.41421356*$dy] $rot] } Polygon { set coords [PolyToPoly $coords] } Line { set coords [list $x0 $y0 $x1 $y1 $x0 $y0] } Point { set coords [PointToPoly $x0 $y0] } } return $coords } itcl::body Shape::CircleToPoly { x0 y0 dx dy } { global powPlotParam regionParam set xRad [expr $dx/$xScale] set yRad [expr $dy/$yScale] set radius [expr sqrt($xRad*$xRad + $yRad*$yRad)] set xRad [expr $radius*$xScale] set yRad [expr $radius*$yScale] set points "" foreach {x y} [circle] { set x [expr $xRad*$x+$x0] set y [expr $yRad*$y+$y0] lappend points $x $y } return $points } itcl::body Shape::EllipseToPoly { x0 y0 dx dy angle } { set points "" foreach {x y} [circle] { set x [expr $dx*$x+$x0] set y [expr $dy*$y+$y0] lappend points $x $y } if {[expr abs($angle)] < 1e-10} {return $points} return [poly_rotate $x0 $y0 $angle $points] } itcl::body Shape::BoxToPoly { x0 y0 dx dy angle } { set points "" foreach {x y} [square] { set x [expr $dx*$x+$x0] set y [expr $dy*$y+$y0] lappend points $x $y } if {[expr abs($angle)] < 1e-10} {return $points} return [poly_rotate $x0 $y0 $angle $points] } itcl::body Shape::PolyToPoly { descr } { lappend descr [lindex $descr 0] [lindex $descr 1] return $descr } itcl::body Shape::PointToPoly { x0 y0 } { global powPlotParam regionParam set halfxMag [expr 0.5*$xScale] set halfyMag [expr 0.5*$yScale] if {$halfxMag<1} {set halfxMag 1} if {$halfyMag<1} {set halfyMag 1} set x1 [expr $x0-$halfxMag] set y1 [expr $y0-$halfyMag] set x2 [expr $x0+$halfxMag] set y2 [expr $y0+$halfyMag] return "$x1 $y1 $x1 $y2 $x2 $y2 $x2 $y1 $x1 $y1" } ######### # # Object coordinates for primitive shapes # # generate a list of points for a circle. every 12 degrees should do set circle_points "" set cnvt [expr -3.1415926535 / 180.0] for {set i 0} {$i <= 360} {incr i 12} { lappend circle_points [expr cos($i * $cnvt)] lappend circle_points [expr sin($i * $cnvt)] } # return coords of unit circle, radius 1 at the origin proc circle {} { global circle_points return $circle_points } # return coords of square (bounding box of unit circle) proc square {} { return "1 1 1 -1 -1 -1 -1 1 1 1" } # rotate a polygon around x0 and y0, return new coordinates proc poly_rotate {x0 y0 angle coords} { set st [expr sin(-3.1415926535 * $angle / 180.0)] set ct [expr cos(-3.1415926535 * $angle / 180.0)] set result "" foreach {x y} $coords { lappend result [expr $ct*$x - $st*$y + $x0*(1.0 - $ct) + $y0*$st] lappend result [expr $st*$x + $ct*$y + $y0*(1.0 - $ct) - $x0*$st] } return $result } # # # ######################################################################## fv5.5/tcltk/pow/Tools.html0000644000220700000360000000236013224715130014430 0ustar birbylhea The POW tool menu

    The POW tool menu

    • Blink Images/Graphs: Through these two dialog boxes, you can blink (animate) multiple images in a single graph or multiple graphs on the POW canvas.
    • Region Files: Through this dialog box, you can create and edit region files using the mouse.
    • Contour Maps: Through this dialog box, you can create and edit contour maps of the current image.
    • Profile: Select a slice through an image and plot the pixel intensity along the slice.
    • Ruler: Measure the distance between two points in an image.
    • Image Probe: Select a region of an image and calculate flux and centroid data.
    • X Range: Select range to to restrict the analysis to only those photons that were detected within certain time intervals.
    fv5.5/tcltk/pow/Visu_Init.c0000644000220700000360000000364313224715130014524 0ustar birbylhea/* * Visu_Init.c * * This file contains interpreter initialization * functions. After the tkUnixInit.c file in the Tk4.1 distribution. * * Copyright (c) 1995-1996 Sun Microsystems, Inc. * Copyright (c) 1995-1996 The Regents of the University of California * Copyright (c) 1996 Pierre-Louis Bossart * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * */ #include "tkpict.h" /* globals linked with tcl variables */ int Private_Colormap = 0; int slice_nb = 0; int nb_slices = 1; /* * Default directory in which to look for libraries: */ #if !(defined(__WIN32__) || defined(macintosh)) static char defaultLibraryDir[200] = VISU_LIBRARY; #endif /* * The following string is the startup script executed in new * interpreters. It looks on disk in several different directories * for a script "visu.tcl" that is compatible with this version * of Visu. The visu.tcl script does all of the real work of * initialization. */ static char *initScript = "" ; int Visu_Init(interp) Tcl_Interp *interp; /* Interpreter for application. */ { #if !(defined(__WIN32__) || defined(macintosh)) const char *libDir; #endif #if !(defined(__WIN32__) || defined(macintosh)) /* create pict image format */ Tk_CreateImageType(&tkPictImageType); /* least current files first */ Tcl_LinkVar(interp,"has_plb_segment",(char*)&has_plb_segment,TCL_LINK_INT); #endif Tcl_LinkVar(interp,"slice_nb",(char*)&slice_nb,TCL_LINK_INT); Tcl_LinkVar(interp,"nb_slices",(char*)&nb_slices,TCL_LINK_INT); Tcl_LinkVar(interp,"Private_Colormap",(char*)&Private_Colormap,TCL_LINK_INT); #if !(defined(__WIN32__) || defined(macintosh)) libDir = Tcl_GetVar(interp, "visu_library", TCL_GLOBAL_ONLY); if (libDir == NULL) { Tcl_SetVar(interp, "visu_library", defaultLibraryDir, TCL_GLOBAL_ONLY); } #endif return Tcl_Eval(interp, initScript); } fv5.5/tcltk/pow/Visu_colors.c0000644000220700000360000002713313224715130015122 0ustar birbylhea/* * colors.c -- * * A source file for Pict images * * Copyright (c) 1995 The Regents of the University of California. * * Author: Pierre-Louis Bossart * Date: November 17, 1995 * * Derived from tkImgPhoto.c in the tk4.0b2 distribution * copyrighted as follows: * * Copyright (c) 1994 The Australian National University. * Copyright (c) 1994-1995 Sun Microsystems, Inc. * * Author: Paul Mackerras (paulus@cs.anu.edu.au), * Department of Computer Science, * Australian National University. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * */ #include "tkpict.h" extern XColor lut_colorcell_defs[256]; extern int ncolors; extern int lut_start; static int Default_Shared_Allocated = 0; static int Default_Screen_Allocated = 0; static int Default_Private_Allocated = 0; int Pow_Allocated = 0; static PictColorTable *DefaultSharedColorTable; static PictColorTable *DefaultScreenColorTable; static PictColorTable *DefaultPrivateColorTable; extern PictColorTable *PowColorTable; /* *---------------------------------------------------------------------- * * DitherInstance -- * * This procedure is called to update an area of an instance's * pixmap by dithering the corresponding area of the master. * * Results: * None. * * Side effects: * The instance's pixmap gets updated. * *---------------------------------------------------------------------- */ void DitherInstance(instancePtr, xStart, yStart, width, height) PictInstance *instancePtr; /* The instance to be updated. */ int xStart, yStart; /* Coordinates of the top-left pixel in the * block to be dithered. */ int width, height; /* Dimensions of the block to be dithered. */ { PictMaster *masterPtr; PictColorTable *colorTable; XImage *imagePtr; int nLines; int i, c, x, y; int xEnd, yEnd; int bitsPerPixel, bytesPerLine, lineLength; unsigned char *srcLinePtr, *srcPtr; unsigned char *destBytePtr, *dstLinePtr; pixel *destLongPtr; #ifdef DEBUG printf("DitherInstance\n"); #endif masterPtr = instancePtr->masterPtr; colorTable = instancePtr->colorTable; /* * First work out how many lines to do at a time, * then how many bytes we'll need for pixel storage, * and allocate it. */ nLines = (MAX_PIXELS + width - 1) / width; if (nLines < 1) { nLines = 1; } if (nLines > height ) { nLines = height; } imagePtr = instancePtr->imagePtr; if (imagePtr == NULL) { return; /* we must be really tight on memory */ } bitsPerPixel = imagePtr->bits_per_pixel; bytesPerLine = ((bitsPerPixel * width + 31) >> 3) & ~3; imagePtr->width = width; imagePtr->height = nLines; imagePtr->bytes_per_line = bytesPerLine; imagePtr->data = (char *) ckalloc((unsigned) (imagePtr->bytes_per_line * nLines)); if( imagePtr->data == NULL ) { (void)fprintf(stderr,"DitherInstance: ckalloc failed \n"); return; } lineLength = masterPtr->width; srcLinePtr = masterPtr->bytedata + (yStart + height - 1) * lineLength + xStart; xEnd = xStart + width; if (bitsPerPixel > 1) { /* * Loop over the image, doing at most nLines lines before * updating the screen image. */ for (; height > 0; height -= nLines) { if (nLines > height) { nLines = height; } dstLinePtr = (unsigned char *) imagePtr->data; yEnd = yStart + nLines; for (y = yStart; y < yEnd; ++y) { srcPtr = srcLinePtr; destBytePtr = dstLinePtr; destLongPtr = (pixel *) dstLinePtr; for (x = xStart; x < xEnd; ++x) { c = srcPtr[0]; srcPtr += 1; if (c < 0) { c = 0; } else if (c > 255) { c = 255; } i = colorTable->redValues[c]; switch (bitsPerPixel) { case NBBY: *destBytePtr++ = i; break; case NBBY * sizeof(pixel): *destLongPtr++ = i; break; default: XPutPixel(imagePtr, x - xStart, y - yStart, (unsigned) i); } } srcLinePtr -= lineLength; dstLinePtr += bytesPerLine; } /* Update the pixmap for this instance with the block of pixels that we have just computed. */ XPutImage(instancePtr->display, instancePtr->pixels, instancePtr->gc, imagePtr, 0, 0, xStart, yStart, (unsigned) width, (unsigned) nLines); yStart = yEnd; } } ckfree(imagePtr->data); imagePtr->data = NULL; } /* end DitherInstance */ int GetColorTable(Tk_Window tkwin, PictColorTable **colorTable, XVisualInfo **visInfoPtr) { Display *disp; Colormap cmap; int ncolors; int lut_start; char colormap_level; char atom = 0; static int gave_message=0; disp = Tk_Display(tkwin); (*visInfoPtr) = get_visual(disp); if ((*visInfoPtr) == NULL) { (void)fprintf (stderr,"GetColorTable: No PseudoColor visuals found . \n"); exit (0); } colormap_level = Private_Colormap; /* first make sure the default Display is PseudoColor */ if( ((*visInfoPtr)->visual != DefaultVisual(disp,DefaultScreen(disp))) && (colormap_level < DEFAULT_PRIVATE_COLORMAP) ) { (void)fprintf (stderr, "ERROR: Default Display is not PseudoColor \n Allocating a Shareable Private Colormap instead \n"); colormap_level = DEFAULT_PRIVATE_COLORMAP; } /* shared colormap */ if(colormap_level == READ_SHARED_COLORMAP) { if( Default_Shared_Allocated == 0 ) { if( !init_colors(disp,&cmap,(*visInfoPtr), &colormap_level,&ncolors,&lut_start,&atom,tkwin) ) { (void)fprintf (stderr, "ERROR: no shared colormap exists.\n"); (void)fprintf (stderr, "Using the default colormap instead \n"); colormap_level = DEFAULT_SCREEN_COLORMAP; } else { if( !AllocateColorTable((PictColorTable **)&DefaultSharedColorTable, disp,cmap,colormap_level,ncolors,lut_start,atom) ) return 0; else { Default_Shared_Allocated = 1; *colorTable = DefaultSharedColorTable; } } } else { /* use existing color table */ DefaultSharedColorTable->refCount ++; *colorTable = DefaultSharedColorTable; } } /* end shared colormap*/ /* default screen colormap */ if(colormap_level == DEFAULT_SCREEN_COLORMAP) { if( Default_Screen_Allocated == 0 ) { if( !init_colors(disp,&cmap,(*visInfoPtr), &colormap_level,&ncolors,&lut_start,&atom,tkwin) ) { /* from deway garett: eliminate multiple messages on stderr:*/ if (!gave_message) { gave_message=1; (void)fprintf(stderr,"ERROR: not enough colors in screen Default Colormap\n"); (void)fprintf(stderr,"Creating a default private colormap instead \n"); } colormap_level = DEFAULT_PRIVATE_COLORMAP; } else { if( !AllocateColorTable((PictColorTable **)&DefaultScreenColorTable, disp,cmap,colormap_level,ncolors,lut_start,atom) ) return 0; else { Default_Screen_Allocated = 1; *colorTable = DefaultScreenColorTable; } } } else { /* use existing color table */ DefaultScreenColorTable->refCount += 1; *colorTable = DefaultScreenColorTable; } } /* end default screen colormap */ /* shared private colormap */ if(colormap_level == DEFAULT_PRIVATE_COLORMAP) { if( Default_Private_Allocated == 0 ) { if( !init_colors(disp,&cmap,(*visInfoPtr), &colormap_level,&ncolors,&lut_start,&atom,tkwin) ) { (void)fprintf(stderr,"init_colors failed \n"); return 0; } else { if( !AllocateColorTable((PictColorTable **)&DefaultPrivateColorTable, disp,cmap,colormap_level,ncolors,lut_start,atom) ) return 0; else { Default_Private_Allocated = 1; *colorTable = DefaultPrivateColorTable; } } } else { /* use existing color table */ DefaultPrivateColorTable->refCount += 1; *colorTable = DefaultPrivateColorTable; } } /* end shared private colormap */ /* private colormap */ if(colormap_level == NEW_PRIVATE_COLORMAP) { if( !init_colors(disp,&cmap,(*visInfoPtr), &colormap_level,&ncolors,&lut_start,&atom,tkwin) ) { (void)fprintf(stderr,"init_colors failed \n"); return 0; } else { if( !AllocateColorTable((PictColorTable **)colorTable, disp,cmap,colormap_level,ncolors,lut_start,atom) ) return 0; } } /* end private colormap */ /* POW colormap */ if(colormap_level == POW_COLORMAP) { if( Pow_Allocated == 0 ) { if( !init_colors(disp,&cmap,(*visInfoPtr), &colormap_level,&ncolors,&lut_start,&atom,tkwin) ) { (void)fprintf(stderr,"init_colors failed \n"); return 0; } else { if( !AllocateColorTable((PictColorTable **)&PowColorTable, disp,cmap,colormap_level,ncolors,lut_start,atom) ) return 0; else { Pow_Allocated = 1; *colorTable = PowColorTable; } } } else { /* use existing color table */ PowColorTable->refCount ++; *colorTable = PowColorTable; } } /* end POW colormap */ /* change default back to screen colormap. This is useless in visu, since the scripts always check for the colormap level of the current image. This might be useful in the future though */ /* Private_Colormap = DEFAULT_SCREEN_COLORMAP;*/ /* set window attributes */ if( Tk_SetWindowVisual(tkwin, (*visInfoPtr)->visual,(*visInfoPtr)->depth, (*colorTable)->colormap) == 0 ){ /* window already exists. See if the new colormap can be installed */ /* if(((*visInfoPtr)->visual == (((Tk_FakeWin *)(tkwin)))->visual) && ((*visInfoPtr)->depth == (((Tk_FakeWin *)(tkwin)))->depth)) { */ /*Let's try not doing any testing, HPUX barfs if we do*/ Tk_SetWindowColormap(tkwin,(*colorTable)->colormap); /* } else { (void)fprintf(stderr,"Window already exists with Visual class %d and depth %d. Change the Tk script to create image widget with PseudoColor 8 visual\n", ((Tk_FakeWin *)(tkwin))->visual->class, ((Tk_FakeWin *)(tkwin))->depth); return 0; } */ } else { /* The visual was set, but the colormap needs to be installed. The window managers should do it but for now let's do it ourselves */ /* Tk_SetWindowColormap(tkwin,(*colorTable)->colormap); */ } return 1; } int DisposeColorTable(PictColorTable *colorTable) { unsigned long *pixels; int i,j; /* if still instances using colorTable *or* if using POW Colormap, don't do this. pict images in POW use the POW windows colormap. Once allocated, the POW colorTable should remain (as far as VISU is concerned). The Pow colorTable is handled in PowCleanUp if POW is exitted. */ if(colorTable->refCount != 0 || colorTable->colormap_level == POW_COLORMAP) return 0; /* destroy atom */ if(colorTable->atom == 1) deinit_disp(colorTable->display); if(colorTable->colormap_level > READ_SHARED_COLORMAP) { pixels = (unsigned long *)ckalloc(colorTable->ncolors* sizeof(unsigned long)); if( pixels == NULL ) return 0; /* create pixel array */ for(j=colorTable->lut_start,i=0;incolors;i++,j++) pixels[i] = j; /* free colors */ XFreeColors(colorTable->display,colorTable->colormap, pixels,colorTable->ncolors,0); ckfree((void*)pixels); /* free colormap */ XFreeColormap(colorTable->display, colorTable->colormap); } if( colorTable->colormap_level == READ_SHARED_COLORMAP ) Default_Shared_Allocated = 0; if( colorTable->colormap_level == DEFAULT_SCREEN_COLORMAP) Default_Screen_Allocated = 0; else if( colorTable->colormap_level == DEFAULT_PRIVATE_COLORMAP ) Default_Private_Allocated = 0; ckfree((void*)colorTable); colorTable = NULL; return 1; } /* end DisposeColorTable */ fv5.5/tcltk/pow/Visu_generic.c0000644000220700000360000003637113224715130015241 0ustar birbylhea#include "tkpict.h" extern Tcl_Interp *interp; PictColorTable *PowColorTable; XColor lut_colorcell_defs[MAX_COLORS]; int byteLookup[MAX_LOOKUP]; double lastLookupMin=0.0, lastLookupMax=0.0; static int convert_block( void *in, int npts, int in_type, double *dispmin, double *dispmax, unsigned char *out, unsigned int *histo ); /***************************************************/ /* Wrappers to convert_block which will either */ /* convert the image data to bytes (translated */ /* using byteLookup[]) or calculate a histogram */ /* of the image data (of length MAX_LOOKUP). */ /***************************************************/ int convert_block_to_byte( void *in, unsigned char *out, int npts, int in_type, double *dispmin, double *dispmax ) { if( (lastLookupMin==0.0 && lastLookupMax==0.0) || (*dispmin==0.0 && *dispmax==0.0) ) { return convert_block( in, npts, in_type, dispmin, dispmax, out, NULL ); } else { return convert_block( in, npts, in_type, &lastLookupMin, &lastLookupMax, out, NULL ); } } int convert_block_to_histo( void *in, int npts, int in_type, double *dispmin, double *dispmax, unsigned int *histo ) { return convert_block( in, npts, in_type, dispmin, dispmax, NULL, histo ); } /***************************************************/ /* Internal routine called by above wrappers */ /***************************************************/ static int convert_block( void *in, int npts, int in_type, double *dispmin, double *dispmax, unsigned char *out, unsigned int *histo ) { register int i; double scale; unsigned char *ptr_out; double holder, maxLookup; if( histo ) for( i=0; i max ) max = *ptr; else if( *ptr < min ) min = *ptr; } *dispmin = min; *dispmax = max; ptr = (unsigned char *)in; } if( (*dispmax-*dispmin) == 0.0 ) { if( histo ) histo[ MAX_LOOKUP>>1 - 1 ] = npts; else if( out ) for( i=npts; i--; ) *ptr_out++ = 127; } else { scale = maxLookup / (*dispmax - *dispmin); for( i=npts; i--; ) { holder = scale * (*ptr++ - *dispmin); if( holder > maxLookup ) holder = maxLookup; else if( holder < 0.0 ) holder = 0.0; if( histo ) histo[ (int)holder ]++; else if( out ) *ptr_out++ = byteLookup[ (int)holder ]; } } } break; case WORD: { short *ptr = (short *)in; short min, max; if( (*dispmin == 0.0) && (*dispmax == 0.0) ) { min = max = *ptr++; for (i=1;i max ) max = *ptr; else if( *ptr < min ) min = *ptr; } *dispmin = min; *dispmax = max; ptr = (short *)in; } if( (*dispmax-*dispmin) == 0.0 ) { if( histo ) histo[ MAX_LOOKUP>>1 - 1 ] = npts; else if( out ) for( i=npts; i--; ) *ptr_out++ = 127; } else { scale = maxLookup / (*dispmax - *dispmin); for( i=npts; i--; ) { holder = scale * (*ptr++ - *dispmin); if( holder > maxLookup ) holder = maxLookup; else if( holder < 0.0 ) holder = 0.0; if( histo ) histo[ (int)holder ]++; else if( out ) *ptr_out++ = byteLookup[ (int)holder ]; } } } break; case LWORD: { int *ptr = (int *)in; int min, max; if( (*dispmin == 0.0) && (*dispmax == 0.0) ) { min = max = *ptr++; for (i=1;i max ) max = *ptr; else if( *ptr < min ) min = *ptr; } *dispmin = min; *dispmax = max; ptr = (int *)in; } if( (*dispmax-*dispmin) == 0.0 ) { if( histo ) histo[ MAX_LOOKUP>>1 - 1 ] = npts; else if( out ) for( i=npts; i--; ) *ptr_out++ = 127; } else { scale = maxLookup / (*dispmax - *dispmin); for( i=npts; i--; ) { holder = scale * (*ptr++ - *dispmin); if( holder > maxLookup ) holder = maxLookup; else if( holder < 0.0 ) holder = 0.0; if( histo ) histo[ (int)holder ]++; else if( out ) *ptr_out++ = byteLookup[ (int)holder ]; } } } break; case REAL: { float *ptr = (float *)in; float min, max; if( (*dispmin == 0.0) && (*dispmax == 0.0) ) { min = max = *ptr++; for (i=1;i max ) max = *ptr; else if( *ptr < min ) min = *ptr; } *dispmin = min; *dispmax = max; ptr = (float *)in; } if( (*dispmax-*dispmin) == 0.0 ) { if( histo ) histo[ MAX_LOOKUP>>1 - 1 ] = npts; else if( out ) for( i=npts; i--; ) *ptr_out++ = 127; } else { scale = maxLookup / (*dispmax - *dispmin); for( i=npts; i--; ) { holder = scale * (*ptr++ - *dispmin); if( holder > maxLookup ) holder = maxLookup; else if( holder < 0.0 ) holder = 0.0; if( histo ) histo[ (int)holder ]++; else if( out ) *ptr_out++ = byteLookup[ (int)holder ]; } } } break; case DOUBLE: { double *ptr = (double *)in; double min, max; if( (*dispmin == 0.0) && (*dispmax == 0.0) ) { min = max = *ptr++; for (i=1;i max ) max = *ptr; else if( *ptr < min ) min = *ptr; } *dispmin = min; *dispmax = max; ptr = (double*)in; } if( (*dispmax-*dispmin) == 0.0 ) { if( histo ) histo[ MAX_LOOKUP>>1 - 1 ] = npts; else if( out ) for( i=npts; i--; ) *ptr_out++ = 127; } else { scale = maxLookup / (*dispmax - *dispmin); for( i=npts; i--; ) { holder = scale * (*ptr++ - *dispmin); if( holder > maxLookup ) holder = maxLookup; else if( holder < 0.0 ) holder = 0.0; if( histo ) histo[ (int)holder ]++; else if( out ) *ptr_out++ = byteLookup[ (int)holder ]; } } } break; case LONGLONG: { #ifdef __WIN32__ __int64 *ptr = (__int64*)in; __int64 min, max; #else long long *ptr = (long long*)in; long long min, max; #endif if( (*dispmin == 0.0) && (*dispmax == 0.0) ) { min = max = *ptr++; for (i=1;i max ) max = *ptr; else if( *ptr < min ) min = *ptr; } *dispmin = min; *dispmax = max; #ifdef __WIN32__ ptr = (__int64*)in; #else ptr = (long long*)in; #endif } if( (*dispmax-*dispmin) == 0.0 ) { if( histo ) histo[ MAX_LOOKUP>>1 - 1 ] = npts; else if( out ) for( i=npts; i--; ) *ptr_out++ = 127; } else { scale = maxLookup / (*dispmax - *dispmin); for( i=npts; i--; ) { holder = scale * (*ptr++ - *dispmin); if( holder > maxLookup ) holder = maxLookup; else if( holder < 0.0 ) holder = 0.0; if( histo ) histo[ (int)holder ]++; else if( out ) *ptr_out++ = byteLookup[ (int)holder ]; } } } break; default: (void)fprintf(stderr,"Unknown data type %d\n",in_type); return(0); } return(1); } /* end convert_block */ void equalize_histo( void *in_data, int data_type, unsigned int totalPix, double *min, double *max ) { unsigned int histo[MAX_LOOKUP], excess; int color, level, done; double bin, pixbin, lvl; int bottBin, topBin; /* Calculate histogram */ done = 0; do { convert_block_to_histo(in_data, totalPix, data_type, min, max, histo); pixbin = (double)(totalPix - (totalPix>1?1:0)) / 256.0; if( pixbin>1.0 ) { /* Reduce the excessively abundant levels to a single binwidth */ pixbin *= 3.0; excess = 0; for( level=0; levelpixbin ) { excess += (unsigned int)((histo[level]-pixbin-0.5)); histo[level] = (unsigned int)(pixbin+0.5); } pixbin = (double)(totalPix - (totalPix>1?1:0) - excess) / 256.0; if( pixbin < 1.0 ) pixbin=1.0; } /* Create new color table */ bin = 0.0; for( level=color=0; level=pixbin && color<255 ) { bin -= pixbin; color++; } } while( level 5 ) bottBin = level-1; if( topBin < 0 && byteLookup[level] > 250 ) topBin = level; } if( topBin - bottBin < MAX_LOOKUP>>3 ) { if( bottBin > 0 ) bottBin--; if( topBin < MAX_LOOKUP-1 ) topBin++; lvl = (*max-*min)/(MAX_LOOKUP-1.0); if( topBin-bottBin>2 || lvl>1e-6*fabs(*min) ) { *max = topBin * lvl + *min; *min = bottBin * lvl + *min; } else done = 1; } else { done = 1; } } while( ! done ); } void build_lookup( int *x_lut, int *y_lut, int nbpts ) { int j; double slope; int curr_pt; curr_pt = 0; slope = 0.0; for( j=0; j 255 ) byteLookup[j] = 255; } else { byteLookup[j] = y_lut[curr_pt]; if( byteLookup[j] < 0 ) byteLookup[j] = 0; else if( byteLookup[j] > 255 ) byteLookup[j] = 255; /* remove vertical ramps */ while( curr_ptdisplay = disp; (*colorTable)->colormap = cmap; (*colorTable)->colormap_level = colormap_level; (*colorTable)->ncolors = ncolors; (*colorTable)->lut_start = lut_start; (*colorTable)->atom = atom; (*colorTable)->refCount = 1; color_nb = ncolors-1; for( i=0; iintensity_lut[i] = i; } /* load linear red green blue lookup tables */ for (i=0; ired_lut[i] = i; (*colorTable)->green_lut[i] = i; (*colorTable)->blue_lut[i] = i; } for (i = 0; i < MAX_COLORS; ++i) { r = i*color_nb/(MAX_COLORS-1)+lut_start; (*colorTable)->redValues[i] = lut_colorcell_defs[r].pixel; } /* Load the gray color pattern */ gray(disp,cmap,ncolors,lut_start,False, (*colorTable)->red, (*colorTable)->green, (*colorTable)->blue, (*colorTable)->intensity_lut, (*colorTable)->red_lut, (*colorTable)->green_lut, (*colorTable)->blue_lut); return 1; } /* end AllocateColorTable */ fv5.5/tcltk/pow/Visu_license.terms0000644000220700000360000000362113224715130016147 0ustar birbylheaThis software was partially funded by the U.S. Department of Energy under Contract No. W-7405-ENG-48. Release of this unclassified code was approved by LLNL ADPR&I Office under Code Release No. 960012. This software is copyrighted by the Regents of the University of California, Sun Microsystems, Inc., and other parties. The following terms apply to all files associated with the software unless explicitly disclaimed in individual files. The authors hereby grant permission to use, copy, modify, distribute, and license this software and its documentation for any purpose, provided that existing copyright notices are retained in all copies and that this notice is included verbatim in any distributions. No written agreement, license, or royalty fee is required for any of the authorized uses. Modifications to this software may be copyrighted by their authors and need not follow the licensing terms described here, provided that the new terms are clearly indicated on the first page of each file where they apply. IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. RESTRICTED RIGHTS: Use, duplication or disclosure by the government is subject to the restrictions as set forth in subparagraph (c) (1) (ii) of the Rights in Technical Data and Computer Software Clause as DFARS 252.227-7013 and FAR 52.227-19. fv5.5/tcltk/pow/Visu_lut.c0000644000220700000360000010565313224715130014431 0ustar birbylhea/* * lut.c -- * * A source file for Pict images * * Copyright (c) 1995 The Regents of the University of California. * * Author: Pierre-Louis Bossart * Date: November 17, 1995 * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * */ #include "tkpict.h" static int random_walk(int *color); void linear_lut(int *lut, Display *disp,Colormap cmap, int ncolors,int lut_start,char overlay, int *red,int *green,int *blue, int *intensity_lut,int *red_lut,int *green_lut, int *blue_lut) { int i,j; for (i=lut_start,j=0; j= lut_size ) lut[j] = lut_size-1; } else { lut[j] = y_lut[curr_pt]; if( lut[j] < 0 ) lut[j] = 0; else if( lut[j] >= lut_size ) lut[j] = lut_size-1; /* remove vertical ramps */ while( curr_pt 255) { /* Reflect off 255 */ *color = (2*255) - *color; } return( *color & 0xff ); } /* end random_walk */ void lut_ramp(int *lut,int begin,float beginv,int end,float endv) { int intensity, i ; float increment, value ; if ((begin < 0) || (begin > 255)) return; if ((end < 0) || (end > 255)) return; if ((beginv < 0.0) || (beginv > 1.0)) return; if ((endv < 0.0) || (endv > 1.0)) return; if (end == begin) { intensity = (int)(beginv * 255 + 0.5); lut[begin] = intensity ; return; } increment = (endv - beginv) / (end - begin) ; value = beginv ; for (i=begin; i<= end; i++) { intensity = (int)(value * 255 + 0.5); lut[i] = intensity ; value += increment ; } } /* end lut_ramp */ void set_hls(int *red,int *green,int *blue) { float H,L,S ; int r,g,b ; int n ; /* set background blue ... n=0 */ H = 0 ; L = 0.5 ; S = 0.5 ; convert_HLS_rgb(H,L,S,&r,&g,&b) ; red[0] = r ; green[0] = g ; blue[0] = b ; /* set red, orange, yellow, and green ranges */ for (n=1; n<=255; n++) { if (n < 64) { H = 105.0 ; L = (float)(0.3 + 0.00968 * (n - 1)); S = (float)(0.4 + 0.00645 * (n - 1)); } else if (n < 128) { H = 155.0 ; L = (float)(0.3 + 0.00952 * (n - 64)); S = (float)(0.4 + 0.00635 * (n - 64)); } else if (n < 192) { H = 190.0 ; L = (float)(0.3 + 0.00968 * (n - 128)); S = (float)(0.4 + 0.00645 * (n - 128)) ; } else { H = 240.0 ; L = (float)(0.3 + 0.00968 * (n - 192)); S = (float)(0.4 + 0.00645 * (n - 192)); } convert_HLS_rgb(H,L,S,&r,&g,&b) ; red[n] = r ; green[n] = g ; blue[n] = b ; } } /* end set_hls */ void convert_HLS_rgb(float H,float L,float S,int *r,int *g,int *b) { float R,G,B ; float M,m ; /* Setup equations */ if (L <= 0.5) M = L * (1 + S) ; else M = L + S - L*S ; m = 2*L - M ; /* Calculate R */ if (H < 60) R = (float)(m + (M - m) * (H/60.0)); else if (H < 180) R = M ; else if (H < 240) R = m + (M - m) * ((240 - H)/60) ; else R = m ; /* calculate G */ if (H < 120) G = m ; else if (H < 180) G = m + (M - m) * ((H - 120)/60) ; else if (H < 300) G = M ; else G = m + (M - m) * ((360 - H)/60) ; /* calculate B */ if (H < 60) B = M ; else if (H < 120) B = m + (M - m) * ((120 - H)/60) ; else if (H < 240) B = m ; else if (H < 300) B = m + (M - m) * (( H - 240)/60) ; else B = M ; /* scale R,G,B to 0-255 */ *r = (int)(255 * R); *g = (int)(255 * G); *b = (int)(255 * B); } /* end convert_HLS_rgb */ void hatgray(Display *disp,Colormap cmap, int ncolors,int lut_start,char overlay, int *red,int *green,int *blue, int *intensity_lut,int *red_lut,int *green_lut, int *blue_lut) { int tred[256],tgreen[256],tblue[256]; int i,j; /* compute the gray color map */ lut_ramp(red,0,(float)0.0,ncolors-1,(float)1.0) ; lut_ramp(green,0,(float)0.0,ncolors-1,(float)1.0) ; lut_ramp(blue,0,(float)0.0,ncolors-1,(float)1.0) ; /* Up ramp */ i = 0; for (j=1; j0; j-=2) { tred[i] = red[j]; tgreen[i] = green[j]; tblue[i] = blue[j]; i++; } for(i=0;i0; j-=2) { tred[i] = red[j]; tgreen[i] = green[j]; tblue[i] = blue[j]; i++; } for(i=0;i= hival ) return; if(loval < 0) loval = 0; if(hival>(MAX_COLORS-1)) hival = (MAX_COLORS-1); for (i=0; idepth; switch( *colormap_level ) { case READ_SHARED_COLORMAP: /* Get LUT start and length from other client */ status = readSharedColorAtom (disp,&cmap, &lut_start, &ncolors); if (status != Success) return 0; else break; /* we still need to set the argument pointers and free the memory allocated */ case DEFAULT_SCREEN_COLORMAP: cmap = DefaultColormap(disp, screenIndex); break; case DEFAULT_PRIVATE_COLORMAP: case NEW_PRIVATE_COLORMAP: /* Allocate our own colormap */ /* get 40 colors from default colormap to avoid flashing */ colormap_size = DisplayCells(disp,screenIndex); colors = (XColor*)ckalloc(colormap_size*sizeof(XColor)); for(i=0;ivisual, AllocNone); /* AllocAll doesn't work quite correctly for X11/NeWS 1.0 */ if (!cmap) { printf ("ERROR in init_colors: XCreateColormap returned %x\n", (unsigned int)cmap); return 0; } colormap_size = 40; XAllocColorCells(disp,cmap,True,plane_masks,0,pixels,colormap_size); XStoreColors(disp,cmap,colors,colormap_size); ckfree((void*)colors); break; case POW_COLORMAP: cmap = Tk_GetColormap(interp, tkwin, ".pow"); break; } /* end switch statement */ if( *colormap_level != READ_SHARED_COLORMAP ) { /* Try to get a set of contiguous color table entries for our use */ /* Decrement by 10 cells until we succeed */ if( depth >= 8 ) { tfGotColors = False; /* Will be set True when we succeed */ ncolors = 212; while (ncolors > 10) { status = XAllocColorCells(disp,cmap,True,plane_masks,0,pixels,ncolors); if (status != 0) { tfGotColors = True; /* Success. Break out of the while loop */ break; } ncolors -= 10; /* Failure. Decrement request and try again */ } /* End of while loop */ } else { (void)fprintf(stderr, "\nERROR in init_colors: Not enough graphics planes, depth is %d\n",depth) ; exit(0); } } if( *colormap_level != READ_SHARED_COLORMAP ) { if(tfGotColors == False) {/* Case 1: Got no colors */ ckfree((void*)plane_masks); plane_masks = NULL; ckfree((void*)pixels); pixels = NULL; return 0; } else if((depth == 8) && (ncolors < 50)) { /* Case 2: not enough colors */ /* Free the colors we got */ XFreeColors (disp, cmap, pixels, ncolors, 0); ckfree((void*)plane_masks); plane_masks = NULL; ckfree((void*)pixels); pixels = NULL; return 0; } else { /* Case 3: We got enough colors */ /* We got colors, but they may not be contiguous (SGI, for example...). * Find the endpoints of the set of contiguous colors ending at the top * value of those allocated, and use that segment. * Free up the rest of the allocated colors, if any. */ lutStartIndex = ncolors - 1; for (i=ncolors-1; i>0; i--) { if (pixels[i-1] != (pixels[i] - 1)) break; lutStartIndex = i-1; } lut_start = pixels[lutStartIndex]; lutEnd = pixels[ncolors-1]; ncolors = lutEnd - lut_start + 1; #ifdef DEBUG printf("lut start = %d nb colors %d \n",lut_start,ncolors); #endif /* Free the short, unused block of colors */ if (lutStartIndex != 0) { XFreeColors (disp, cmap, pixels, lutStartIndex, 0); } /* Send default lut data to server for other clients to use */ if( *colormap_level == DEFAULT_SCREEN_COLORMAP ) { writeSharedColorAtom (disp,cmap, lut_start, ncolors); *atom = 1; /* We wrote color atom, and should delete it when the colortable is disposed */ } } /* End of third case */ } for (color_def=lut_start; color_defdepth >= depth ) return(vis_found); } return(NULL); } /* end pick_visual */ XVisualInfo *get_visual(Display *disp) /* Pointer to list of matching visuals */ { XVisualInfo vTemplate; /* Template of the visual we want */ XVisualInfo *visualList; /* Pointer to list of matching visuals */ int visualsMatched; /* Number of visuals matched */ int screenIndex; int depth; XVisualInfo *vis_found,*vis_found1; #ifdef DEBUG printf("get_visual\n"); #endif screenIndex = DefaultScreen(disp); /* Screen index */ depth = 8; /* need at least 8 planes */ root_window = RootWindow(disp, screenIndex); /* Set up the template for getting visual info. Select some or all of these depending on the VisualMask. */ vTemplate.screen = screenIndex; vTemplate.class = PseudoColor; /* Find all PseudoColor visuals */ visualList = XGetVisualInfo (disp, VisualScreenMask | VisualClassMask, &vTemplate, &visualsMatched); if (visualList == NULL) { /* This is recoverable, so don't print a message to stderr (void)fprintf (stderr,"get_visual: No PseudoColor visuals found . \n"); */ return NULL; /* exit (0);*/ } if( (vis_found=pick_visual((XVisualInfo *)visualList,depth,visualsMatched)) == NULL) { /* This is recoverable, so don't print a message to stderr (void)fprintf (stderr,"get_visual: No PseudoColor visuals with depth at least 8 found . \n"); */ return NULL; /*exit (0);*/ } vTemplate.screen = vis_found->screen; vTemplate.class = vis_found->class; vTemplate.depth = vis_found->depth; vis_found1 = XGetVisualInfo (disp, VisualScreenMask | VisualClassMask | VisualDepthMask, &vTemplate, &visualsMatched); XFree(visualList); if( vis_found1 == NULL) { /* This is recoverable, so don't print a message to stderr (void)fprintf (stderr,"get_visual: No PseudoColor visuals with depth at least 8 found . \n"); */ return NULL; /*exit (0);*/ } return(vis_found1); } /* End of "get_visual" */ static void show_installed_colormaps(Display *disp) { Colormap *colorMapList; /* Pointer to list of installed colormaps */ int i; /* Local looping variable */ int num; /* Number of returned colormaps */ #ifdef DEBUG printf ("show_installed_colormaps\n"); #endif XFlush(disp) ; colorMapList = XListInstalledColormaps (disp, root_window, &num); XFlush(disp) ; printf ("Number of installed colormaps in root_window (%x) =%d\n", (unsigned int)root_window, num); for (i=0; iclass) { case PseudoColor: printf ("Visual class is PseudoColor\n"); break; case StaticColor: printf ("Visual class is StaticColor\n"); break; case DirectColor: printf ("Visual class is DirectColor\n"); break; case TrueColor: printf ("Visual class is TrueColor\n"); break; case GrayScale: printf ("Visual class is GrayScale\n"); break; case StaticGray: printf ("Visual class is StaticGray\n"); break; default: printf ("Visual class is not known\n"); break; } return; }/* end of "print_visual_class" */ /* Write the shared color atom to give info about the shared colorlut */ void writeSharedColorAtom (Display *disp,Colormap cmap,int lutStart,int nPC) { Atom colormapAtom; /* Atom for specifying colormap info to server */ struct XColorSharedStruct XColorShared; XColorShared.cmap = cmap; XColorShared.lutStart = lutStart; XColorShared.nPC = nPC; #ifdef DEBUG printf("writeSharedColorAtom\n"); #endif /* Post the colormap in atom VIEW_COLORMAP */ /* Create the atom */ colormapAtom = XInternAtom (disp, "VIEW_COLORMAP", False); if (colormapAtom == None) { #ifdef DEBUG (void)fprintf(stderr, "ERROR in writeSharedColorAtom: XInternAtom returned None (%d)\n", (int)colormapAtom); #endif return; } /* Store XColorShared in the atom */ XChangeProperty (disp, root_window, colormapAtom, XA_STRING, 8, PropModeReplace, (unsigned char*)&XColorShared, sizeof(XColorShared)); return; } /* End of "writeSharedColorAtom" */ /* Read the shared color atom to get information about the shared colorlut */ Status readSharedColorAtom (Display *disp, Colormap *cmap, /* The colormap ID */ int *lutStart, /* The first available LUT value */ int *nPC) /* The number of pseudocolor values used */ { Atom colormapAtom; /* Atom for specifying colormap info to server */ int status; Atom actualType; int actualFormat; unsigned long nitems; unsigned long bytesAfter; struct XColorSharedStruct *theColorShared=NULL; #ifdef DEBUG printf("readSharedColorAtom\n"); #endif /* Create the atom */ colormapAtom = XInternAtom (disp, "VIEW_COLORMAP", True); if (colormapAtom == None) { #ifdef DEBUG printf("ERROR in readSharedColorAtom: XInternAtom returned None (%d)\n", (unsigned int)colormapAtom); #endif cmap = NULL; *lutStart = *nPC = 0; return BadAtom; } status = XGetWindowProperty (disp, root_window, colormapAtom, 0L, 1000L, False, AnyPropertyType, &actualType, &actualFormat, &nitems, &bytesAfter,(unsigned char **)&theColorShared); if ((status == Success) && (theColorShared != NULL)) { *cmap = theColorShared->cmap; *lutStart = theColorShared->lutStart; *nPC = theColorShared->nPC; XFree (theColorShared); theColorShared=NULL; return status; } else { switch (status) { case Success: if (actualType == None) { /* printf ("actualType=None\n"); */ return BadAtom; } break; case BadAtom : printf("bad atom\n"); break; case BadMatch : printf("bad match\n"); break; case BadValue : printf("bad value\n"); break; case BadWindow : printf("bad window\n"); break; default: printf("bad other\n"); break; } /* End of switch (status) */ printf("ERROR in readSharedColorAtom: XGetWindowProperty returned %d\n", status); cmap = NULL; *lutStart = *nPC = 0; return status; } } /* End of readSharedColorAtom */ /* Destroy the shared colormap atom, in preparation to exit the program */ void destroySharedColorAtom(Display *disp) { Atom colormapAtom; /* Atom for specifying colormap info to server */ #ifdef DEBUG printf("destroySharedColorAtom\n"); #endif /* Create the atom */ colormapAtom = XInternAtom (disp, "VIEW_COLORMAP", True); if (colormapAtom == None) { printf("ERROR in destroySharedColorAtom: XInternAtom returned None (%d)\n", (int)colormapAtom); } /* Destroy the property, in preparation to exit */ XDeleteProperty (disp, root_window, colormapAtom); return; } /* End of "destroySharedColorAtom" */ fv5.5/tcltk/pow/Visu_tkImgPict.c0000644000220700000360000044277013224715130015524 0ustar birbylhea/* * tkImgPict.c -- * * A source file for Pict images * * Copyright (c) 1995 The Regents of the University of California. * * Author: Pierre-Louis Bossart * Date: November 17, 1995 * * Derived from tkImgPhoto.c in the tk4.0b2 distribution * copyrighted as follows: * * Copyright (c) 1994 The Australian National University. * Copyright (c) 1994-1995 Sun Microsystems, Inc. * * Author: Paul Mackerras (paulus@cs.anu.edu.au), * Department of Computer Science, * Australian National University. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * */ #include "tkpict.h" /* if PLB_SEGMENT is defined, then include the plb_segment include file */ #ifdef PLB_SEGMENT #include "plb_segment.h" int has_plb_segment = 1; #else int has_plb_segment = 0; #endif /* * Hash table used to provide access to Pict images from C code. */ static Tcl_HashTable imgPictHash; static int imgPictHashInitialized; /* set when Tcl_InitHashTable done */ static int ImgPictCreate _ANSI_ARGS_((Tcl_Interp *interp, char *name, int objc, Tcl_Obj *CONST objv[], Tk_ImageType *typePtr, Tk_ImageMaster master, ClientData *clientDataPtr)); static ClientData ImgPictGet _ANSI_ARGS_((Tk_Window tkwin, ClientData clientData)); static void ImgPictDisplay _ANSI_ARGS_((ClientData clientData, Display *display, Drawable drawable, int imageX, int imageY, int width, int height, int drawableX, int drawableY)); static void ImgPictFree _ANSI_ARGS_((ClientData clientData, Display *display)); static void ImgPictDelete _ANSI_ARGS_((ClientData clientData)); Tk_ImageType tkPictImageType = { "pict", /* name */ ImgPictCreate, /* createProc */ ImgPictGet, /* getProc */ ImgPictDisplay, /* displayProc */ ImgPictFree, /* freeProc */ ImgPictDelete, /* deleteProc */ NULL /* nextPtr */ }; /* * List of option names. The order here must match the order of * declarations of the OPT_* constants above. */ static char *optionNames[] = { "-format", "-from", "-shrink", "-subsample", "-to", "-zoom", (char *) NULL }; /* * Information used for parsing configuration specifications: */ static Tk_ConfigSpec configSpecs[] = { {TK_CONFIG_STRING, "-data", (char *) NULL, (char *) NULL, (char *) NULL, Tk_Offset(PictMaster, dataString), TK_CONFIG_NULL_OK}, {TK_CONFIG_STRING, "-format", (char *) NULL, (char *) NULL, (char *) NULL, Tk_Offset(PictMaster, format), TK_CONFIG_NULL_OK}, {TK_CONFIG_STRING, "-file", (char *) NULL, (char *) NULL, (char *) NULL, Tk_Offset(PictMaster, fileString), TK_CONFIG_NULL_OK}, {TK_CONFIG_INT, "-height", (char *) NULL, (char *) NULL, DEF_Pict_HEIGHT, Tk_Offset(PictMaster, userHeight), 0}, {TK_CONFIG_INT, "-width", (char *) NULL, (char *) NULL, DEF_Pict_WIDTH, Tk_Offset(PictMaster, userWidth), 0}, {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL, (char *) NULL, 0, 0} }; /* * Pointer to the first in the list of known Pict image formats. */ static Tk_PictImageFormat *formatList = NULL; /* * Forward declarations */ static int ImgPictCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int argc, const char **argv)); static int ParseSubcommandOptions _ANSI_ARGS_(( struct SubcommandOptions *optPtr, Tcl_Interp *interp, int allowedOptions, int *indexPtr, int argc, const char **argv)); static void ImgPictCmdDeletedProc _ANSI_ARGS_(( ClientData clientData)); static int ImgPictConfigureMaster _ANSI_ARGS_(( Tcl_Interp *interp, PictMaster *masterPtr, int argc, const char **argv, int flags)); static void ImgPictConfigureInstance _ANSI_ARGS_(( PictInstance *instancePtr)); static void ImgPictSetSize _ANSI_ARGS_((PictMaster *masterPtr, int width, int height)); static void ImgPictInstanceSetSize _ANSI_ARGS_(( PictInstance *instancePtr)); static int ImgPictCopy(Tcl_Interp *interp, PictMaster *masterPtr, int argc, const char **argv); static int ImgPictSnap2Photo(Tcl_Interp *interp, PictMaster *masterPtr, int argc, const char **argv); static int ImgPictSnap2Pict(Tcl_Interp *interp, PictMaster *masterPtr, int argc, const char **argv); static int MatchFileFormat _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Channel f, char *fileName, char *formatString, Tk_PictImageFormat **imageFormatPtr, int *widthPtr, int *heightPtr)); static int MatchStringFormat _ANSI_ARGS_((Tcl_Interp *interp, char *string, char *formatString, Tk_PictImageFormat **imageFormatPtr, int *widthPtr, int *heightPtr)); int convert_block_to_byte(void *in, unsigned char *out, int npts, int in_type,double *dispmin, double *dispmax); static int make_colorbar(Tk_PictHandle handle, int width,int height); static void normalize_data(PictMaster *masterPtr); static void get_line_pixels(char *string,unsigned char *img, int nr,int nc,int x1,int y1,int x2,int y2, double min, double max); static int ChangeColorTable(PictMaster *masterPtr); #ifdef PLB_SEGMENT static int ImgPictClip(Tcl_Interp *interp, PictMaster *masterPtr, int argc, char **argv); static int ImgPictThreshold(Tcl_Interp *interp, PictMaster *masterPtr, int argc, char **argv); static int ImgPictSmooth(Tcl_Interp *interp, PictMaster *masterPtr, int argc, char **argv); static int ImgPictGradient(Tcl_Interp *interp, PictMaster *masterPtr, int argc, char **argv); static int ImgPictLaplacian(Tcl_Interp *interp, PictMaster *masterPtr, int argc, char **argv); static int ImgPictZeroCrng(Tcl_Interp *interp, PictMaster *masterPtr, int argc, char **argv); static int ImgPictErosion(Tcl_Interp *interp, PictMaster *masterPtr, int argc, char **argv); static int ImgPictDilation(Tcl_Interp *interp, PictMaster *masterPtr, int argc, char **argv); static int ImgPictCloseHoles(Tcl_Interp *interp, PictMaster *masterPtr, int argc, char **argv); static int ImgPictGetHoles(Tcl_Interp *interp, PictMaster *masterPtr, int argc, char **argv); static int ImgPictDistanceTransform(Tcl_Interp *interp, PictMaster *masterPtr, int argc, char **argv); static int ImgPictLabel(Tcl_Interp *interp, PictMaster *masterPtr, int argc, char **argv); #endif /* *---------------------------------------------------------------------- * * Tk_CreatePictImageFormat -- * * This procedure is invoked by an image file handler to register * a new Pict image format and the procedures that handle the * new format. The procedure is typically invoked during * Tcl_AppInit. * * Results: * None. * * Side effects: * The new image file format is entered into a table used in the * Pict image "read" and "write" subcommands. * *---------------------------------------------------------------------- */ void Tk_CreatePictImageFormat(formatPtr) Tk_PictImageFormat *formatPtr; /* Structure describing the format. All of * the fields except "nextPtr" must be filled * in by caller. Must not have been passed * to Tk_CreatePictImageFormat previously. */ { Tk_PictImageFormat *copyPtr; #ifdef DEBUG printf("Tk_CreatePictImageFormat\n"); #endif copyPtr = (Tk_PictImageFormat *) ckalloc(sizeof(Tk_PictImageFormat)); if(copyPtr == NULL ) { (void)fprintf(stderr,"Tk_CreatePictImageFormat: Could not allocate memory\n"); return; } *copyPtr = *formatPtr; copyPtr->name = (char *) ckalloc((unsigned) (strlen(formatPtr->name) + 1)); if(copyPtr->name == NULL ) { (void)fprintf(stderr,"Tk_CreatePictImageFormat: Could not allocate memory\n"); return; } strcpy(copyPtr->name, formatPtr->name); copyPtr->nextPtr = formatList; formatList = copyPtr; } /* *---------------------------------------------------------------------- * * ImgPictCreate -- * * This procedure is called by the Tk image code to create * a new Pict image. * * Results: * A standard Tcl result. * * Side effects: * The data structure for a new Pict image is allocated and * initialized. * *---------------------------------------------------------------------- */ static int ImgPictCreate(interp, name, objc, objv, typePtr, master, clientDataPtr) Tcl_Interp *interp; /* Interpreter for application containing * image. */ char *name; /* Name to use for image. */ int objc; /* Number of arguments. */ Tcl_Obj *CONST objv[]; /* Argument strings for options (doesn't * include image name or type). */ Tk_ImageType *typePtr; /* Pointer to our type record (not used). */ Tk_ImageMaster master; /* Token for image, to be used by us in * later callbacks. */ ClientData *clientDataPtr; /* Store manager's token for image here; * it will be returned in later callbacks. */ { PictMaster *masterPtr; Tcl_HashEntry *entry; int isNew; int j, argc; const char **argv; #ifdef DEBUG printf("ImgPictCreate\n"); #endif /* Convert Tcl_Objs to char * */ argc = objc; argv = (const char **) ckalloc( argc * sizeof(char *) ); for( j=0; jtkMaster = master; masterPtr->interp = interp; masterPtr->imageCmd = Tcl_CreateCommand(interp, name, ImgPictCmd, (ClientData) masterPtr, ImgPictCmdDeletedProc); masterPtr->data = NULL; masterPtr->bytedata = NULL; masterPtr->instancePtr = NULL; masterPtr->validRegion = XCreateRegion(); masterPtr->dispmax = 0.0; masterPtr->dispmin = 0.0; masterPtr->user_dispmax = 0.0; masterPtr->user_dispmin = 0.0; masterPtr->pixel_x = 1.0; masterPtr->pixel_y = 1.0; /* * Process configuration options given in the image create command. */ if (ImgPictConfigureMaster(interp, masterPtr, argc, argv, 0) != TCL_OK) { ImgPictDelete((ClientData) masterPtr); ckfree( (char*) argv ); return TCL_ERROR; } /* * Enter this Pict image in the hash table. */ if (!imgPictHashInitialized) { Tcl_InitHashTable(&imgPictHash, TCL_STRING_KEYS); imgPictHashInitialized = 1; } entry = Tcl_CreateHashEntry(&imgPictHash, name, &isNew); Tcl_SetHashValue(entry, masterPtr); *clientDataPtr = (ClientData) masterPtr; ckfree( (char*) argv ); return TCL_OK; } /* *---------------------------------------------------------------------- * * ImgPictCmd -- * * This procedure is invoked to process the Tcl command that * corresponds to a Pict image. See the user documentation * for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int ImgPictCmd(clientData, interp, argc, argv) ClientData clientData; /* Information about Pict master. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ const char **argv; /* Argument strings. */ { PictMaster *masterPtr = (PictMaster *) clientData; int c, x, y; Tk_PictImageBlock block; char string[10000]; Tk_PictHandle srcHandle; size_t length; int pix_int; float pix_float; double pix_double; short *shortPtr; int *intPtr; float *floatPtr; double *doublePtr; int i; #ifdef DEBUG printf("ImgPictCmd\n"); #endif if (argc < 2) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " option ?arg arg ...?\"", (char *) NULL); return TCL_ERROR; } c = argv[1][0]; length = strlen(argv[1]); if ((c == 'b') && (strncmp(argv[1], "blank", length) == 0)) { /* * Pict blank command - just call Tk_PictBlank. */ if (argc == 2) { Tk_PictBlank(masterPtr); } else { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " blank\"", (char *) NULL); return TCL_ERROR; } return TCL_OK; } else if (c == 'c') { if( (strncmp(argv[1], "colorbar", length) == 0)) { make_colorbar((Tk_PictHandle)masterPtr, masterPtr->width,masterPtr->height); return TCL_OK; } else if( (strncmp(argv[1], "cget", length) == 0)) { if (argc != 3) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " cget option\"", (char *) NULL); return TCL_ERROR; } return Tk_ConfigureValue(interp, Tk_MainWindow(interp), configSpecs, (char *) masterPtr, argv[2], 0); } else if( (strncmp(argv[1], "configure", length) == 0)) { /* * Pict configure command - handle this in the standard way. */ if (argc == 2) { return Tk_ConfigureInfo(interp, Tk_MainWindow(interp), configSpecs, (char *) masterPtr, (char *) NULL, 0); } if (argc == 3) { return Tk_ConfigureInfo(interp, Tk_MainWindow(interp), configSpecs, (char *) masterPtr, argv[2], 0); } return ImgPictConfigureMaster(interp, masterPtr, argc-2, argv+2, TK_CONFIG_ARGV_ONLY); } else if( (strncmp(argv[1], "cmap_level", length) == 0)) { PictInstance *instancePtr; int cmap_level; if (argc != 2 && argc != 3) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " cmap_level [0|1|2|3] \"", (char *) NULL); return TCL_ERROR; } if( (instancePtr=masterPtr->instancePtr) == NULL ) { Tcl_AppendResult(interp, "No instance and no colors allocated yet", (char *) NULL); return TCL_ERROR; } if (argc == 2) { sprintf(string,"%d",instancePtr->colormap_level); Tcl_AppendResult(interp,string,(char *) NULL); } else { if(Tcl_GetInt(interp, argv[2], &cmap_level) != TCL_OK) { Tcl_AppendResult(interp, "Wrong arguments, should be: \"", argv[0], " cmap_level [0|1|2|3]\"", (char *) NULL); return TCL_ERROR; } if(cmap_level != READ_SHARED_COLORMAP && cmap_level != DEFAULT_SCREEN_COLORMAP && cmap_level != DEFAULT_PRIVATE_COLORMAP && cmap_level != NEW_PRIVATE_COLORMAP ) { Tcl_AppendResult(interp, "Wrong arguments, should be: \"", argv[0], " cmap_level [0|1|2|3]\"", (char *) NULL); return TCL_ERROR; } Private_Colormap = cmap_level; if( ChangeColorTable((PictMaster *)masterPtr) == 0 ) { Tcl_AppendResult(interp, "Could not change colormap level for active window", (char *) NULL); return TCL_ERROR; } } return TCL_OK; } else if( (strncmp(argv[1], "cmap_stretch", length) == 0)) { PictInstance *instancePtr; PictColorTable *colorTable; int cwid,clen; int x_lut[MAX_CLUT_LEN]; int y_lut[MAX_CLUT_LEN]; int i,j; int lut_size, nElem; const char **lutElem; int *p_lut; if( (instancePtr=masterPtr->instancePtr) == NULL ) return TCL_OK; if (argc != 6) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " cmap_stretch [intensity|red|green|blue] cwid clen {x1 y1 x2 y2 ...}\"", (char *) NULL); return TCL_ERROR; } else { colorTable = instancePtr->colorTable; length =strlen(argv[2]); if( (strncmp(argv[2], "intensity", length) == 0)) { p_lut = colorTable->intensity_lut; lut_size = colorTable->ncolors; } else if( (strncmp(argv[2], "red", length) == 0)) { p_lut = colorTable->red_lut; lut_size = MAX_COLORS; } else if( (strncmp(argv[2], "green", length) == 0)) { p_lut = colorTable->green_lut; lut_size = MAX_COLORS; } else if( (strncmp(argv[2], "blue", length) == 0)) { p_lut = colorTable->blue_lut; lut_size = MAX_COLORS; } else { Tcl_AppendResult(interp, "bad lookup table : should be \"", argv[0], " cmap_stretch [intensity|red|green|blue] cwid clen x1 y1 x2 y2 ... \"", (char *) NULL); return TCL_ERROR; } if((Tcl_GetInt(interp, argv[3], &cwid) != TCL_OK) || (Tcl_GetInt(interp, argv[4], &clen) != TCL_OK) ) { Tcl_AppendResult(interp, "bad lookup table : should be \"", argv[0], " cmap_stretch [intensity|red|green|blue] cwid clen {x1 y1 x2 y2 ... }\"", (char *) NULL); return TCL_ERROR; } if( Tcl_SplitList( interp, argv[5], &nElem, &lutElem ) != TCL_OK ) { Tcl_AppendResult(interp, "Error reading LUT", (char*)NULL); return TCL_ERROR; } if( nElem<4 || nElem&0x1 ) { Tcl_SetResult(interp,"LUT must have an even number of elements >= 4", TCL_VOLATILE); ckfree( (char*)lutElem ); return TCL_ERROR; } i = 0; j = 0; while(idisplay, instancePtr->colormap, colorTable->ncolors, colorTable->lut_start, instancePtr->has_overlay, colorTable->red,colorTable->green,colorTable->blue, colorTable->intensity_lut, colorTable->red_lut,colorTable->green_lut, colorTable->blue_lut); return TCL_OK; } } else if (strncmp(argv[1], "cmap_threshold", length) == 0) { double loval,hival; PictInstance *instancePtr; PictColorTable *colorTable; if (argc != 4) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " cmap_threshold x y\"", (char *) NULL); return TCL_ERROR; } if ((Tcl_GetDouble(interp, argv[2], &loval) != TCL_OK) || (Tcl_GetDouble(interp, argv[3], &hival) != TCL_OK)) { return TCL_ERROR; } if( masterPtr->instancePtr == NULL ) return TCL_OK; instancePtr = masterPtr->instancePtr; colorTable = instancePtr->colorTable; loval = (double)(loval - masterPtr->dispmin) * (double)(colorTable->ncolors) / (double)(masterPtr->dispmax - masterPtr->dispmin); hival = (hival - masterPtr->dispmin) * (double)(colorTable->ncolors) / (double)(masterPtr->dispmax - masterPtr->dispmin); lut_thres(instancePtr->display, instancePtr->colormap, colorTable->ncolors, colorTable->lut_start, instancePtr->has_overlay, floor(loval),ceil(hival), colorTable->red,colorTable->green,colorTable->blue, colorTable->intensity_lut, colorTable->red_lut,colorTable->green_lut, colorTable->blue_lut); return TCL_OK; } else if ( (strncmp(argv[1], "colormap", length) == 0)) { /* * Pict colormap command - first parse and check parameters. */ PictInstance *instancePtr; PictColorTable *colorTable; void (*f)(Display *display,Colormap cmap, int ncolors,int lut_start,char overlay, int *red,int *green,int *blue, int *intensity_lut,int *red_lut,int *green_lut, int *blue_lut); if (argc != 3) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " colormap cmap\"", (char *) NULL); return TCL_ERROR; } instancePtr = masterPtr->instancePtr; if( instancePtr == NULL ) return TCL_OK; colorTable = instancePtr->colorTable; if(strcmp(argv[2], "gray") == 0) f = gray; else if(strcmp(argv[2], "blkbdy") == 0) f = blkbdy; else if(strcmp(argv[2], "hot") == 0) f = hot; else if(strcmp(argv[2], "cold") == 0) f= cold; else if(strcmp(argv[2], "hls") == 0) f = hls; else if(strcmp(argv[2], "rgb") == 0) f = rgb; else if(strcmp(argv[2], "invert") == 0) f = invert_cmap; else if(strcmp(argv[2], "random") == 0) f = randwalk_spectrum; else if(strcmp(argv[2], "bowlerhat") == 0) f = bowlerhat; else if(strcmp(argv[2], "tophat") == 0) f = tophat; else if(strcmp(argv[2], "hatgray") == 0) f = hatgray; else if(strcmp(argv[2], "hatct") == 0) f = hatct; else if(strcmp(argv[2], "gray-ramp2") == 0) f = gray_ramp2; else if(strcmp(argv[2], "gray-ramp4") == 0) f = gray_ramp4; else if(strcmp(argv[2], "gray-step4") == 0) f = gray_step4; else if(strcmp(argv[2], "gray-step8") == 0) f = gray_step8; else if(strcmp(argv[2], "bgr-step") == 0) f = bgr_step; else if(strcmp(argv[2], "bgr-ramp") == 0) f = bgr_ramp; else if(strcmp(argv[2], "bgr-step2") == 0) f = bgr_step2; else if(strcmp(argv[2], "bgr-ramp2") == 0) f = bgr_ramp2; else if(strcmp(argv[2], "rygcbm-ramp") == 0) f = rygcbm_ramp; else if(strcmp(argv[2], "rygcbm-step") == 0) f = rygcbm_step; else if(strcmp(argv[2], "spectrum") == 0) f = spectrum2; else if(strcmp(argv[2], "inv_spec") == 0) f = inv_spec; else if(strcmp(argv[2], "color1") == 0) f = color1_lut; else if(strcmp(argv[2], "color2") == 0) f = color2_lut; else if(strcmp(argv[2], "color3") == 0) f = color3_lut; else { /* Try to find a user-specified cmap... */ char scrtch[200]; Tcl_Obj *lut; sprintf(scrtch,"cmapLUT_%s,powDef",argv[2]); lut = Tcl_ObjGetVar2(interp, Tcl_NewStringObj("powImageParam",-1), Tcl_NewStringObj(scrtch,-1), TCL_GLOBAL_ONLY); if( lut==NULL ) { sprintf(scrtch,"Unable to locate LUT for %s\n",argv[2]); Tcl_SetResult(interp,scrtch,TCL_VOLATILE); return TCL_ERROR; } return customCmap(instancePtr->display, instancePtr->colormap, colorTable->ncolors, colorTable->lut_start, instancePtr->has_overlay, colorTable->red,colorTable->green,colorTable->blue, colorTable->intensity_lut, colorTable->red_lut,colorTable->green_lut, colorTable->blue_lut, interp, lut); } (*f)(instancePtr->display, instancePtr->colormap, colorTable->ncolors, colorTable->lut_start, instancePtr->has_overlay, colorTable->red,colorTable->green,colorTable->blue, colorTable->intensity_lut, colorTable->red_lut,colorTable->green_lut,colorTable->blue_lut); return TCL_OK; } else if( (strncmp(argv[1], "copy", length) == 0)) { return ImgPictCopy(interp,masterPtr,argc,argv); } #ifdef PLB_SEGMENT else if ( (strncmp(argv[1], "clip", length) == 0)) { return ImgPictClip(interp,masterPtr,argc,argv); } else if ( (strncmp(argv[1], "close_holes", length) == 0)) { return ImgPictCloseHoles(interp,masterPtr,argc,argv); } else if (strncmp(argv[1], "convert", length) == 0) { PictMaster *srcMasterPtr; void *buff; int npts; int datatype,datasize; if(argc!=5) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " convert srcImg -type [byte|short|int|float] \"", (char *) NULL); return TCL_ERROR; } length = strlen(argv[3]); if (strncmp(argv[3], "-type", length) != 0) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " convert srcImg -type [byte|short|int|float]\"", (char *) NULL); return TCL_ERROR; } length = strlen(argv[4]); if ((strncmp(argv[4], "byte", length) != 0) && (strncmp(argv[4], "short", length) != 0) && (strncmp(argv[4], "int", length) != 0) && (strncmp(argv[4], "float", length) != 0)) { Tcl_AppendResult(interp, "bad type : should be \"", argv[0], " convert srcImg -type [byte|short|int|float]\"", (char *) NULL); return TCL_ERROR; } if ((srcHandle = Tk_FindPict(argv[2])) == NULL) { Tcl_AppendResult(interp, "image \"", argv[2], "\" doesn't", " exist or is not a Pict image", (char *) NULL); return TCL_ERROR; } srcMasterPtr = (PictMaster *)srcHandle; /* set new type */ if (strcmp(argv[4],"byte") == 0) { datatype = BYTE; datasize = sizeof(unsigned char); } else if(strcmp(argv[4],"short") == 0) { datatype = WORD; datasize = sizeof(short); } else if(strcmp(argv[4],"int") == 0) { datatype = LWORD; datasize = sizeof(int); } else if(strcmp(argv[4],"float") == 0) { datatype = REAL; datasize = sizeof(float); } else if(strcmp(argv[4],"double") == 0) { datatype = DOUBLE; datasize = sizeof(double); } else { Tcl_AppendResult(interp, argv[0], " convert : ", "unknown data type", (char *) NULL); return TCL_ERROR; } /* allocate memory */ npts = (srcMasterPtr->width)*(srcMasterPtr->height); buff = (void*)ckalloc(npts*datasize); if( buff == NULL ) { Tcl_AppendResult(interp, "Cannot allocate memory for conversion", (char*)NULL); return TCL_ERROR; } /* convert data */ lconvert_types(npts,(void*)srcMasterPtr->data, srcMasterPtr->datatype, (void*)buff,datatype); /* set image size */ Tk_PictExpand(masterPtr,srcMasterPtr->width,srcMasterPtr->height); /* initialize block */ block.pixelPtr = (unsigned char*)buff; block.width = srcMasterPtr->width; block.height = srcMasterPtr->height; block.pitch = block.width; block.pixelSize = datasize; block.datatype = datatype; block.pixel_x = srcMasterPtr->pixel_x; block.pixel_y = srcMasterPtr->pixel_y; block.copy = NO_COPY; block.skip = 0; Tk_PictPutBlock(masterPtr,&block,0,0, masterPtr->width,masterPtr->height); return TCL_OK; } #endif } #ifdef PLB_SEGMENT else if(c=='d') { if ( (strncmp(argv[1], "dilation", length) == 0)) { return ImgPictDilation(interp,masterPtr,argc,argv); } else if(strncmp(argv[1], "dt", length) == 0) { return ImgPictDistanceTransform(interp,masterPtr,argc,argv); } } else if(c=='e') { if ( (strncmp(argv[1], "erosion", length) == 0)) { return ImgPictErosion(interp,masterPtr,argc,argv); } } #endif else if (c == 'g') { if( (strncmp(argv[1], "get", length) == 0)) { /* * Pict get command - first parse and check parameters. */ if (argc != 4) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " get x y\"", (char *) NULL); return TCL_ERROR; } if ((Tcl_GetInt(interp, argv[2], &x) != TCL_OK) || (Tcl_GetInt(interp, argv[3], &y) != TCL_OK)) { return TCL_ERROR; } if ((x < 0) || (x >= masterPtr->width) || (y < 0) || (y >= masterPtr->height)) { Tcl_AppendResult(interp, argv[0], " get: ", "coordinates out of range", (char *) NULL); return TCL_ERROR; } /* * Extract the value of the desired pixel and format it as a string. */ switch(masterPtr->datatype) { case BYTE: pix_int = (masterPtr->bytedata)[y * masterPtr->width + x]; sprintf(string, "%d", pix_int); break; case WORD: shortPtr = (short*)masterPtr->data; pix_int = shortPtr[y * masterPtr->width + x]; sprintf(string, "%d", pix_int); break; case LWORD: intPtr = (int*)masterPtr->data; pix_int = intPtr[y * masterPtr->width + x]; sprintf(string, "%d", pix_int); break; case REAL: floatPtr = (float*)masterPtr->data; pix_float = floatPtr[y* masterPtr->width + x]; sprintf(string, "%.5g", pix_float); break; case DOUBLE: doublePtr = (double*)masterPtr->data; pix_double = doublePtr[y* masterPtr->width + x]; sprintf(string, "%.5g", pix_double); break; default: Tcl_AppendResult(interp, argv[0], " get: ", "unknown data type", (char *) NULL); return TCL_ERROR; } Tcl_SetResult(interp,string,TCL_VOLATILE); return TCL_OK; } else if( (strncmp(argv[1], "getline", length) == 0)) { int x0,y0,x1,y1; /* * Pict get command - first parse and check parameters. */ if (argc != 6) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " getline x0 y0 x1 y1\"", (char *) NULL); return TCL_ERROR; } if((Tcl_GetInt(interp, argv[2], &x0) != TCL_OK) || (Tcl_GetInt(interp, argv[3], &y0) != TCL_OK) || (Tcl_GetInt(interp, argv[4], &x1) != TCL_OK) || (Tcl_GetInt(interp, argv[5], &y1) != TCL_OK)) { Tcl_AppendResult(interp, argv[0], " getline: ", "parameters out of range", (char *) NULL); return TCL_ERROR; } sprintf(string,""); get_line_pixels(string,masterPtr->bytedata, masterPtr->height, masterPtr->width, x0,y0,x1,y1, masterPtr->dispmin, masterPtr->dispmax); Tcl_AppendResult(interp, string, (char *) NULL); return TCL_OK; } else if( (strncmp(argv[1], "getmin", length) == 0)) { sprintf(string,"%.5g",masterPtr->dispmin); Tcl_AppendResult(interp, string, (char *) NULL); return TCL_OK; } else if( (strncmp(argv[1], "getmax", length) == 0)) { sprintf(string,"%.5g",masterPtr->dispmax); Tcl_AppendResult(interp, string, (char *) NULL); return TCL_OK; } #ifdef PLB_SEGMENT else if( (strncmp(argv[1], "get_holes", length) == 0)) { return ImgPictGetHoles(interp,masterPtr,argc,argv); } else if( (strncmp(argv[1], "gradient", length) == 0)) { return ImgPictGradient(interp,masterPtr,argc,argv); } #endif } else if(c== 'h') { if( strncmp(argv[1], "histogram", length) == 0 ) { int hist[256]; char string1[256]; int size; unsigned char *ptr; size = (masterPtr->width)*(masterPtr->height); /* clear histogram */ for (i = 0; i < 256; i++) hist[i] = 0; /* fill histogram */ ptr = masterPtr->bytedata; for (i = 0;i < size; i++) hist[(*ptr++)]++; /* format output string */ sprintf(string,""); for(i=0;i<256;i++) { sprintf(string1,"%g ",((double)i/(double)(MAX_COLORS-1.0)* (masterPtr->dispmax-masterPtr->dispmin)) +masterPtr->dispmin); strcat(string,string1); sprintf(string1,"%d ",hist[i]); strcat(string,string1); } Tcl_AppendResult(interp, string, (char *) NULL); return TCL_OK; } } #ifdef PLB_SEGMENT else if( c=='l') { if(strncmp(argv[1], "label", length) == 0) { return ImgPictLabel(interp,masterPtr,argc,argv); } else if(strncmp(argv[1], "laplacian", length) == 0) { return ImgPictLaplacian(interp,masterPtr,argc,argv); } } #endif else if ((c == 'r') && (strncmp(argv[1], "range", length) == 0)) { double dispmax; double dispmin; PictInstance *instancePtr; if (argc != 4) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " range x y\"", (char *) NULL); return TCL_ERROR; } if((Tcl_GetDouble(interp, argv[2], &dispmin) != TCL_OK) || (Tcl_GetDouble(interp, argv[3], &dispmax) != TCL_OK)) return TCL_ERROR; masterPtr->user_dispmax = dispmax; masterPtr->user_dispmin = dispmin; normalize_data(masterPtr); /* * Update each instance. */ for(instancePtr = masterPtr->instancePtr; instancePtr != NULL; instancePtr = instancePtr->nextPtr) DitherInstance(instancePtr, 0, 0, instancePtr->width, instancePtr->height); /* * Tell the core image code that this image has changed. */ Tk_ImageChanged(masterPtr->tkMaster,0,0, masterPtr-> width, masterPtr->height, masterPtr->width, masterPtr->height); return TCL_OK; } else if (c == 'r') { if( (strncmp(argv[1], "redither", length) == 0)) { if (argc == 2) { PictInstance *instancePtr; for (instancePtr = masterPtr->instancePtr; instancePtr != NULL; instancePtr = instancePtr->nextPtr) { DitherInstance(instancePtr, 0, 0, instancePtr->width,instancePtr->height); } i++; Tk_ImageChanged(masterPtr->tkMaster, 0, 0, masterPtr->width, masterPtr->height, masterPtr->width, masterPtr->height); } else { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " redither\"", (char *) NULL); return TCL_ERROR; } return TCL_OK; } else if( (strncmp(argv[1], "rxsize", length) == 0)) { if (argc == 2) { sprintf(string,"%g",masterPtr->pixel_x); Tcl_AppendResult(interp, string, (char *) NULL); } else { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " rxsize\"", (char *) NULL); return TCL_ERROR; } return TCL_OK; } else if( (strncmp(argv[1], "rysize", length) == 0)) { if (argc == 2) { sprintf(string,"%g",masterPtr->pixel_y); Tcl_AppendResult(interp, string, (char *) NULL); } else { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " rysize\"", (char *) NULL); return TCL_ERROR; } return TCL_OK; } } else if (c == 's') { if( (strncmp(argv[1], "snap2photo", length) == 0)) { return ImgPictSnap2Photo(interp,masterPtr,argc,argv); } else if( (strncmp(argv[1], "snap2pict", length) == 0)) { return ImgPictSnap2Pict(interp,masterPtr,argc,argv); } #ifdef PLB_SEGMENT else if( (strncmp(argv[1], "smooth", length) == 0)) { return ImgPictSmooth(interp,masterPtr,argc,argv); } else if( (strncmp(argv[1], "snake", length) == 0)) { return ImgPictSnakeCmd(masterPtr,interp,argc,argv); } #endif } else if ( c == 't') { #ifdef PLB_SEGMENT if (strncmp(argv[1], "threshold", length) == 0) { return ImgPictThreshold(interp,masterPtr,argc,argv); } /* end threshold */ else #endif if (strncmp(argv[1], "thres_isodata", length) == 0) { int hist[256]; int size; unsigned char *ptr; double t1,t2,g1,g2; int i,jt,it; int n = 256; double scale; if( argc != 2 ) { Tcl_AppendResult(interp," wrong # of arguments: should be ",argv[0], " thres_isodata ",(char *) NULL); return TCL_ERROR; } size = (masterPtr->width)*(masterPtr->height); /* clear histogram */ for (i = 0; i < n; i++) hist[i] = 0; /* fill histogram */ ptr = masterPtr->bytedata; for (i = 0;i < size; i++) hist[(*ptr++)]++; /* find threshold width isodata algorithm */ jt = -1; do { it = jt; for (t1 = g1 = 0.0, i = 0; i < it; i++) { t1 += hist[i]; g1 += hist[i] * ((double)i); } g1 = (t1 == 0.0 ? 0.0 : g1/t1); for (t2 = g2 = 0.0; i < n; i++) { t2 += hist[i]; g2 += hist[i] * ((double)i); } g2 = (t2 == 0.0 ? (it-1) : g2/t2); jt = (jt == -1 ? g2 + 1 : (g1 + g2)/2 + 1); } while (jt != it); scale = (masterPtr->dispmax-masterPtr->dispmin)/255.0; if( masterPtr->datatype != REAL && masterPtr->datatype != DOUBLE) sprintf(string,"%d",(int)((double)jt*scale + masterPtr->dispmin)); else sprintf(string,"%g",(double)jt*scale + masterPtr->dispmin); Tcl_AppendResult(interp, string, (char *) NULL); return TCL_OK; } /* end thres_isodata */ else if( strncmp(argv[1],"type",length) == 0) { if(argc!=2) { Tcl_AppendResult(interp," Wrong number of arguments, should be ", argv[0]," type",(char*)NULL); return TCL_ERROR; } switch(masterPtr->datatype) { case BYTE: Tcl_SetResult(interp,"byte",TCL_VOLATILE); break; case WORD: Tcl_SetResult(interp,"short",TCL_VOLATILE); break; case LWORD: Tcl_SetResult(interp,"int",TCL_VOLATILE); break; case REAL: Tcl_SetResult(interp,"float",TCL_VOLATILE); break; case DOUBLE: Tcl_SetResult(interp,"double",TCL_VOLATILE); break; default: Tcl_AppendResult(interp, argv[0], " type: ", "unknown data type", (char *) NULL); return TCL_ERROR; } return TCL_OK; } } /* endif c == 't' */ else if (c == 'w') { } #ifdef PLB_SEGMENT else if( c=='z') { if(strncmp(argv[1], "zero_crossings", length) == 0) { return ImgPictZeroCrng(interp,masterPtr,argc,argv); } } #endif /* If this point is reached, issue error message and list of commands */ #ifdef PLB_SEGMENT Tcl_AppendResult(interp, "bad option \"", argv[1], "\": must be blank, configure, cget, cmap_stretch,", "cmap_threshold, colorbar, colormap, copy, clip, convert," "erosion, dt, dilation, get,getline, getmin, getmax," "gradient, histogram, label, laplacian, overlay," "range,read, rdbinary, redither, snap2photo, snap2pict", "smooth, threshold, type, write, wrbinary, zero_crng", (char *) NULL); #else Tcl_AppendResult(interp, "bad option \"", argv[1], "\": must be blank, configure, cget, cmap_stretch,", "cmap_threshold, colorbar, colormap, copy, get,", "getline, getmin, getmax, histogram, overlay, range,", "read, rdbinary, redither, snap2photo, snap2pict, type, write,wrbinary", (char *) NULL); #endif return TCL_ERROR; } /* *---------------------------------------------------------------------- * * ParseSubcommandOptions -- * * This procedure is invoked to process one of the options * which may be specified for the Pict image subcommands, * namely, -from, -to, -zoom, -subsample, -format, and -shrink. * * Results: * A standard Tcl result. * * Side effects: * Fields in *optPtr get filled in. * *---------------------------------------------------------------------- */ static int ParseSubcommandOptions(optPtr, interp, allowedOptions, optIndexPtr, argc, argv) struct SubcommandOptions *optPtr; /* Information about the options specified * and the values given is returned here. */ Tcl_Interp *interp; /* Interpreter to use for reporting errors. */ int allowedOptions; /* Indicates which options are valid for * the current command. */ int *optIndexPtr; /* Points to a variable containing the * current index in argv; this variable is * updated by this procedure. */ int argc; /* Number of arguments in argv[]. */ const char **argv; /* Arguments to be parsed. */ { int index, c, bit, currentBit; size_t length; char *option, **listPtr; int values[4]; int numValues, maxValues, argIndex; #ifdef DEBUG printf("ParseSubcommandOptions\n"); #endif for (index = *optIndexPtr; index < argc; *optIndexPtr = ++index) { /* * We can have one value specified without an option; * it goes into optPtr->name. */ option = argv[index]; if (option[0] != '-') { if (optPtr->name == NULL) { optPtr->name = option; continue; } break; } /* * Work out which option this is. */ length = strlen(option); c = option[0]; bit = 0; currentBit = 1; for (listPtr = optionNames; *listPtr != NULL; ++listPtr) { if ((c == *listPtr[0]) && (strncmp(option, *listPtr, length) == 0)) { if (bit != 0) { bit = 0; /* An ambiguous option. */ break; } bit = currentBit; } currentBit <<= 1; } /* * If this option is not recognized and allowed, put * an error message in the interpreter and return. */ if ((allowedOptions & bit) == 0) { Tcl_AppendResult(interp, "unrecognized option \"", argv[index], "\": must be ", (char *)NULL); bit = 1; for (listPtr = optionNames; *listPtr != NULL; ++listPtr) { if ((allowedOptions & bit) != 0) { if ((allowedOptions & (bit - 1)) != 0) { Tcl_AppendResult(interp, ", ", (char *) NULL); if ((allowedOptions & ~((bit << 1) - 1)) == 0) { Tcl_AppendResult(interp, "or ", (char *) NULL); } } Tcl_AppendResult(interp, *listPtr, (char *) NULL); } bit <<= 1; } return TCL_ERROR; } /* * For the -from, -to, -zoom and -subsample options, * parse the values given. Report an error if too few * or too many values are given. */ if ((bit != OPT_SHRINK) && (bit != OPT_FORMAT)) { maxValues = ((bit == OPT_FROM) || (bit == OPT_TO))? 4: 2; argIndex = index + 1; for (numValues = 0; numValues < maxValues; ++numValues) { if ((argIndex < argc) && (isdigit(UCHAR(argv[argIndex][0])) || ((argv[argIndex][0] == '-') && (isdigit(UCHAR(argv[argIndex][1])))))) { if (Tcl_GetInt(interp, argv[argIndex], &values[numValues]) != TCL_OK) { return TCL_ERROR; } } else { break; } ++argIndex; } if (numValues == 0) { Tcl_AppendResult(interp, "the \"", argv[index], "\" option ", "requires one ", maxValues == 2? "or two": "to four", " integer values", (char *) NULL); return TCL_ERROR; } *optIndexPtr = (index += numValues); /* * Y values default to the corresponding X value if not specified. */ if (numValues == 1) { values[1] = values[0]; } if (numValues == 3) { values[3] = values[2]; } /* * Check the values given and put them in the appropriate * field of the SubcommandOptions structure. */ switch (bit) { case OPT_FROM: if ((values[0] < 0) || (values[1] < 0) || ((numValues > 2) && ((values[2] < 0) || (values[3] < 0)))) { Tcl_AppendResult(interp, "value(s) for the -from", " option must be non-negative", (char *) NULL); return TCL_ERROR; } if (numValues <= 2) { optPtr->fromX = values[0]; optPtr->fromY = values[1]; optPtr->fromX2 = -1; optPtr->fromY2 = -1; } else { optPtr->fromX = MIN(values[0], values[2]); optPtr->fromY = MIN(values[1], values[3]); optPtr->fromX2 = MAX(values[0], values[2]); optPtr->fromY2 = MAX(values[1], values[3]); } break; case OPT_SUBSAMPLE: optPtr->subsampleX = values[0]; optPtr->subsampleY = values[1]; break; case OPT_TO: if ((values[0] < 0) || (values[1] < 0) || ((numValues > 2) && ((values[2] < 0) || (values[3] < 0)))) { Tcl_AppendResult(interp, "value(s) for the -to", " option must be non-negative", (char *) NULL); return TCL_ERROR; } if (numValues <= 2) { optPtr->toX = values[0]; optPtr->toY = values[1]; optPtr->toX2 = -1; optPtr->toY2 = -1; } else { optPtr->toX = MIN(values[0], values[2]); optPtr->toY = MIN(values[1], values[3]); optPtr->toX2 = MAX(values[0], values[2]); optPtr->toY2 = MAX(values[1], values[3]); } break; case OPT_ZOOM: if ((values[0] <= 0) || (values[1] <= 0)) { Tcl_AppendResult(interp, "value(s) for the -zoom", " option must be positive", (char *) NULL); return TCL_ERROR; } optPtr->zoomX = values[0]; optPtr->zoomY = values[1]; break; } } else if (bit == OPT_FORMAT) { /* * The -format option takes a single string value. */ if (index + 1 < argc) { *optIndexPtr = ++index; optPtr->format = argv[index]; } else { Tcl_AppendResult(interp, "the \"-format\" option ", "requires a value", (char *) NULL); return TCL_ERROR; } } /* * Remember that we saw this option. */ optPtr->options |= bit; } return TCL_OK; } /* *---------------------------------------------------------------------- * * ImgPictConfigureMaster -- * * This procedure is called when a Pict image is created or * reconfigured. It processes configuration options and resets * any instances of the image. * * Results: * A standard Tcl return value. If TCL_ERROR is returned then * an error message is left in masterPtr->interp->result. * * Side effects: * Existing instances of the image will be redisplayed to match * the new configuration options. * *---------------------------------------------------------------------- */ static int ImgPictConfigureMaster(interp, masterPtr, argc, argv, flags) Tcl_Interp *interp; /* Interpreter to use for reporting errors. */ PictMaster *masterPtr; /* Pointer to data structure describing * overall Pict image to (re)configure. */ int argc; /* Number of entries in argv. */ const char **argv; /* Pairs of configuration options for image. */ int flags; /* Flags to pass to Tk_ConfigureWidget, * such as TK_CONFIG_ARGV_ONLY. */ { PictInstance *instancePtr; char *oldFileString, *oldDataString, *realFileName; int result; Tcl_Channel f; Tk_PictImageFormat *imageFormat; int imageWidth, imageHeight; Tcl_DString buffer; #ifdef DEBUG printf("ImgPictConfigureMaster\n"); #endif /* * Save the current values for fileString and dataString, so we * can tell if the user specifies them anew. */ oldFileString = masterPtr->fileString; oldDataString = (oldFileString == NULL)? masterPtr->dataString: NULL; /* * Process the configuration options specified. */ if (Tk_ConfigureWidget(interp, Tk_MainWindow(interp), configSpecs, argc, argv, (char *) masterPtr, flags) != TCL_OK) { return TCL_ERROR; } /* * Regard the empty string for -file, -data or -format as the null * value. */ if ((masterPtr->fileString != NULL) && (masterPtr->fileString[0] == 0)) { ckfree(masterPtr->fileString); masterPtr->fileString = NULL; } if ((masterPtr->dataString != NULL) && (masterPtr->dataString[0] == 0)) { ckfree(masterPtr->dataString); masterPtr->dataString = NULL; } if ((masterPtr->format != NULL) && (masterPtr->format[0] == 0)) { ckfree(masterPtr->format); masterPtr->format = NULL; } /* * Set the image to the user-requested size, if any, * and make sure storage is correctly allocated for this image. */ ImgPictSetSize(masterPtr, masterPtr->width, masterPtr->height); /* * Read in the image from the file or string if the user has * specified the -file or -data option. */ if ((masterPtr->fileString != NULL) && (masterPtr->fileString != oldFileString)) { realFileName = Tcl_TildeSubst(interp, masterPtr->fileString, &buffer); if (realFileName == NULL) { Tcl_AppendResult(interp, "No filename specified",(char*)NULL); return TCL_ERROR; } f = Tcl_OpenFileChannel(interp, realFileName, "r", 0); Tcl_DStringFree(&buffer); if (f == NULL) { Tcl_AppendResult(interp, "couldn't read image file \"", masterPtr->fileString, "\": ", Tcl_PosixError(interp), (char *) NULL); return TCL_ERROR; } if (MatchFileFormat(interp, f, masterPtr->fileString, masterPtr->format, &imageFormat, &imageWidth, &imageHeight) != TCL_OK) { Tcl_Close(interp, f); return TCL_ERROR; } ImgPictSetSize(masterPtr, imageWidth, imageHeight); result = (*imageFormat->fileReadProc)(interp, f, masterPtr->fileString, Tcl_NewStringObj( masterPtr->format, -1 ), (Tk_PictHandle) masterPtr, 0, 0, imageWidth, imageHeight, 0, 0); Tcl_Close(interp,f); if (result != TCL_OK) { return TCL_ERROR; } masterPtr->flags |= IMAGE_CHANGED; } if ((masterPtr->fileString == NULL) && (masterPtr->dataString != NULL) && (masterPtr->dataString != oldDataString)) { if (MatchStringFormat(interp, masterPtr->dataString, masterPtr->format, &imageFormat, &imageWidth, &imageHeight) != TCL_OK) { return TCL_ERROR; } ImgPictSetSize(masterPtr, imageWidth, imageHeight); if ((*imageFormat->stringReadProc)(interp, Tcl_NewStringObj( masterPtr->dataString, -1 ), Tcl_NewStringObj( masterPtr->format, -1 ), (Tk_PictHandle) masterPtr, 0, 0, imageWidth, imageHeight, 0, 0) != TCL_OK) { return TCL_ERROR; } masterPtr->flags |= IMAGE_CHANGED; } /* * Cycle through all of the instances of this image, regenerating * the information for each instance. Then force the image to be * redisplayed everywhere that it is used. */ for (instancePtr = masterPtr->instancePtr; instancePtr != NULL; instancePtr = instancePtr->nextPtr) { ImgPictConfigureInstance(instancePtr); } /* * Inform the generic image code that the image * has (potentially) changed. */ Tk_ImageChanged(masterPtr->tkMaster, 0, 0, masterPtr->width, masterPtr->height, masterPtr->width, masterPtr->height); masterPtr->flags &= ~IMAGE_CHANGED; return TCL_OK; } /* *---------------------------------------------------------------------- * * ImgPictConfigureInstance -- * * This procedure is called to create displaying information for * a Pict image instance based on the configuration information * in the master. It is invoked both when new instances are * created and when the master is reconfigured. * * Results: * None. * * Side effects: * Generates errors via Tk_BackgroundError if there are problems * in setting up the instance. * *---------------------------------------------------------------------- */ static void ImgPictConfigureInstance(instancePtr) PictInstance *instancePtr; /* Instance to reconfigure. */ { PictMaster *masterPtr = instancePtr->masterPtr; Display *disp; XImage *imagePtr; int bitsPerPixel; XRectangle validBox; int new_image = 0; #ifdef DEBUG printf("ImgPictConfigureInstance\n"); #endif /* * Create a new XImage structure for sending data to * the X server, if necessary. */ disp = instancePtr->display; bitsPerPixel = instancePtr->visualInfo.depth; if ((instancePtr->imagePtr == NULL) || (instancePtr->imagePtr->bits_per_pixel != bitsPerPixel)) { new_image = 1; if (instancePtr->imagePtr != NULL) { XFree((char *) instancePtr->imagePtr); } imagePtr = XCreateImage(disp, instancePtr->visualInfo.visual, (unsigned) bitsPerPixel, (bitsPerPixel > 1? ZPixmap: XYBitmap), 0, (char *) NULL, 1, 1, 32, 0); instancePtr->imagePtr = imagePtr; /* * Determine the endianness of this machine. * We create images using the local host's endianness, rather * than the endianness of the server; otherwise we would have * to byte-swap any 16 or 32 bit values that we store in the * image in those situations where the server's endianness * is different from ours. */ if (imagePtr != NULL) { union { int i; char c[sizeof(int)]; } kludge; imagePtr->bitmap_unit = sizeof(pixel) * NBBY; kludge.i = 0; kludge.c[0] = 1; imagePtr->byte_order = (kludge.i == 1) ? LSBFirst : MSBFirst; _XInitImageFuncPtrs(imagePtr); } } /* * If the user has specified a width and/or height for the master * which is different from our current width/height, set the size * to the values specified by the user. If we have no pixmap, we * do this also, since it has the side effect of allocating a * pixmap for us. */ if ((instancePtr->pixels == None) || (instancePtr->width != masterPtr->width) || (instancePtr->height != masterPtr->height)) { ImgPictInstanceSetSize(instancePtr); } /* * Redither this instance if necessary. */ if ((masterPtr->flags & IMAGE_CHANGED) || (new_image == 1)) { XClipBox(masterPtr->validRegion, &validBox); if ((validBox.width > 0) && (validBox.height > 0)) { DitherInstance(instancePtr, validBox.x, validBox.y, validBox.width, validBox.height); } } } /* *---------------------------------------------------------------------- * * ImgPictGet -- * * This procedure is called for each use of a Pict image in a * widget. * * Results: * The return value is a token for the instance, which is passed * back to us in calls to ImgPictDisplay and ImgPictFree. * * Side effects: * A data structure is set up for the instance (or, an existing * instance is re-used for the new one). * *---------------------------------------------------------------------- */ static ClientData ImgPictGet(tkwin, masterData) Tk_Window tkwin; /* Window in which the instance will be * used. */ ClientData masterData; /* Pointer to our master structure for the * image. */ { PictMaster *masterPtr = (PictMaster *) masterData; PictInstance *instancePtr; PictColorTable *colorTable; XVisualInfo *visInfoPtr; XRectangle validBox; XColor *white, *black; XGCValues gcValues; #ifdef DEBUG printf("ImgPictGet\n"); #endif if( GetColorTable(tkwin,(PictColorTable **)&colorTable,(XVisualInfo **)&visInfoPtr) == 0 ) { fprintf(stderr," GetColorTable failed \n"); return 0; } /* * Make a new instance of the image. */ instancePtr = (PictInstance *) ckalloc(sizeof(PictInstance)); if(instancePtr == NULL) { (void)fprintf(stderr,"ImgPictGet: Could not allocate memory\n"); return 0; } instancePtr->tkwin = tkwin; instancePtr->masterPtr = masterPtr; instancePtr->display = colorTable->display; instancePtr->colormap = colorTable->colormap; instancePtr->colormap_level = colorTable->colormap_level; instancePtr->has_overlay = 0; instancePtr->refCount = 1; instancePtr->pixels = None; instancePtr->width = 0; instancePtr->height = 0; instancePtr->imagePtr = 0; instancePtr->colorTable = colorTable; instancePtr->nextPtr = masterPtr->instancePtr; masterPtr->instancePtr = instancePtr; instancePtr->visualInfo = *visInfoPtr; XFree(visInfoPtr); /* * Make a GC with background = black and foreground = white. */ white = Tk_GetColor(masterPtr->interp, tkwin, "white"); black = Tk_GetColor(masterPtr->interp, tkwin, "black"); gcValues.foreground = (white != NULL)? white->pixel: WhitePixelOfScreen(Tk_Screen(tkwin)); gcValues.background = (black != NULL)? black->pixel: BlackPixelOfScreen(Tk_Screen(tkwin)); gcValues.graphics_exposures = False; instancePtr->gc = Tk_GetGC(tkwin, GCForeground|GCBackground|GCGraphicsExposures, &gcValues); instancePtr->setgc = GXcopy; /* Set configuration options and finish the initialization of the instance. */ ImgPictConfigureInstance(instancePtr); /* If this is the first instance, must set the size of the image. */ if (instancePtr->nextPtr == NULL) { Tk_ImageChanged(masterPtr->tkMaster, 0, 0, 0, 0, masterPtr->width, masterPtr->height); } /* If we have no pixmap, we do this also, since it has the side effect of allocating a pixmap for us. */ if (instancePtr->pixels == None) { XClipBox(masterPtr->validRegion, &validBox); if ((validBox.width > 0) && (validBox.height > 0)) { DitherInstance(instancePtr, validBox.x, validBox.y, validBox.width, validBox.height); } } return (ClientData) instancePtr; } /* end ImgPictGet */ /* *---------------------------------------------------------------------- * * ImgPictDisplay -- * * This procedure is invoked to draw a Pict image. * * Results: * None. * * Side effects: * A portion of the image gets rendered in a pixmap or window. * *---------------------------------------------------------------------- */ static void ImgPictDisplay(clientData, display, drawable, imageX, imageY, width, height, drawableX, drawableY) ClientData clientData; /* Pointer to PictInstance structure for * for instance to be displayed. */ Display *display; /* Display on which to draw image. */ Drawable drawable; /* Pixmap or window in which to draw image. */ int imageX, imageY; /* Upper-left corner of region within image * to draw. */ int width, height; /* Dimensions of region within image to draw. */ int drawableX, drawableY; /* Coordinates within drawable that * correspond to imageX and imageY. */ { PictInstance *instancePtr = (PictInstance *) clientData; #ifdef DEBUG printf("ImgPictDisplay\n"); #endif /* * If there's no pixmap, it means that an error occurred * while creating the image instance so it can't be displayed. */ if (instancePtr->pixels == None) { return; } /* * masterPtr->region describes which parts of the image contain * valid data. We set this region as the clip mask for the gc, * setting its origin appropriately, and use it when drawing the * image. */ XSetRegion(display, instancePtr->gc, instancePtr->masterPtr->validRegion); XSetClipOrigin(display, instancePtr->gc, drawableX - imageX, drawableY - imageY); XCopyArea(display, instancePtr->pixels, drawable, instancePtr->gc, imageX, imageY, (unsigned) width, (unsigned) height, drawableX, drawableY); XSetClipMask(display, instancePtr->gc, None); XSetClipOrigin(display, instancePtr->gc, 0, 0); } /* *---------------------------------------------------------------------- * * ImgPictFree -- * * This procedure is called when a widget ceases to use a * particular instance of an image. We don't actually get * rid of the instance until later because we may be about * to get this instance again. * * Results: * None. * * Side effects: * Internal data structures get cleaned up, later. * *---------------------------------------------------------------------- */ static void ImgPictFree(clientData, display) ClientData clientData; /* Pointer to PictInstance structure for * for instance to be displayed. */ Display *display; /* Display containing window that used image. */ { PictInstance *instancePtr = (PictInstance *) clientData; #ifdef DEBUG printf("ImgPictFree\n"); #endif instancePtr->refCount -= 1; if (instancePtr->refCount > 0) { return; } /* There are no more uses of the image within this widget. free the instance structure. */ DisposeInstance((ClientData) instancePtr); } /* *---------------------------------------------------------------------- * * ImgPictDelete -- * * This procedure is called by the image code to delete the * master structure for an image. * * Results: * None. * * Side effects: * Resources associated with the image get freed. * *---------------------------------------------------------------------- */ static void ImgPictDelete(masterData) ClientData masterData; /* Pointer to PictMaster structure for * image. Must not have any more instances. */ { PictMaster *masterPtr = (PictMaster *) masterData; PictInstance *instancePtr; #ifdef DEBUG printf("ImgPictDelete\n"); #endif while ((instancePtr = masterPtr->instancePtr) != NULL) { if (instancePtr->refCount > 0) { panic("tried to delete Pict image when instances still exist"); } #if (TK_MINOR_VERSION == 0) Tk_CancelIdleCall(DisposeInstance, (ClientData) instancePtr); #else Tcl_CancelIdleCall(DisposeInstance, (ClientData) instancePtr); #endif DisposeInstance((ClientData) instancePtr); } masterPtr->tkMaster = NULL; if (masterPtr->imageCmd != NULL) { Tcl_DeleteCommand(masterPtr->interp, Tcl_GetCommandName(masterPtr->interp, masterPtr->imageCmd)); } if (masterPtr->data != NULL) { if( (char*)(masterPtr->data) == (char*)(masterPtr->bytedata) ) { ckfree((char *) masterPtr->data); masterPtr->data = NULL; masterPtr->bytedata = NULL; } else { ckfree((char *) masterPtr->data); masterPtr->data = NULL; } } if (masterPtr->bytedata != NULL) { ckfree((char *) masterPtr->bytedata); } if (masterPtr->validRegion != NULL) { XDestroyRegion(masterPtr->validRegion); } Tk_FreeOptions(configSpecs, (char *) masterPtr, (Display *) NULL, 0); ckfree((char *) masterPtr); } /* *---------------------------------------------------------------------- * * ImgPictCmdDeletedProc -- * * This procedure is invoked when the image command for an image * is deleted. It deletes the image. * * Results: * None. * * Side effects: * The image is deleted. * *---------------------------------------------------------------------- */ static void ImgPictCmdDeletedProc(clientData) ClientData clientData; /* Pointer to PictMaster structure for * image. */ { PictMaster *masterPtr = (PictMaster *) clientData; #ifdef DEBUG printf("ImgPictCmdDeletedProc\n"); #endif masterPtr->imageCmd = NULL; if (masterPtr->tkMaster != NULL) { Tk_DeleteImage(masterPtr->interp, Tk_NameOfImage(masterPtr->tkMaster)); } } /* *---------------------------------------------------------------------- * * ImgPictSetSize -- * * This procedure reallocates the image storage and instance * pixmaps for a Pict image, as necessary, to change the * image's size to `width' x `height' pixels. * * Results: * None. * * Side effects: * Storage gets reallocated, for the master and all its instances. * *---------------------------------------------------------------------- */ static void ImgPictSetSize(masterPtr, width, height) PictMaster *masterPtr; int width, height; { char *newData; int h, offset, pitch; char *srcPtr, *destPtr; XRectangle validBox, clipBox; Region clipRegion; PictInstance *instancePtr; #ifdef DEBUG printf("ImgPictSetSize\n"); #endif if (masterPtr->userWidth > 0) { width = masterPtr->userWidth; } if (masterPtr->userHeight > 0) { height = masterPtr->userHeight; } /* * We have to trim the valid region if it is currently * larger than the new image size. */ XClipBox(masterPtr->validRegion, &validBox); if ((validBox.x + validBox.width > (unsigned) width) || (validBox.y + validBox.height > (unsigned) height)) { clipBox.x = 0; clipBox.y = 0; clipBox.width = width; clipBox.height = height; clipRegion = XCreateRegion(); XUnionRectWithRegion(&clipBox, clipRegion, clipRegion); XIntersectRegion(masterPtr->validRegion, clipRegion, masterPtr->validRegion); XDestroyRegion(clipRegion); XClipBox(masterPtr->validRegion, &validBox); } if ((width != masterPtr->width) || (height != masterPtr->height)) { if( masterPtr->data == NULL ) { masterPtr->width = width; masterPtr->height = height; } else { /* * Reallocate storage for the byte image and copy * over valid regions. */ pitch = width; newData = (char *) ckalloc((unsigned) (height * pitch*masterPtr->datasize)); if(newData == NULL) { (void)fprintf(stderr,"ImgPictSetSize: Could not allocate memory\n"); return; } /* * Zero the new array. The dithering code shouldn't read the * areas outside validBox, but they might be copied to another * Pict image or written to a file. */ if ((masterPtr->data != NULL) && ((width == masterPtr->width) || (width == validBox.width))) { if (validBox.y > 0) { memset((VOID *) newData, 0, (size_t) (validBox.y * pitch*masterPtr->datasize)); } h = validBox.y + validBox.height; if (h < height) { memset((VOID *) (newData + h * pitch), 0, (size_t) ((height - h) * pitch)); } } else { memset((VOID *) newData, 0, (size_t) (height * pitch*masterPtr->datasize)); } if (masterPtr->data != NULL) { /* * Copy the common area over to the new array array and * free the old array. */ if (width == masterPtr->width) { /* * The region to be copied is contiguous. */ offset = validBox.y * pitch; memcpy((VOID *) (newData + offset), (VOID *) (masterPtr->data + offset), (size_t) (validBox.height * pitch*masterPtr->datasize)); } else if ((validBox.width > 0) && (validBox.height > 0)) { /* * Area to be copied is not contiguous - copy line by line. */ destPtr = newData + (validBox.y * width + validBox.x)*masterPtr->datasize; srcPtr = masterPtr->data + (validBox.y * masterPtr->width + validBox.x)*masterPtr->datasize; for (h = validBox.height; h > 0; h--) { memcpy((VOID *) destPtr, (VOID *) srcPtr, (size_t) (validBox.width*masterPtr->datasize)); destPtr += width*masterPtr->datasize ; srcPtr += masterPtr->width*masterPtr->datasize; } } if (masterPtr->data != NULL) { if ((char*)(masterPtr->data) == (char*)(masterPtr->bytedata)) { free((void*)masterPtr->data); masterPtr->data = NULL; masterPtr->bytedata = NULL; } else { free((void*)masterPtr->data); masterPtr->data = NULL; free((void*)masterPtr->bytedata); masterPtr->bytedata = NULL; } } } masterPtr->data = newData; masterPtr->width = width; masterPtr->height = height; normalize_data(masterPtr); } } /* * Now adjust the sizes of the pixmaps for all of the instances. */ for (instancePtr = masterPtr->instancePtr; instancePtr != NULL; instancePtr = instancePtr->nextPtr) { ImgPictInstanceSetSize(instancePtr); } } /* *---------------------------------------------------------------------- * * ImgPictInstanceSetSize -- * * This procedure reallocates the instance pixmap and dithering * error array for a Pict instance, as necessary, to change the * image's size to `width' x `height' pixels. * * Results: * None. * * Side effects: * Storage gets reallocated, here and in the X server. * *---------------------------------------------------------------------- */ static void ImgPictInstanceSetSize(instancePtr) PictInstance *instancePtr; /* Instance whose size is to be * changed. */ { PictMaster *masterPtr; XRectangle validBox; Pixmap newPixmap; #ifdef DEBUG printf("ImgPictInstanceSetSize\n"); #endif masterPtr = instancePtr->masterPtr; XClipBox(masterPtr->validRegion, &validBox); if ((instancePtr->width != masterPtr->width) || (instancePtr->height != masterPtr->height) || (instancePtr->pixels == None)) { newPixmap = Tk_GetPixmap(instancePtr->display, RootWindow(instancePtr->display, instancePtr->visualInfo.screen), (masterPtr->width > 0) ? masterPtr->width: 1, (masterPtr->height > 0) ? masterPtr->height: 1, instancePtr->visualInfo.depth); if (instancePtr->pixels != None) { /* * Copy any common pixels from the old pixmap and free it. */ XCopyArea(instancePtr->display, instancePtr->pixels, newPixmap, instancePtr->gc, validBox.x, validBox.y, validBox.width, validBox.height, validBox.x, validBox.y); Tk_FreePixmap(instancePtr->display, instancePtr->pixels); } instancePtr->pixels = newPixmap; } instancePtr->width = masterPtr->width; instancePtr->height = masterPtr->height; } /* *---------------------------------------------------------------------- * * ImgPictCopy * * This procedure copies data from one image to another * * Results: * None. * * Side effects: * The contents of the image is replaced by what's been read. * *---------------------------------------------------------------------- */ static int ImgPictCopy(Tcl_Interp *interp, PictMaster *masterPtr, int argc, const char **argv) { int index; int width, height; struct SubcommandOptions options; Tk_PictImageBlock block; Tk_PictHandle srcHandle; /* * Pict copy command - first parse options. */ index = 2; memset((VOID *) &options, 0, sizeof(options)); options.zoomX = options.zoomY = 1; options.subsampleX = options.subsampleY = 1; options.name = NULL; if (ParseSubcommandOptions(&options, interp, OPT_FROM | OPT_TO | OPT_ZOOM | OPT_SUBSAMPLE | OPT_SHRINK, &index, argc, argv) != TCL_OK) { return TCL_ERROR; } if (options.name == NULL || index < argc) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " copy source-image ?-from x1 y1 x2 y2?", " ?-to x1 y1 x2 y2? ?-zoom x y? ?-subsample x y?", "\"", (char *) NULL); return TCL_ERROR; } /* * Look for the source image and get a pointer to its image data. * Check the values given for the -from option. */ if ((srcHandle = Tk_FindPict(options.name)) == NULL) { Tcl_AppendResult(interp, "image \"", argv[2], "\" doesn't", " exist or is not a Pict image", (char *) NULL); return TCL_ERROR; } Tk_PictGetImage(srcHandle, &block); if ((options.fromX2 > block.width) || (options.fromY2 > block.height) || (options.fromX2 > block.width) || (options.fromY2 > block.height)) { Tcl_AppendResult(interp, "coordinates for -from option extend ", "outside source image", (char *) NULL); return TCL_ERROR; } /* * Fill in default values for unspecified parameters. */ if (((options.options & OPT_FROM) == 0) || (options.fromX2 < 0)) { options.fromX2 = block.width; options.fromY2 = block.height; } if (((options.options & OPT_TO) == 0) || (options.toX2 < 0)) { width = options.fromX2 - options.fromX; if (options.subsampleX > 0) { width = (width + options.subsampleX - 1) / options.subsampleX; } else if (options.subsampleX == 0) { width = 0; } else { width = (width - options.subsampleX - 1) / -options.subsampleX; } options.toX2 = options.toX + width * options.zoomX; height = options.fromY2 - options.fromY; if (options.subsampleY > 0) { height = (height + options.subsampleY - 1) / options.subsampleY; } else if (options.subsampleY == 0) { height = 0; } else { height = (height - options.subsampleY - 1) / -options.subsampleY; } options.toY2 = options.toY + height * options.zoomY; } /* * Set the destination image size if the -shrink option was specified. */ if (options.options & OPT_SHRINK) { ImgPictSetSize(masterPtr, options.toX2, options.toY2); } /* * Copy the image data over using Tk_PictPutZoomedBlock. */ block.pixelPtr += (options.fromX + options.fromY * block.pitch) * block.pixelSize; block.width = options.fromX2 - options.fromX; block.height = options.fromY2 - options.fromY; Tk_PictPutZoomedBlock((Tk_PictHandle) masterPtr, &block, options.toX, options.toY, options.toX2 - options.toX, options.toY2 - options.toY, options.zoomX, options.zoomY, options.subsampleX, options.subsampleY); return TCL_OK; } /* end ImgPictCopy */ /* *---------------------------------------------------------------------- * * ImgPictSnap2Photo -- * * This procedure is used for snapshots of a pict image. The result * is stored as a photo image. * * Results: * None. * * Side effects: * None * *---------------------------------------------------------------------- */ int ImgPictSnap2Photo(Tcl_Interp *interp, PictMaster *masterPtr, int argc, const char **argv) { void *destHandle; int i,j,col; Tk_PhotoImageBlock photoblock; PictInstance *instancePtr=masterPtr->instancePtr; PictColorTable *colorTable; int *red,*green,*blue; int *intensity_lut,*red_lut,*green_lut,*blue_lut; if ((destHandle = Tk_FindPhoto(interp,argv[2])) == NULL) { Tcl_AppendResult(interp, "image \"", argv[2], "\" doesn't", " exist or is not a Photo image", (char *) NULL); return TCL_ERROR; } /* set size */ Tk_PhotoExpand(interp, destHandle,masterPtr->width,masterPtr->height); /* copy data from pict image to photo image. If no instance exists, no colors have been allocated, so we copy the original master data. Otherwise, we copy them using the color lookup tables in a 24-bit image. */ if( masterPtr->instancePtr == NULL ) { photoblock.pixelSize = 1; photoblock.offset[0] = 0; photoblock.offset[1] = 0; photoblock.offset[2] = 0; photoblock.width = masterPtr->width; photoblock.height = masterPtr->height; photoblock.pitch = photoblock.pixelSize * masterPtr->width; /* allocate storage */ photoblock.pixelPtr = (unsigned char*)ckalloc((size_t) (masterPtr->width)* (masterPtr->height)); if ( photoblock.pixelPtr == NULL) { Tcl_AppendResult(interp, "Cannot allocate memory in snap2photo ", (char*)NULL); return TCL_ERROR; } memcpy((void*)(photoblock.pixelPtr), (void*)(masterPtr->bytedata), (size_t)(masterPtr->width)*(masterPtr->height)); } else { /* produce a 24-bit image */ photoblock.pixelSize = 3; photoblock.offset[0] = 0; photoblock.offset[1] = 1; photoblock.offset[2] = 2; photoblock.width = masterPtr->width; photoblock.height = masterPtr->height; photoblock.pitch = photoblock.pixelSize * (masterPtr->width); /* allocate storage */ photoblock.pixelPtr = (unsigned char*)ckalloc((size_t)3* (masterPtr->width)* (masterPtr->height)); if ( photoblock.pixelPtr == NULL) { Tcl_AppendResult(interp, "Cannot allocate memory in snap2photo ", (char*)NULL); return TCL_ERROR; } /* get the colors */ colorTable = instancePtr->colorTable; red = colorTable->red; red_lut = colorTable->red_lut; green = colorTable->green; green_lut = colorTable->green_lut; blue = colorTable->blue; blue_lut = colorTable->blue_lut; intensity_lut = colorTable->intensity_lut; if( instancePtr->has_overlay == 0 ) { for(i=0,j=0;i<(masterPtr->width)*(masterPtr->height);i++) { /* map from [0-MAX_COLORS-1] to [0-(colorTable->ncolors-1)] */ col = (double)(masterPtr->bytedata[i])* (double)((colorTable->ncolors-1))/ (double)(MAX_COLORS-1); /* fill pixels of 24-bit image */ photoblock.pixelPtr[j++] = red_lut[red[intensity_lut[col]]]; photoblock.pixelPtr[j++] = green_lut[green[intensity_lut[col]]]; photoblock.pixelPtr[j++] = blue_lut[blue[intensity_lut[col]]]; } } else { /* instead of using a XGetImage call, we re-calculate the color values. tedious but no need for a server call */ Tcl_AppendResult(interp, "Overlays not supported. How did you get here?",(char *) NULL); return TCL_ERROR; } /* end else if overlays */ } /* put block in photo image */ Tk_PhotoPutBlock(interp, destHandle,&photoblock,0,0,masterPtr->width,masterPtr->height, TK_PHOTO_COMPOSITE_SET); /* free photo block */ ckfree((void*)photoblock.pixelPtr); return TCL_OK; } /* end ImgPictSnap2Photo */ /* *---------------------------------------------------------------------- * * ImgPictSnap2Pict -- * * This procedure is used for snapshots of a pict image. The result * is stored as a pict image after NTSC conversion. * * Results: * None. * * Side effects: * None * *---------------------------------------------------------------------- */ int ImgPictSnap2Pict(Tcl_Interp *interp, PictMaster *masterPtr, int argc, const char **argv) { PictMaster *destmasterPtr; Tk_PictHandle destHandle; Tk_PictImageBlock *tmp_block; int i,j,col; /* Basically the same thing as snap2photo, plus the conversion to gray, but we can use Tk_PictExpand and Tk_PictPutBlock */ if ((destHandle = Tk_FindPict(argv[2])) == NULL) { Tcl_AppendResult(interp, "image \"", argv[2], "\" doesn't", " exist or is not a Pict image", (char *) NULL); return TCL_ERROR; } destmasterPtr = (PictMaster*)destHandle; /* allocate storage */ tmp_block = (Tk_PictImageBlock*)ckalloc(sizeof(Tk_PictImageBlock)); if ( tmp_block == NULL) { Tcl_AppendResult(interp, "Cannot allocate memory in snap2pict ", (char*)NULL); return TCL_ERROR; } tmp_block->pixelPtr = (unsigned char*)ckalloc((size_t) (masterPtr->width)* (masterPtr->height)); tmp_block->width = masterPtr->width; tmp_block->height = masterPtr->height; tmp_block->datatype = BYTE; tmp_block->pixelSize = sizeof(unsigned char); tmp_block->pitch = tmp_block->pixelSize * tmp_block->width; tmp_block->copy = NO_COPY; tmp_block->skip = 0; tmp_block->pixel_x = masterPtr->pixel_x; tmp_block->pixel_y = masterPtr->pixel_y; /* copy data from pict image to pict image. If no instance exists, no colors have been allocated, so we copy the original master byte data. Otherwise, we copy them using the color lookup tables */ if( masterPtr->instancePtr == NULL ) { (void)memcpy((char*)(tmp_block->pixelPtr), (char*)(masterPtr->bytedata), (masterPtr->width)*(masterPtr->height)); } else { PictInstance *instancePtr=masterPtr->instancePtr; PictColorTable *colorTable; int *red,*green,*blue; int *intensity_lut,*red_lut,*green_lut,*blue_lut; colorTable = instancePtr->colorTable; red = colorTable->red; red_lut = colorTable->red_lut; green = colorTable->green; green_lut = colorTable->green_lut; blue = colorTable->blue; blue_lut = colorTable->blue_lut; intensity_lut = colorTable->intensity_lut; if( instancePtr->has_overlay == 0 ) { for(i=0,j=0;iwidth*masterPtr->height;i++) { /* map from [0-MAX_COLORS-1] to [0-(colorTable->ncolors-1)] */ col = (double)(masterPtr->bytedata[i])* (double)(colorTable->ncolors-1)/ (double)(MAX_COLORS-1); tmp_block->pixelPtr[i] = GRAY((red_lut[red[intensity_lut[col]]]), (green_lut[green[intensity_lut[col]]]), (blue_lut[blue[intensity_lut[col]]])); } } else { Tcl_AppendResult(interp, "Overlays not supported. How did you get here?",(char *) NULL); return TCL_ERROR; } /* end else if overlays */ } Tk_PictExpand(destHandle,masterPtr->width,masterPtr->height); Tk_PictPutBlock(destHandle,tmp_block,0,0,masterPtr->width,masterPtr->height); Tk_ImageChanged(destmasterPtr->tkMaster,0,0, destmasterPtr-> width, destmasterPtr->height, destmasterPtr->width, destmasterPtr->height); ckfree((void*)tmp_block); return TCL_OK; } /* end ImgPictSnap2Pict */ /* *---------------------------------------------------------------------- * * DisposeInstance -- * * This procedure is called to finally free up an instance * of a Pict image which is no longer required. * * Results: * None. * * Side effects: * The instance data structure and the resources it references * are freed. * *---------------------------------------------------------------------- */ void DisposeInstance(clientData) ClientData clientData; /* Pointer to the instance whose resources * are to be released. */ { PictInstance *instancePtr = (PictInstance *) clientData; PictInstance *prevPtr; #ifdef DEBUG printf("DisposeInstance\n"); #endif if(instancePtr->has_overlay) { XFreeGC(instancePtr->display,instancePtr->overlay_gc); instancePtr->has_overlay = False; } if (instancePtr->pixels != None) { Tk_FreePixmap(instancePtr->display, instancePtr->pixels); } if (instancePtr->gc != None) { Tk_FreeGC(instancePtr->display, instancePtr->gc); } if (instancePtr->imagePtr != NULL) { XFree((char *) instancePtr->imagePtr); } instancePtr->colorTable->refCount --; if( instancePtr->colorTable->refCount == 0 ) { (void)DisposeColorTable(instancePtr->colorTable); instancePtr->colorTable = NULL; } if (instancePtr->masterPtr->instancePtr == instancePtr) { instancePtr->masterPtr->instancePtr = instancePtr->nextPtr; } else { for (prevPtr = instancePtr->masterPtr->instancePtr; prevPtr->nextPtr != instancePtr; prevPtr = prevPtr->nextPtr) { /* Empty loop body */ } prevPtr->nextPtr = instancePtr->nextPtr; } ckfree((char *) instancePtr); } /* *---------------------------------------------------------------------- * * MatchFileFormat -- * * This procedure is called to find a Pict image file format * handler which can parse the image data in the given file. * If a user-specified format string is provided, only handlers * whose names match a prefix of the format string are tried. * * Results: * A standard TCL return value. If the return value is TCL_OK, a * pointer to the image format record is returned in * *imageFormatPtr, and the width and height of the image are * returned in *widthPtr and *heightPtr. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int MatchFileFormat(interp, f, fileName, formatString, imageFormatPtr, widthPtr, heightPtr) Tcl_Interp *interp; /* Interpreter to use for reporting errors. */ Tcl_Channel f; /* The image file, open for reading. */ char *fileName; /* The name of the image file. */ char *formatString; /* User-specified format string, or NULL. */ Tk_PictImageFormat **imageFormatPtr; /* A pointer to the Pict image format * record is returned here. */ int *widthPtr, *heightPtr; /* The dimensions of the image are * returned here. */ { int matched; Tk_PictImageFormat *formatPtr; #ifdef DEBUG printf("MatchFileFormat\n"); #endif /* * Scan through the table of file format handlers to find * one which can handle the image. */ matched = 0; for (formatPtr = formatList; formatPtr != NULL; formatPtr = formatPtr->nextPtr) { if ((formatString != NULL) && (strncasecmp(formatString, formatPtr->name, strlen(formatPtr->name)) != 0)) { continue; } matched = 1; if (formatPtr->fileMatchProc != NULL) { Tcl_Seek(f, 0L, SEEK_SET); if ((*formatPtr->fileMatchProc)(f, fileName, Tcl_NewStringObj( formatString, -1 ), widthPtr, heightPtr, interp)) { if (*widthPtr < 1) { *widthPtr = 1; } if (*heightPtr < 1) { *heightPtr = 1; } break; } } } if (formatPtr == NULL) { if ((formatString != NULL) && !matched) { Tcl_AppendResult(interp, "image file format \"", formatString, "\" is unknown", (char *) NULL); } else { Tcl_AppendResult(interp, "couldn't recognize data in image file \"", fileName, "\"", (char *) NULL); } return TCL_ERROR; } *imageFormatPtr = formatPtr; Tcl_Seek(f, 0L, SEEK_SET); return TCL_OK; } /* *---------------------------------------------------------------------- * * MatchStringFormat -- * * This procedure is called to find a Pict image file format * handler which can parse the image data in the given string. * If a user-specified format string is provided, only handlers * whose names match a prefix of the format string are tried. * * Results: * A standard TCL return value. If the return value is TCL_OK, a * pointer to the image format record is returned in * *imageFormatPtr, and the width and height of the image are * returned in *widthPtr and *heightPtr. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int MatchStringFormat(interp, string, formatString, imageFormatPtr, widthPtr, heightPtr) Tcl_Interp *interp; /* Interpreter to use for reporting errors. */ char *string; /* String containing the image data. */ char *formatString; /* User-specified format string, or NULL. */ Tk_PictImageFormat **imageFormatPtr; /* A pointer to the Pict image format * record is returned here. */ int *widthPtr, *heightPtr; /* The dimensions of the image are * returned here. */ { int matched; Tk_PictImageFormat *formatPtr; #ifdef DEBUG printf("MatchStringFormat\n"); #endif /* * Scan through the table of file format handlers to find * one which can handle the image. */ matched = 0; for (formatPtr = formatList; formatPtr != NULL; formatPtr = formatPtr->nextPtr) { if ((formatString != NULL) && (strncasecmp(formatString, formatPtr->name, strlen(formatPtr->name)) != 0)) { continue; } matched = 1; if ((formatPtr->stringMatchProc != NULL) && (*formatPtr->stringMatchProc)( Tcl_NewStringObj( string, -1 ), Tcl_NewStringObj( formatString, -1 ), widthPtr, heightPtr, interp)) { break; } } if (formatPtr == NULL) { if ((formatString != NULL) && !matched) { Tcl_AppendResult(interp, "image file format \"", formatString, "\" is unknown", (char *) NULL); } else { Tcl_AppendResult(interp, "no format found to parse", " image data string", (char *) NULL); } return TCL_ERROR; } *imageFormatPtr = formatPtr; return TCL_OK; } /* *---------------------------------------------------------------------- * * Tk_FindPict -- * * This procedure is called to get an opaque handle (actually a * PictMaster *) for a given image, which can be used in * subsequent calls to Tk_PictPutBlock, etc. The `name' * parameter is the name of the image. * * Results: * The handle for the Pict image, or NULL if there is no * Pict image with the name given. * * Side effects: * None. * *---------------------------------------------------------------------- */ Tk_PictHandle Tk_FindPict(imageName) char *imageName; /* Name of the desired Pict image. */ { Tcl_HashEntry *entry; #ifdef DEBUG printf("Tk_FindPict\n"); #endif if (!imgPictHashInitialized) { return NULL; } entry = Tcl_FindHashEntry(&imgPictHash, imageName); if (entry == NULL) { return NULL; } return (Tk_PictHandle) Tcl_GetHashValue(entry); } /* *---------------------------------------------------------------------- * * Tk_PictPutBlock -- * * This procedure is called to put image data into a Pict image. * * Results: * None. * * Side effects: * The image data is stored. The image may be expanded. * The Tk image code is informed that the image has changed. * *---------------------------------------------------------------------- */ void Tk_PictPutBlock(handle, blockPtr, x, y, width, height) Tk_PictHandle handle; /* Opaque handle for the Pict image * to be updated. */ register Tk_PictImageBlock *blockPtr; /* Pointer to a structure describing the * pixel data to be copied into the image. */ int x, y; /* Coordinates of the top-left pixel to * be updated in the image. */ int width, height; /* Dimensions of the area of the image * to be updated. */ { register PictMaster *masterPtr; PictInstance *instancePtr; int xEnd, yEnd; XRectangle rect; int i,j; #ifdef DEBUG printf("Tk_PictPutBlock\n"); #endif masterPtr = (PictMaster *) handle; if ((masterPtr->userWidth != 0) && ((x + width) > masterPtr->userWidth)) { width = masterPtr->userWidth - x; } if ((masterPtr->userHeight != 0) && ((y + height) > masterPtr->userHeight)) { height = masterPtr->userHeight - y; } if ((width <= 0) || (height <= 0)) return; xEnd = x + width; yEnd = y + height; if ((xEnd > masterPtr->width) || (yEnd > masterPtr->height)) { ImgPictSetSize(masterPtr, MAX(xEnd, masterPtr->width), MAX(yEnd, masterPtr->height)); } if((x!= 0) || (y!= 0) || (masterPtr->width != blockPtr->width) || (masterPtr->height != blockPtr->height)) { #ifdef DEBUG printf(" needs copy \n"); #endif blockPtr->copy = COPY; /* printf("Warning : the physical dimensions of the block being read will not be saved \n"); */ } if( blockPtr->copy == COPY ) { if( masterPtr->data == NULL ) { #ifdef DEBUG printf("needs allocation \n"); #endif masterPtr->datatype = blockPtr->datatype; masterPtr->datasize = blockPtr->pixelSize; masterPtr->data = (char*)ckalloc((size_t)masterPtr->datasize* masterPtr->width* masterPtr->height); if( masterPtr->data == NULL ) { (void)fprintf(stderr,"Could not allocate memory \n"); return; } } else { if (masterPtr->datatype != blockPtr->datatype ) { (void)fprintf(stderr,"Type mismatch \n"); return; } } if(masterPtr->width == blockPtr->width && masterPtr->height == blockPtr->height) masterPtr->skip = blockPtr->skip; if( blockPtr->datatype == BYTE ) { for(i=0;idata[i+x+(j+y)*masterPtr->width] = blockPtr->pixelPtr[i+j*blockPtr->pitch]; } else if( blockPtr->datatype == WORD ) { short *srcPtr = (short*)blockPtr->pixelPtr; short *destPtr = (short*)masterPtr->data; for(i=0;iwidth] = srcPtr[i+j*blockPtr->pitch]; } else if( blockPtr->datatype == LWORD ) { int *srcPtr = (int*)blockPtr->pixelPtr; int *destPtr = (int*)masterPtr->data; for(i=0;iwidth] = srcPtr[i+j*blockPtr->pitch]; } else if( blockPtr->datatype == REAL ) { float *srcPtr = (float*)blockPtr->pixelPtr; float *destPtr = (float*)masterPtr->data; for(i=0;iwidth] = srcPtr[i+j*blockPtr->pitch]; } else if( blockPtr->datatype == DOUBLE ) { double *srcPtr = (double*)blockPtr->pixelPtr; double *destPtr = (double*)masterPtr->data; for(i=0;iwidth] = srcPtr[i+j*blockPtr->pitch]; } } else { if( masterPtr->bytedata != NULL ) { if( (char*)masterPtr->bytedata == (char*)masterPtr->data ) { ckfree((void*)masterPtr->bytedata); masterPtr->bytedata = NULL; masterPtr->data = NULL; } else { ckfree((void*)masterPtr->bytedata); masterPtr->bytedata = NULL; } } if( masterPtr->data != NULL ) { free((void*)masterPtr->data); masterPtr->data = NULL; } masterPtr->datatype = blockPtr->datatype; masterPtr->datasize = blockPtr->pixelSize; masterPtr->skip = blockPtr->skip; /* save physical dimensions */ masterPtr->pixel_x = blockPtr->pixel_x; masterPtr->pixel_y = blockPtr->pixel_y; /* Put the data into our local data array */ masterPtr->data = (char*)blockPtr->pixelPtr; } normalize_data(masterPtr); blockPtr->pixelPtr = NULL; /* * Add this new block to the region which specifies which data is valid. */ rect.x = x; rect.y = y; rect.width = width; rect.height = height; XUnionRectWithRegion(&rect, masterPtr->validRegion, masterPtr->validRegion); /* * Update each instance. */ for(instancePtr = masterPtr->instancePtr; instancePtr != NULL; instancePtr = instancePtr->nextPtr) DitherInstance(instancePtr, x, y, width, height); /* * Tell the core image code that this image has changed. */ Tk_ImageChanged(masterPtr->tkMaster, x, y, width, height, masterPtr->width, masterPtr->height); } /* *---------------------------------------------------------------------- * * Tk_PictPutZoomedBlock -- * * This procedure is called to put image data into a Pict image, * with possible subsampling and/or zooming of the pixels. * * Results: * None. * * Side effects: * The image data is stored. The image may be expanded. * The Tk image code is informed that the image has changed. * *---------------------------------------------------------------------- */ void Tk_PictPutZoomedBlock(handle, blockPtr, x, y, width, height, zoomX, zoomY, subsampleX, subsampleY) Tk_PictHandle handle; /* Opaque handle for the Pict image * to be updated. */ register Tk_PictImageBlock *blockPtr; /* Pointer to a structure describing the * pixel data to be copied into the image. */ int x, y; /* Coordinates of the top-left pixel to * be updated in the image. */ int width, height; /* Dimensions of the area of the image * to be updated. */ int zoomX, zoomY; /* Zoom factors for the X and Y axes. */ int subsampleX, subsampleY; /* Subsampling factors for the X and Y axes. */ { register PictMaster *masterPtr; PictInstance *instancePtr; int xEnd, yEnd; int wLeft, hLeft; int wCopy, hCopy; int blockWid, blockHt; unsigned char *srcPtr, *srcLinePtr, *srcOrigPtr; unsigned char *destPtr, *destLinePtr; int pitch; int xRepeat, yRepeat; int blockXSkip, blockYSkip; XRectangle rect; register int il; #ifdef DEBUG printf("Tk_PictPutZoomedBlock\n"); #endif if ((zoomX == 1) && (zoomY == 1) && (subsampleX == 1) && (subsampleY == 1)) { Tk_PictPutBlock(handle, blockPtr, x, y, width, height); return; } masterPtr = (PictMaster *) handle; if ((zoomX <= 0) || (zoomY <= 0)) return; if ((masterPtr->userWidth != 0) && ((x + width) > masterPtr->userWidth)) { width = masterPtr->userWidth - x; } if ((masterPtr->userHeight != 0) && ((y + height) > masterPtr->userHeight)) { height = masterPtr->userHeight - y; } if ((width <= 0) || (height <= 0)) return; xEnd = x + width; yEnd = y + height; if ((xEnd > masterPtr->width) || (yEnd > masterPtr->height)) { ImgPictSetSize(masterPtr, MAX(xEnd, masterPtr->width), MAX(yEnd, masterPtr->height)); } if( masterPtr->data == NULL ) { #ifdef DEBUG printf("needs allocation \n"); #endif masterPtr->datatype = blockPtr->datatype; masterPtr->datasize = blockPtr->pixelSize; masterPtr->pixel_x = blockPtr->pixel_x; masterPtr->pixel_y = blockPtr->pixel_y; masterPtr->data = (char*)ckalloc((size_t)masterPtr->datasize* masterPtr->width* masterPtr->height); if( masterPtr->data == NULL ) { (void)fprintf(stderr,"Could not allocate memory \n"); return; } } else { if (masterPtr->datatype != blockPtr->datatype ) { (void)fprintf(stderr,"Type mismatch \n"); return; } if ((masterPtr->pixel_x != blockPtr->pixel_x) || (masterPtr->pixel_y != blockPtr->pixel_y) ) { printf("Warning : the physical dimensions of the block being read will not be saved \n"); } } /* * Work out what area the pixel data in the block expands to after * subsampling and zooming. */ blockXSkip = subsampleX * blockPtr->pixelSize; blockYSkip = subsampleY * blockPtr->pitch * blockPtr->pixelSize; if (subsampleX > 0) blockWid = ((blockPtr->width + subsampleX - 1) / subsampleX) * zoomX; else if (subsampleX == 0) blockWid = width; else blockWid = ((blockPtr->width - subsampleX - 1) / -subsampleX) * zoomX; if (subsampleY > 0) blockHt = ((blockPtr->height + subsampleY - 1) / subsampleY) * zoomY; else if (subsampleY == 0) blockHt = height; else blockHt = ((blockPtr->height - subsampleY - 1) / -subsampleY) * zoomY; destLinePtr = (unsigned char*)(masterPtr->data + (y * masterPtr->width + x)*masterPtr->datasize); srcOrigPtr = blockPtr->pixelPtr; if (subsampleX < 0) { srcOrigPtr += (blockPtr->width - 1) * blockPtr->pixelSize; } if (subsampleY < 0) { srcOrigPtr += (blockPtr->height - 1) * blockPtr->pitch * blockPtr->pixelSize; } pitch = masterPtr->width*masterPtr->datasize; for (hLeft = height; hLeft > 0; ) { hCopy = MIN(hLeft, blockHt); hLeft -= hCopy; yRepeat = zoomY; srcLinePtr = srcOrigPtr; for (; hCopy > 0; --hCopy) { destPtr = destLinePtr; for (wLeft = width; wLeft > 0;) { wCopy = MIN(wLeft, blockWid); wLeft -= wCopy; srcPtr = srcLinePtr; for (; wCopy > 0; wCopy -= zoomX) { for (xRepeat = MIN(wCopy, zoomX); xRepeat > 0; xRepeat--) { for(il=0;ildatasize;il++) *destPtr++ = srcPtr[il]; } srcPtr += blockXSkip; } } destLinePtr += pitch; yRepeat--; if (yRepeat <= 0) { srcLinePtr += blockYSkip; yRepeat = zoomY; } } } normalize_data(masterPtr); blockPtr->pixelPtr = NULL; /* * Add this new block to the region that specifies which data is valid. */ rect.x = x; rect.y = y; rect.width = width; rect.height = height; XUnionRectWithRegion(&rect, masterPtr->validRegion, masterPtr->validRegion); /* * Update each instance. */ for(instancePtr = masterPtr->instancePtr; instancePtr != NULL; instancePtr = instancePtr->nextPtr) DitherInstance(instancePtr, x, y, width, height); /* * Tell the core image code that this image has changed. */ Tk_ImageChanged(masterPtr->tkMaster, x, y, width, height, masterPtr->width, masterPtr->height); } /* *---------------------------------------------------------------------- * * Tk_PictBlank -- * * This procedure is called to clear an entire Pict image. * * Results: * None. * * Side effects: * The valid region for the image is set to the null region. * The generic image code is notified that the image has changed. * *---------------------------------------------------------------------- */ void Tk_PictBlank(handle) Tk_PictHandle handle; /* Handle for the image to be blanked. */ { PictMaster *masterPtr; #ifdef DEBUG printf("Tk_PictBlank\n"); #endif masterPtr = (PictMaster *) handle; /* * The image has valid data nowhere. */ if (masterPtr->validRegion != NULL) { XDestroyRegion(masterPtr->validRegion); } masterPtr->validRegion = XCreateRegion(); /* * Clear out the data storage array. */ memset((VOID *) masterPtr->data, 0, (size_t) (masterPtr->width * masterPtr->height * masterPtr->datasize)); /* * Tell the core image code that this image has changed. */ Tk_ImageChanged(masterPtr->tkMaster, 0, 0, masterPtr->width, masterPtr->height, masterPtr->width, masterPtr->height); } /* *---------------------------------------------------------------------- * * Tk_PictExpand -- * * This procedure is called to request that a Pict image be * expanded if necessary to be at least `width' pixels wide and * `height' pixels high. If the user has declared a definite * image size (using the -width and -height configuration * options) then this call has no effect. * * Results: * None. * * Side effects: * The size of the Pict image may change; if so the generic * image code is informed. * *---------------------------------------------------------------------- */ void Tk_PictExpand(handle, width, height) Tk_PictHandle handle; /* Handle for the image to be expanded. */ int width, height; /* Desired minimum dimensions of the image. */ { PictMaster *masterPtr; #ifdef DEBUG printf("Tk_PictExpand\n"); #endif masterPtr = (PictMaster *) handle; if (width <= masterPtr->width) { width = masterPtr->width; } if (height <= masterPtr->height) { height = masterPtr->height; } if ((width != masterPtr->width) || (height != masterPtr->height)) { ImgPictSetSize(masterPtr, MAX(width, masterPtr->width), MAX(height, masterPtr->height)); Tk_ImageChanged(masterPtr->tkMaster, 0, 0, 0, 0, masterPtr->width, masterPtr->height); } } /* *---------------------------------------------------------------------- * * Tk_PictGetSize -- * * This procedure is called to obtain the current size of a Pict * image. * * Results: * The image's width and height are returned in *widthp * and *heightp. * * Side effects: * None. * *---------------------------------------------------------------------- */ void Tk_PictGetSize(handle, widthPtr, heightPtr) Tk_PictHandle handle; /* Handle for the image whose dimensions * are requested. */ int *widthPtr, *heightPtr; /* The dimensions of the image are returned * here. */ { PictMaster *masterPtr; #ifdef DEBUG printf("Tk_PictGetSize\n"); #endif masterPtr = (PictMaster *) handle; *widthPtr = masterPtr->width; *heightPtr = masterPtr->height; } /* *---------------------------------------------------------------------- * * Tk_PictSetSize -- * * This procedure is called to set size of a Pict image. * This call is equivalent to using the -width and -height * configuration options. * * Results: * None. * * Side effects: * The size of the image may change; if so the generic * image code is informed. * *---------------------------------------------------------------------- */ void Tk_PictSetSize(handle, width, height) Tk_PictHandle handle; /* Handle for the image whose size is to * be set. */ int width, height; /* New dimensions for the image. */ { PictMaster *masterPtr; #ifdef DEBUG printf("Tk_PictSetSize\n"); #endif masterPtr = (PictMaster *) handle; masterPtr->userWidth = width; masterPtr->userHeight = height; ImgPictSetSize(masterPtr, ((width > 0) ? width: masterPtr->width), ((height > 0) ? height: masterPtr->height)); Tk_ImageChanged(masterPtr->tkMaster, 0, 0, 0, 0, masterPtr->width, masterPtr->height); } /* *---------------------------------------------------------------------- * * Tk_PictGetImage -- * * This procedure is called to obtain image data from a Pict * image. This procedure fills in the Tk_PictImageBlock structure * pointed to by `blockPtr' with details of the address and * layout of the image data in memory. * * Results: * TRUE (1) indicating that image data is available, * for backwards compatibility with the old Pict widget. * * Side effects: * None. * *---------------------------------------------------------------------- */ int Tk_PictGetImage(handle, blockPtr) Tk_PictHandle handle; /* Handle for the Pict image from which * image data is desired. */ Tk_PictImageBlock *blockPtr; /* Information about the address and layout * of the image data is returned here. */ { PictMaster *masterPtr; #ifdef DEBUG printf("Tk_PictGetImage\n"); #endif masterPtr = (PictMaster *) handle; blockPtr->pixelPtr = (unsigned char*)masterPtr->data; blockPtr->width = masterPtr->width; blockPtr->height = masterPtr->height; blockPtr->pitch = masterPtr->width; blockPtr->pixelSize = masterPtr->datasize;; blockPtr->datatype = masterPtr->datatype; blockPtr->copy = COPY; blockPtr->skip = masterPtr->skip; blockPtr->pixel_x = masterPtr->pixel_x; blockPtr->pixel_y = masterPtr->pixel_y; return 1; } static int make_colorbar(Tk_PictHandle handle, int width, int height) { Tk_PictImageBlock block; int i,j; unsigned char *pixelPtr; int nBytes; #ifdef DEBUG printf("make_colorbar \n"); #endif block.datatype = BYTE; block.pixelSize = sizeof(unsigned char); block.width = width; block.height = height; block.pitch = block.pixelSize * width; nBytes = width * height * block.pixelSize; pixelPtr = (unsigned char *) ckalloc((unsigned) nBytes); if ( pixelPtr == NULL ) return 0; for(j=0;jbytedata != NULL ) { ckfree((void*)masterPtr->bytedata); } out=(unsigned char*)ckalloc((size_t)(masterPtr->width*masterPtr->height*sizeof(unsigned char))); if( out == NULL ) { (void)fprintf(stderr,"Could not allocate memory \n"); return; } masterPtr->bytedata = out; if( masterPtr->user_dispmin != 0.0 || masterPtr->user_dispmax != 0.0 ) { masterPtr->dispmin = masterPtr->user_dispmin; masterPtr->dispmax = masterPtr->user_dispmax; } else { masterPtr->dispmin = 0.0; masterPtr->dispmax = 0.0; } convert_block_to_byte((void*)masterPtr->data, (unsigned char*)masterPtr->bytedata, (masterPtr->width)*(masterPtr->height), masterPtr->datatype, &(masterPtr->dispmin), &(masterPtr->dispmax)); } /* end normalize_data */ /* extract the pixel values along an arbitrary line. No interpolation, uses the Bresenham algorithm instead */ static void get_line_pixels(char *string, unsigned char *img, int nr,int nc, int x1,int y1, int x2,int y2, double min, double max) { int d, x, y, ax, ay, sx, sy, dx, dy; int pix_int; int i = 0; char string1[10000]; dx = x2-x1; ax = ABS(dx)<<1; sx = SGN(dx); dy = y2-y1; ay = ABS(dy)<<1; sy = SGN(dy); x = x1; y = y1; if (ax>ay) { /* x dominant */ d = ay-(ax>>1); for (;;) { /* add index x+y*nc to list */ if ((y<0) || (y>= nr) || (x<0) || (x>nc)) pix_int = 0; else pix_int = img[y*nc + x]; sprintf(string1,"%d ",i++); strcat(string,string1); sprintf(string1,"%g ",((double)pix_int/(double)(MAX_COLORS-1.0)*(max-min))+min); strcat(string,string1); if (x==x2) return; if (d>=0) { y += sy; d -= ax; } x += sx; d += ay; } } else { /* y dominant */ d = ax-(ay>>1); for (;;) { /* add index x+y*nc to list */ if ((y<0) || (y>= nr) || (x<0) || (x>nc)) pix_int = 0; else pix_int = img[y*nc + x]; sprintf(string1,"%d ",i++); strcat(string,string1); sprintf(string1,"%g ",((double)pix_int/(double)(MAX_COLORS-1.0)*(max-min))+min); strcat(string,string1); if (y==y2) return; if (d>=0) { x += sx; d -= ay; } y += sy; d += ax; } } } /* end get_line_pixels */ static int ChangeColorTable(PictMaster *masterPtr) { PictInstance *instancePtr = masterPtr->instancePtr; PictColorTable *colorTable; PictColorTable *old_colorTable; XVisualInfo *visInfoPtr; XRectangle validBox; #ifdef DEBUG printf("ChangeColorTable \n"); #endif old_colorTable = instancePtr->colorTable; old_colorTable->refCount--; if ( old_colorTable->refCount == 0 ) { DisposeColorTable((PictColorTable *)old_colorTable); } if( GetColorTable(instancePtr->tkwin,(PictColorTable **)&colorTable, (XVisualInfo **)&visInfoPtr) == 0 ) { fprintf(stderr," GetColorTable failed \n"); return 0; } instancePtr->display = colorTable->display; instancePtr->colormap = colorTable->colormap; instancePtr->colormap_level = colorTable->colormap_level; instancePtr->has_overlay = 0; instancePtr->colorTable = colorTable; instancePtr->visualInfo = *visInfoPtr; XFree(visInfoPtr); XClipBox(masterPtr->validRegion, &validBox); if ((validBox.width > 0) && (validBox.height > 0)) { DitherInstance(instancePtr, validBox.x, validBox.y, validBox.width, validBox.height); } Tk_ImageChanged(masterPtr->tkMaster, 0, 0, masterPtr->width, masterPtr->height, masterPtr->width, masterPtr->height); return 1; } /* end ChangeColorTable */ #ifdef PLB_SEGMENT static int ImgPictClip(Tcl_Interp *interp, PictMaster *masterPtr, int argc, char **argv) { PictInstance *instancePtr; int loval,hival; double dloval,dhival; int sim; if (argc < 3 || argc > 4) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " clip loval [hival]\"", (char *) NULL); return TCL_ERROR; } sim = masterPtr->width*masterPtr->height; if(masterPtr->datatype == BYTE) { if(argc==3) { if(Tcl_GetInt(interp, argv[2], &loval) != TCL_OK) return TCL_ERROR; if(loval<0 || loval > 255) { Tcl_AppendResult(interp, argv[0], "clip: ", "parameters should be in range [0-255]", (char *) NULL); return TCL_ERROR; } lclip_above_ubyte((unsigned char*)masterPtr->data,sim, loval); } else { if((Tcl_GetInt(interp, argv[2], &loval) != TCL_OK) || (Tcl_GetInt(interp, argv[3], &hival) != TCL_OK)) return TCL_ERROR; if(loval<0 || loval > 255 || hival<0 || hival>255) { Tcl_AppendResult(interp, argv[0], "clip: ", "parameters should be in range [0-255]", (char *) NULL); return TCL_ERROR; } lclip_ubyte((unsigned char*)masterPtr->data,sim,loval,hival); } } else if(masterPtr->datatype == WORD ) { if(argc==3) { if(Tcl_GetInt(interp, argv[2], &loval) != TCL_OK) return TCL_ERROR; if(loval<-32767 || loval > 32767 ) { Tcl_AppendResult(interp, argv[0], "clip: ", "parameters should be in range [-32768,32768]", (char *) NULL); return TCL_ERROR; } lclip_above_short((short*)masterPtr->data,sim,loval); } else { if((Tcl_GetInt(interp, argv[2], &loval) != TCL_OK) || (Tcl_GetInt(interp, argv[3], &hival) != TCL_OK)) return TCL_ERROR; if((loval<-32767) || (loval > 32767) || (hival<-32767) || (hival>32767)) { Tcl_AppendResult(interp, argv[0], "clip: ", "parameters should be in range [-32768,32768]", (char *) NULL); return TCL_ERROR; } lclip_short((short*)masterPtr->data,sim,loval,hival); } } else if(masterPtr->datatype == LWORD ) { if(argc==3) { if(Tcl_GetInt(interp, argv[2], &loval) != TCL_OK) return TCL_ERROR; lclip_above_int((int*)masterPtr->data,sim,loval); } else { if((Tcl_GetInt(interp, argv[2], &loval) != TCL_OK) || (Tcl_GetInt(interp, argv[3], &hival) != TCL_OK)) return TCL_ERROR; lclip_int((int*)masterPtr->data,sim,loval,hival); } } else if(masterPtr->datatype == REAL ) { /*this should be duplicated for DOUBLEs, but since I don't have the plb segment library, I've no idea how. LEB */ if(argc==3) { if(Tcl_GetDouble(interp, argv[2], &dloval) != TCL_OK) return TCL_ERROR; lclip_above_float((float*)masterPtr->data,sim,dloval); } else { if((Tcl_GetDouble(interp, argv[2], &dloval) != TCL_OK) || (Tcl_GetDouble(interp, argv[3], &dhival) != TCL_OK)) return TCL_ERROR; lclip_float((float*)masterPtr->data,sim, (float)dloval,(float)dhival); } } normalize_data(masterPtr); /* * Update each instance. */ for(instancePtr = masterPtr->instancePtr; instancePtr != NULL; instancePtr = instancePtr->nextPtr) DitherInstance(instancePtr, 0, 0, masterPtr->width, masterPtr->height); /* * Tell the core image code that this image has changed. */ Tk_ImageChanged(masterPtr->tkMaster, 0, 0, masterPtr->width, masterPtr->height, masterPtr->width, masterPtr->height); return TCL_OK; } /* end ImgPictClip */ static int ImgPictThreshold(Tcl_Interp *interp, PictMaster *masterPtr, int argc, char **argv) { PictInstance *instancePtr; int loval,hival,inval,outval; int rdval; double dloval,dhival,dinval,doutval; int sim; int parsed1 = 1; char *arg; int argstart; int has_lo; int has_hi; if( argc == 2 ) { Tcl_AppendResult(interp,"Usage ",argv[0]," threshold -loval [-hival -inval -outval ] \n",(char*)NULL); return TCL_ERROR; } has_lo = has_hi = 0; argstart = 2; if ( masterPtr->datatype == BYTE ) { inval = 255; outval = 0; } else if ( masterPtr->datatype == WORD || masterPtr->datatype == LWORD ) { inval = 1; outval = 0; } else if (masterPtr->datatype == REAL ) { /*this should be duplicated for DOUBLEs, but since I don't have the plb segment library, I've no idea how. LEB */ dinval = 1.0; doutval = 0.0; } if ( masterPtr->datatype != REAL ) { /*this should be duplicated for DOUBLEs, but since I don't have the plb segment library, I've no idea how. LEB */ while( (argstart [-hival -inval -outval ] \n",(char*)NULL); return TCL_ERROR; } if(masterPtr->datatype == BYTE) { if((rdval<0 || rdval > 255)) { Tcl_AppendResult(interp, argv[0], "threshold: ", "parameters should be in range [0-255]", (char *) NULL); return TCL_ERROR; } } else if(masterPtr->datatype == WORD) { if((loval<-32767) || (loval > 32767)) { Tcl_AppendResult(interp, argv[0], "threshold: ", "parameters should be in range [-32768,32768]", (char *) NULL); return TCL_ERROR; } } } } else { /* process floating-points */ while ((arg = argv[argstart]) != NULL && parsed1) { parsed1 = 0; if (strcmp(arg,"-loval") == 0) { has_lo = parsed1 = 1; ++argstart; if( argv[argstart] != NULL ) { if( (Tcl_GetDouble(interp, argv[argstart], &dloval) != TCL_OK)) { Tcl_AppendResult(interp," could not read value for ",arg, " option",(char*)NULL); return TCL_ERROR; } } argstart++; } else if (strcmp(arg,"-hival") == 0) { has_hi = parsed1 = 1; ++argstart; if( argv[argstart] != NULL ) { if( (Tcl_GetDouble(interp, argv[argstart], &dhival) != TCL_OK)) { Tcl_AppendResult(interp," could not read value for ",arg," option",(char*)NULL); return TCL_ERROR; } } argstart++; } else if (strcmp(arg,"-inval") == 0) { parsed1 = 1; ++argstart; if( argv[argstart] != NULL ) { if( (Tcl_GetDouble(interp, argv[argstart], &dinval) != TCL_OK)) { Tcl_AppendResult(interp," could not read value for ",arg, " option",(char*)NULL); return TCL_ERROR; } } argstart++; } else if (strcmp(arg,"-outval") == 0) { parsed1 = 1; ++argstart; if( argv[argstart] != NULL ) { if( (Tcl_GetDouble(interp, argv[argstart], &doutval) != TCL_OK)) { Tcl_AppendResult(interp," could not read value for ",arg, " option",(char*)NULL); return TCL_ERROR; } } argstart++; } else { Tcl_AppendResult(interp,"Usage ",argv[0]," threshold -loval [-hival -in -out ] \n",(char*)NULL); return TCL_ERROR; } } } if( !has_lo) { Tcl_AppendResult(interp,"Usage ",argv[0]," threshold -loval [-hival -inval -outval ] \n",(char*)NULL); return TCL_ERROR; } sim = masterPtr->width*masterPtr->height; if(masterPtr->datatype == BYTE) { if( !has_hi ) lthres_above_ubyte((unsigned char*)masterPtr->data, (unsigned char*)masterPtr->data, sim, loval,inval,outval); else lthres_between_ubyte((unsigned char*)masterPtr->data, (unsigned char*)masterPtr->data, sim, loval,hival,inval,outval); } else if(masterPtr->datatype == WORD ) { if( !has_hi ) lthres_above_short((short*)masterPtr->data, (short*)masterPtr->data, sim,loval,inval,outval); else lthres_between_short((short*)masterPtr->data, (short*)masterPtr->data, sim,loval,hival,inval,outval); } else if(masterPtr->datatype == LWORD ) { if( !has_hi ) lthres_above_int((int*)masterPtr->data, (int*)masterPtr->data, sim,loval,inval,outval); else lthres_between_int((int*)masterPtr->data, (int*)masterPtr->data, sim,loval,hival,inval,outval); } else if(masterPtr->datatype == REAL ) { /*this should be duplicated for DOUBLEs, but since I don't have the plb segment library, I've no idea how. LEB */ if( !has_hi ) lthres_above_float((float*)masterPtr->data, (float*)masterPtr->data, sim,(float)dloval,(float)dinval,(float)doutval); else lthres_between_float((float*)masterPtr->data, (float*)masterPtr->data, sim, (float)dloval,(float)dhival, (float)dinval,(float)doutval); } normalize_data(masterPtr); /* * Update each instance. */ for(instancePtr = masterPtr->instancePtr; instancePtr != NULL; instancePtr = instancePtr->nextPtr) DitherInstance(instancePtr, 0, 0, masterPtr->width, masterPtr->height); /* * Tell the core image code that this image has changed. */ Tk_ImageChanged(masterPtr->tkMaster, 0, 0, masterPtr->width, masterPtr->height, masterPtr->width, masterPtr->height); return TCL_OK; } /* end ImgPictThreshold */ static int ImgPictSmooth(Tcl_Interp *interp, PictMaster *masterPtr, int argc, char **argv) { Tk_PictHandle srcHandle; PictMaster *srcMasterPtr; Tk_PictImageBlock block; float *temp_img; float *buffer; int nr,nc; int npts; float *binom_filter; int filter_order=7; int len; if(argc != 3 && argc != 5) { Tcl_AppendResult(interp,"wrong # of arguments, should be ", argv[0], " smooth [-order ]", (char *) NULL); return TCL_ERROR; } if( argc==5 ) { len = strlen(argv[3]); if (strncmp(argv[3],"-order",len) != 0 || (Tcl_GetInt(interp, argv[4], &filter_order) != TCL_OK )) { Tcl_AppendResult(interp," wrong # of arguments, should be ", argv[0], "smooth [-order ]", (char *) NULL); return TCL_ERROR; } if (filter_order<1 || filter_order> 40) { Tcl_AppendResult(interp,"The order of the low-pass filter is too big. The maximum acceptable value is 40", (char *) NULL); return TCL_ERROR; } } if ((srcHandle = Tk_FindPict(argv[2])) == NULL) { Tcl_AppendResult(interp, "image \"", argv[2], "\" doesn't", " exist or is not a Pict image", (char *) NULL); return TCL_ERROR; } srcMasterPtr = (PictMaster *)srcHandle; if( srcMasterPtr->data == NULL ) { Tcl_AppendResult(interp, "image \"", argv[2], "\" doesn't", " contain any data", (char *) NULL); return TCL_ERROR; } /* allocate memory */ nr = srcMasterPtr->height; nc = srcMasterPtr->width; npts = nr*nc; temp_img = (float*)ckalloc(npts*sizeof(float)); if ( temp_img == NULL) { Tcl_AppendResult(interp, "Cannot allocate memory in smooth ", (char*)NULL); return TCL_ERROR; } /* convert to float and allocate memory */ buffer = (float*)ckalloc(npts*sizeof(float)); if ( buffer == NULL) { Tcl_AppendResult(interp, "Cannot allocate memory in smooth ", (char*)NULL); return TCL_ERROR; } /* allocate memory for filter */ binom_filter = (float*)ckalloc(filter_order*sizeof(float)); if ( binom_filter == NULL) { Tcl_AppendResult(interp, "Cannot allocate memory in smooth ", (char*)NULL); return TCL_ERROR; } lconvert_types(npts, (void*)srcMasterPtr->data, srcMasterPtr->datatype, (void*)buffer, REAL); lbinom_float_1D(binom_filter,filter_order); lconvolve2D_float((char*)buffer,(char*)binom_filter,(char*)temp_img, nr,nc,filter_order,1); lconvolve2D_float((char*)temp_img,(char*)binom_filter,(char*)buffer, nr,nc,1,filter_order); block.width = nc; block.height = nr; block.pitch = nc; block.pixelSize = sizeof(float); block.datatype = REAL; block.copy = NO_COPY; block.skip = 0; block.pixel_x = srcMasterPtr->pixel_x; block.pixel_y = srcMasterPtr->pixel_y; block.pixelPtr = (unsigned char*)buffer; /* set image size */ Tk_PictExpand(masterPtr,nc,nr); Tk_PictPutBlock(masterPtr,&block,0,0,nc,nr); /* free memory */ ckfree((void*)temp_img); ckfree((void*)binom_filter); return TCL_OK; } /* end ImgPictSmooth */ static int ImgPictGradient(Tcl_Interp *interp, PictMaster *masterPtr, int argc, char **argv) { Tk_PictHandle srcHandle; PictMaster *srcMasterPtr; Tk_PictImageBlock block; float *g_img; float *buffer; int npts; int nr,nc; int len; float *binom_filter; int filter_order = 1; if(argc != 3 && argc != 5) { Tcl_AppendResult(interp,"wrong # of arguments, should be ", argv[0], " gradient [-order ]", (char *) NULL); return TCL_ERROR; } if( argc==5 ) { len = strlen(argv[3]); if (strncmp(argv[3],"-order",len) != 0 || (Tcl_GetInt(interp, argv[4], &filter_order) != TCL_OK )) { Tcl_AppendResult(interp," wrong # of arguments, should be ", argv[0], "gradient [-order ]", (char *) NULL); return TCL_ERROR; } if (filter_order<1 || filter_order> 40) { Tcl_AppendResult(interp,"The order of the low-pass filter is too big. The maximum acceptable value is 40", (char *) NULL); return TCL_ERROR; } } if ((srcHandle = Tk_FindPict(argv[2])) == NULL) { Tcl_AppendResult(interp, "image \"", argv[2], "\" doesn't", " exist or is not a Pict image", (char *) NULL); return TCL_ERROR; } srcMasterPtr = (PictMaster *)srcHandle; if( srcMasterPtr->data == NULL ) { Tcl_AppendResult(interp, "image \"", argv[2], "\" doesn't", " contain any data", (char *) NULL); return TCL_ERROR; } /* allocate memory */ nr = srcMasterPtr->height; nc = srcMasterPtr->width; npts = nr*nc; g_img = (float*)ckalloc(npts*sizeof(float)); if ( g_img == NULL) { Tcl_AppendResult(interp, "Cannot allocate memory in gradient ", (char*)NULL); return TCL_ERROR; } /* convert to float if necessary, otherwise copy */ buffer = (float*)ckalloc(npts*sizeof(float)); if ( buffer == NULL) { Tcl_AppendResult(interp, "Cannot allocate memory in gradient ", (char*)NULL); return TCL_ERROR; } lconvert_types(npts, (void*)srcMasterPtr->data, srcMasterPtr->datatype, (void*)buffer, REAL); if( filter_order > 1 ) { /* allocate memory for filter */ binom_filter = (float*)ckalloc(filter_order*sizeof(float)); if ( binom_filter == NULL) { Tcl_AppendResult(interp, "Cannot allocate memory in gradient ", (char*)NULL); return TCL_ERROR; } lbinom_float_1D(binom_filter,filter_order); lconvolve2D_float((char*)buffer,(char*)binom_filter,(char*)g_img, nr,nc,filter_order,1); lconvolve2D_float((char*)g_img,(char*)binom_filter,(char*)buffer, nr,nc,1,filter_order); } lgradient2D_float((float*)buffer,(float*)g_img,nr,nc); block.width = nc; block.height = nr; block.pitch = nc; block.pixelSize = sizeof(float); block.datatype = REAL; block.copy = NO_COPY; block.skip = 0; block.pixel_x = srcMasterPtr->pixel_x; block.pixel_y = srcMasterPtr->pixel_y; block.pixelPtr = (unsigned char*)g_img; /* set the dimensions to force reallocation of memory */ masterPtr->width = 0; masterPtr->height = 0; Tk_PictPutBlock(masterPtr,&block,0,0,nc,nr); /* free memory */ ckfree((void*)buffer); if( filter_order > 1 ) ckfree((void*)binom_filter); return TCL_OK; } /* end ImgPictGradient */ static int ImgPictLaplacian(Tcl_Interp *interp, PictMaster *masterPtr, int argc, char **argv) { Tk_PictHandle srcHandle; PictMaster *srcMasterPtr; Tk_PictImageBlock block; float *g_img; float *buffer; int npts; int nr,nc; int len; if(argc != 3) { Tcl_AppendResult(interp,"wrong # of arguments, should be ", argv[0], " laplacian ", (char *) NULL); return TCL_ERROR; } if ((srcHandle = Tk_FindPict(argv[2])) == NULL) { Tcl_AppendResult(interp, "image \"", argv[2], "\" doesn't", " exist or is not a Pict image", (char *) NULL); return TCL_ERROR; } srcMasterPtr = (PictMaster *)srcHandle; if( srcMasterPtr->data == NULL ) { Tcl_AppendResult(interp, "image \"", argv[2], "\" doesn't", " contain any data", (char *) NULL); return TCL_ERROR; } /* allocate memory */ nr = srcMasterPtr->height; nc = srcMasterPtr->width; npts = nr*nc; g_img = (float*)ckalloc(npts*sizeof(float)); if ( g_img == NULL) { Tcl_AppendResult(interp, "Cannot allocate memory in laplacian ", (char*)NULL); return TCL_ERROR; } /* convert to float if necessary, otherwise copy */ buffer = (float*)ckalloc(npts*sizeof(float)); if ( buffer == NULL) { Tcl_AppendResult(interp, "Cannot allocate memory in laplacian ", (char*)NULL); return TCL_ERROR; } lconvert_types(npts, (void*)srcMasterPtr->data, srcMasterPtr->datatype, (void*)buffer, REAL); llaplacian2D_float((float*)buffer,(float*)g_img,nr,nc); block.width = nc; block.height = nr; block.pitch = nc; block.pixelSize = sizeof(float); block.datatype = REAL; block.copy = NO_COPY; block.skip = 0; block.pixel_x = srcMasterPtr->pixel_x; block.pixel_y = srcMasterPtr->pixel_y; block.pixelPtr = (unsigned char*)g_img; /* set the dimensions to force reallocation of memory */ masterPtr->width = 0; masterPtr->height = 0; Tk_PictPutBlock(masterPtr,&block,0,0,nc,nr); /* free memory */ ckfree((void*)buffer); return TCL_OK; } /* end ImgPictLaplacian */ static int ImgPictZeroCrng(Tcl_Interp *interp, PictMaster *masterPtr, int argc, char **argv) { Tk_PictHandle srcHandle; PictMaster *srcMasterPtr; Tk_PictImageBlock block; unsigned char *result; float *buffer; int npts; int nr,nc; int i,j; unsigned char temp; if(argc != 3) { Tcl_AppendResult(interp,"wrong # of arguments, should be ", argv[0], " zero_crossings ", (char *) NULL); return TCL_ERROR; } if ((srcHandle = Tk_FindPict(argv[2])) == NULL) { Tcl_AppendResult(interp, "image \"", argv[2], "\" doesn't", " exist or is not a Pict image", (char *) NULL); return TCL_ERROR; } srcMasterPtr = (PictMaster *)srcHandle; if( srcMasterPtr->data == NULL ) { Tcl_AppendResult(interp, "image \"", argv[2], "\" doesn't", " contain any data", (char *) NULL); return TCL_ERROR; } if( srcMasterPtr->datatype != REAL ) { Tcl_AppendResult(interp, "Can only compute zero-crossings for floating-point images", (char *) NULL); return TCL_ERROR; } /* allocate memory */ nr = srcMasterPtr->height; nc = srcMasterPtr->width; npts = nr*nc; result = (unsigned char*)ckalloc(npts*sizeof(unsigned char)); if ( result == NULL) { Tcl_AppendResult(interp, "Cannot allocate memory in zero_crossings ", (char*)NULL); return TCL_ERROR; } memset((void*)result,0,npts*sizeof(unsigned char)); buffer = (float*)(srcMasterPtr->data); /* detect zero_crossings */ for(i=1;i<(nc-1);i++) for(j=1;j<(nr-1);j++) { temp = 0; if( buffer[j*nc+i] < 0.0 ) { if(((float)(buffer[(j+1)*nc +i]) > 0.) || ((float)(buffer[j*nc +i+1]) > 0.) ) temp = 255; } if( buffer[j*nc+i] >= 0.0 ) { if(((float)(buffer[(j+1)*nc +i]) <= 0.) || ((float)(buffer[j*nc +i+1]) <= 0.) ) temp = 255; } result[j*nc + i ] = temp; } block.width = nc; block.height = nr; block.pitch = nc; block.pixelSize = sizeof(unsigned char); block.datatype = BYTE; block.copy = NO_COPY; block.skip = 0; block.pixel_x = srcMasterPtr->pixel_x; block.pixel_y = srcMasterPtr->pixel_y; block.pixelPtr = (unsigned char*)result; /* set the dimensions to force reallocation of memory */ masterPtr->width = 0; masterPtr->height = 0; Tk_PictPutBlock(masterPtr,&block,0,0,nc,nr); return TCL_OK; } /* end ImgPictZeroCrng */ static int ImgPictErosion(Tcl_Interp *interp, PictMaster *masterPtr, int argc, char **argv) { Tk_PictHandle srcHandle; PictMaster *srcMasterPtr; Tk_PictImageBlock block; unsigned char *result; int nr,nc; int x,y; int npts; if(argc != 5) { Tcl_AppendResult(interp,"wrong # of arguments, should be ", argv[0], " erosion x y", (char *) NULL); return TCL_ERROR; } if((Tcl_GetInt(interp, argv[3], &x) != TCL_OK) || (Tcl_GetInt(interp, argv[4], &y) != TCL_OK)) { Tcl_AppendResult(interp," wrong arguments, should be ", argv[0], " erosion x y", (char *) NULL); return TCL_ERROR; } if ((srcHandle = Tk_FindPict(argv[2])) == NULL) { Tcl_AppendResult(interp, "image \"", argv[2], "\" doesn't", " exist or is not a Pict image", (char *) NULL); return TCL_ERROR; } srcMasterPtr = (PictMaster *)srcHandle; if( srcMasterPtr->data == NULL ) { Tcl_AppendResult(interp, "image \"", argv[2], "\" doesn't", " contain any data", (char *) NULL); return TCL_ERROR; } /* allocate memory */ nr = srcMasterPtr->height; nc = srcMasterPtr->width; npts = nr*nc; /* allocate memory for result */ result = (unsigned char*)ckalloc(npts*sizeof(unsigned char)); if ( result == NULL) { Tcl_AppendResult(interp, "Cannot allocate memory in erosion ", (char*)NULL); return TCL_ERROR; } memcpy((void*)result,(void*)(srcMasterPtr->bytedata), (size_t)(npts*sizeof(unsigned char))); if( !lseparable_erosion_3D(result,nr,nc,1, x,y,0) ) { Tcl_AppendResult(interp, "lerosion_3D failed", (char*)NULL); ckfree((void*)result); return TCL_ERROR; } block.width = nc; block.height = nr; block.pitch = nc; block.pixelSize = sizeof(unsigned char); block.datatype = BYTE; block.copy = NO_COPY; block.skip = 0; block.pixel_x = srcMasterPtr->pixel_x; block.pixel_y = srcMasterPtr->pixel_y; block.pixelPtr = (unsigned char*)result; /* set image size */ Tk_PictExpand(masterPtr,nc,nr); Tk_PictPutBlock(masterPtr,&block,0,0,nc,nr); return TCL_OK; } /* end ImgPictErosion*/ static int ImgPictDilation(Tcl_Interp *interp, PictMaster *masterPtr, int argc, char **argv) { Tk_PictHandle srcHandle; PictMaster *srcMasterPtr; Tk_PictImageBlock block; unsigned char *result; int nr,nc; int x,y; int npts; if(argc != 5) { Tcl_AppendResult(interp,"wrong # of arguments, should be ", argv[0], " dilation x y", (char *) NULL); return TCL_ERROR; } if((Tcl_GetInt(interp, argv[3], &x) != TCL_OK) || (Tcl_GetInt(interp, argv[4], &y) != TCL_OK)) { Tcl_AppendResult(interp," wrong arguments, should be ", argv[0], " dilation x y", (char *) NULL); return TCL_ERROR; } if ((srcHandle = Tk_FindPict(argv[2])) == NULL) { Tcl_AppendResult(interp, "image \"", argv[2], "\" doesn't", " exist or is not a Pict image", (char *) NULL); return TCL_ERROR; } srcMasterPtr = (PictMaster *)srcHandle; if( srcMasterPtr->data == NULL ) { Tcl_AppendResult(interp, "image \"", argv[2], "\" doesn't", " contain any data", (char *) NULL); return TCL_ERROR; } /* allocate memory */ nr = srcMasterPtr->height; nc = srcMasterPtr->width; npts = nr*nc; /* allocate memory for result */ result = (unsigned char*)ckalloc(npts*sizeof(unsigned char)); if ( result == NULL) { Tcl_AppendResult(interp, "Cannot allocate memory in dilation ", (char*)NULL); return TCL_ERROR; } memcpy((void*)result,(void*)(srcMasterPtr->bytedata), (size_t)(npts*sizeof(unsigned char))); if( !lseparable_dilation_3D(result,nr,nc,1, x,y,0) ) { Tcl_AppendResult(interp, "ldilation_3D failed", (char*)NULL); ckfree((void*)result); return TCL_ERROR; } block.width = nc; block.height = nr; block.pitch = nc; block.pixelSize = sizeof(unsigned char); block.datatype = BYTE; block.copy = NO_COPY; block.skip = 0; block.pixel_x = srcMasterPtr->pixel_x; block.pixel_y = srcMasterPtr->pixel_y; block.pixelPtr = (unsigned char*)result; /* set image size */ Tk_PictExpand(masterPtr,nc,nr); Tk_PictPutBlock(masterPtr,&block,0,0,nc,nr); return TCL_OK; } /* end ImgPictDilation*/ static int ImgPictCloseHoles(Tcl_Interp *interp, PictMaster *masterPtr, int argc, char **argv) { Tk_PictHandle srcHandle; PictMaster *srcMasterPtr; Tk_PictImageBlock block; unsigned char *temp_img; unsigned char *marker; int nr,nc; int npts; if(argc != 3) { Tcl_AppendResult(interp,"wrong # of arguments, should be ", argv[0], " close_holes ", (char *) NULL); return TCL_ERROR; } if ((srcHandle = Tk_FindPict(argv[2])) == NULL) { Tcl_AppendResult(interp, "image \"", argv[2], "\" doesn't", " exist or is not a Pict image", (char *) NULL); return TCL_ERROR; } srcMasterPtr = (PictMaster *)srcHandle; if( srcMasterPtr->data == NULL ) { Tcl_AppendResult(interp, "image \"", argv[2], "\" doesn't", " contain any data", (char *) NULL); return TCL_ERROR; } /* allocate memory */ nr = srcMasterPtr->height; nc = srcMasterPtr->width; npts = nr*nc; /* allocate memory for marker */ marker = (unsigned char*)ckalloc(npts*sizeof(unsigned char)); if ( marker == NULL) { Tcl_AppendResult(interp, "Cannot allocate memory in close_holes ", (char*)NULL); return TCL_ERROR; } temp_img = (unsigned char *)(srcMasterPtr->bytedata); if( !lclose_holes_3D(temp_img,marker,255,nr,nc,1,0) ) { Tcl_AppendResult(interp, "lclose_holes_3D failed", (char*)NULL); ckfree((void*)marker); return TCL_ERROR; } block.width = nc; block.height = nr; block.pitch = nc; block.pixelSize = sizeof(unsigned char); block.datatype = BYTE; block.copy = NO_COPY; block.skip = 0; block.pixel_x = srcMasterPtr->pixel_x; block.pixel_y = srcMasterPtr->pixel_y; block.pixelPtr = (unsigned char*)marker; /* set image size */ Tk_PictExpand(masterPtr,nc,nr); Tk_PictPutBlock(masterPtr,&block,0,0,nc,nr); return TCL_OK; } /* end ImgPictCloseHoles */ static int ImgPictGetHoles(Tcl_Interp *interp, PictMaster *masterPtr, int argc, char **argv) { Tk_PictHandle srcHandle; PictMaster *srcMasterPtr; Tk_PictImageBlock block; unsigned char *temp_img; unsigned char *marker; int nr,nc; int npts; int i; if(argc != 3) { Tcl_AppendResult(interp,"wrong # of arguments, should be ", argv[0], " get_holes ", (char *) NULL); return TCL_ERROR; } if ((srcHandle = Tk_FindPict(argv[2])) == NULL) { Tcl_AppendResult(interp, "image \"", argv[2], "\" doesn't", " exist or is not a Pict image", (char *) NULL); return TCL_ERROR; } srcMasterPtr = (PictMaster *)srcHandle; if( srcMasterPtr->data == NULL ) { Tcl_AppendResult(interp, "image \"", argv[2], "\" doesn't", " contain any data", (char *) NULL); return TCL_ERROR; } /* allocate memory */ nr = srcMasterPtr->height; nc = srcMasterPtr->width; npts = nr*nc; /* allocate memory for marker */ marker = (unsigned char*)ckalloc(npts*sizeof(unsigned char)); if ( marker == NULL) { Tcl_AppendResult(interp, "Cannot allocate memory in close_holes ", (char*)NULL); return TCL_ERROR; } temp_img = (unsigned char*)(srcMasterPtr->bytedata); if( !lclose_holes_3D(temp_img,marker,255,nr,nc,1,0) ) { Tcl_AppendResult(interp, "lclose_holes_3D failed", (char*)NULL); ckfree((void*)marker); return TCL_ERROR; } /* now get the holes by substraction */ for(i=0;ipixel_x; block.pixel_y = srcMasterPtr->pixel_y; block.pixelPtr = (unsigned char*)marker; /* set image size */ Tk_PictExpand(masterPtr,nc,nr); Tk_PictPutBlock(masterPtr,&block,0,0,nc,nr); return TCL_OK; } /* end ImgPictGetHoles */ static int ImgPictDistanceTransform(Tcl_Interp *interp, PictMaster *masterPtr, int argc, char **argv) { Tk_PictHandle srcHandle; PictMaster *srcMasterPtr; Tk_PictImageBlock block; unsigned char *temp_img; short *result; int nr,nc; int npts; int dist; if(argc != 4) { Tcl_AppendResult(interp,"wrong # of arguments, should be ", argv[0], " dt [34|5711]", (char *) NULL); return TCL_ERROR; } if ((srcHandle = Tk_FindPict(argv[2])) == NULL) { Tcl_AppendResult(interp, "image \"", argv[2], "\" doesn't", " exist or is not a Pict image", (char *) NULL); return TCL_ERROR; } srcMasterPtr = (PictMaster *)srcHandle; if( srcMasterPtr->data == NULL ) { Tcl_AppendResult(interp, "image \"", argv[2], "\" doesn't", " contain any data", (char *) NULL); return TCL_ERROR; } if((Tcl_GetInt(interp, argv[3], &dist) != TCL_OK) || (dist != 34 && dist != 5711)) { Tcl_AppendResult(interp," wrong arguments, should be ", argv[0], " dt [34|5711]", (char *) NULL); return TCL_ERROR; } /* allocate memory */ nr = srcMasterPtr->height; nc = srcMasterPtr->width; npts = nr*nc; /* allocate memory for output */ result = (short*)ckalloc(npts*sizeof(short)); if ( result == NULL) { Tcl_AppendResult(interp, "Cannot allocate memory in DistanceTransform", (char*)NULL); return TCL_ERROR; } temp_img = (unsigned char*)(srcMasterPtr->bytedata); if( !ldt_2D(temp_img, result,nr,nc, 1, /* one slice */ dist, /* type of distance */ 1)) { /* force normalization */ Tcl_AppendResult(interp, "ldt_2D failed", (char*)NULL); ckfree((void*)result); return TCL_ERROR; } block.width = nc; block.height = nr; block.pitch = nc; block.pixelSize = sizeof(short); block.datatype = WORD; block.copy = NO_COPY; block.skip = 0; block.pixel_x = srcMasterPtr->pixel_x; block.pixel_y = srcMasterPtr->pixel_y; block.pixelPtr = (unsigned char*)result; /* set image size */ Tk_PictExpand(masterPtr,nc,nr); Tk_PictPutBlock(masterPtr,&block,0,0,nc,nr); return TCL_OK; } /* end ImgPictDistanceTransform*/ static int ImgPictLabel(Tcl_Interp *interp, PictMaster *masterPtr, int argc, char **argv) { Tk_PictHandle srcHandle; PictMaster *srcMasterPtr; Tk_PictImageBlock block; unsigned char *temp_img; short *result; int nr,nc; int npts; char *arg; int argstart; int parsed1; int hival = 1; int loval = 1; int has_lo = 0; int su = 0; int ma =0 ; int stretch = 0; int minlab = 1; int verbose = 0; if(argc < 3) { Tcl_AppendResult(interp,"wrong # of arguments, should be ", argv[0], " label [-hival -loval -su -ma -minlab -v]", (char *) NULL); return TCL_ERROR; } if ((srcHandle = Tk_FindPict(argv[2])) == NULL) { Tcl_AppendResult(interp, "image \"", argv[2], "\" doesn't", " exist or is not a Pict image", (char *) NULL); return TCL_ERROR; } srcMasterPtr = (PictMaster *)srcHandle; if( srcMasterPtr->data == NULL ) { Tcl_AppendResult(interp, "image \"", argv[2], "\" doesn't", " contain any data", (char *) NULL); return TCL_ERROR; } argstart = 3; while ( (argstart 255 || loval > 255 || minlab > 255) { Tcl_AppendResult(interp," hival, loval and minlab values should be lower than 255",(char*)NULL); return TCL_ERROR; } if( minlab > 1 ) stretch = 1; /* allocate memory */ nr = srcMasterPtr->height; nc = srcMasterPtr->width; npts = nr*nc; /* allocate memory for input */ temp_img = (unsigned char*)ckalloc(npts*sizeof(unsigned char)); if ( temp_img == NULL) { Tcl_AppendResult(interp, "Cannot allocate memory in label", (char*)NULL); return TCL_ERROR; } memcpy((void*)temp_img,(void*)(srcMasterPtr->bytedata),npts); /* allocate memory for output */ result = (short*)ckalloc(npts*sizeof(short)); if ( result == NULL) { Tcl_AppendResult(interp, "Cannot allocate memory in label", (char*)NULL); ckfree((void*)temp_img); return TCL_ERROR; } if( lflabel_2D_short(temp_img, result, nr,nc, su, ma, (unsigned char)hival, (unsigned char)loval, (unsigned char)stretch, (unsigned char)minlab, (char)verbose) < 0) { Tcl_AppendResult(interp, "lflabel_2D_short failed", (char*)NULL); ckfree((void*)result); ckfree((void*)temp_img); return TCL_ERROR; } block.width = nc; block.height = nr; block.pitch = nc; block.pixelSize = sizeof(short); block.datatype = WORD; block.copy = NO_COPY; block.skip = 0; block.pixel_x = srcMasterPtr->pixel_x; block.pixel_y = srcMasterPtr->pixel_y; block.pixelPtr = (unsigned char*)result; /* set image size */ Tk_PictExpand(masterPtr,nc,nr); Tk_PictPutBlock(masterPtr,&block,0,0,nc,nr); /* free memory */ ckfree((void*)temp_img); return TCL_OK; } /* end ImgPictLabel */ #endif /* *---------------------------------------------------------------------- * * Tk_PictPutScaledBlock -- * * This procedure is called to put image data into a Pict image, * with possible zooming of the pixels. * * Results: * None. * * Side effects: * The image data is stored. The image may be expanded. * The Tk image code is informed that the image has changed. * *---------------------------------------------------------------------- */ void Tk_PictPutScaledBlock(handle, blockPtr, x, y, width, height, zoomX, zoomY, Xoff, Yoff) Tk_PictHandle handle; /* Opaque handle for the Pict image * to be updated. */ register Tk_PictImageBlock *blockPtr; /* Pointer to a structure describing the * pixel data to be copied into the image. */ int x, y; /* Coordinates of the top-left pixel to * be updated in the image. */ int width, height; /* Dimensions of the area of the image * to be updated. */ double zoomX, zoomY; /* Zoom factors for the X and Y axes. */ double Xoff, Yoff; /* Offset into initial pixel data */ { register PictMaster *masterPtr; PictInstance *instancePtr; int xEnd, yEnd; int wCopy, hCopy; unsigned char *srcPtr, *srcLinePtr; unsigned char *destPtr, *destLinePtr; int pitch; double xRepeat, yRepeat; int blockXSkip, blockYSkip; XRectangle rect; register int il; #ifdef DEBUG printf("PowPictPutZoomedBlock\n"); #endif if ((zoomX == 1.01) && (zoomY == 1.0)) { Tk_PictPutBlock(handle, blockPtr, x, y, width, height); return; } masterPtr = (PictMaster *) handle; if ((zoomX <= 0.0) || (zoomY <= 0.0)) return; if ((masterPtr->userWidth != 0) && ((x + width) > masterPtr->userWidth)) { width = masterPtr->userWidth - x; } if ((masterPtr->userHeight != 0) && ((y + height) > masterPtr->userHeight)) { height = masterPtr->userHeight - y; } if ((width <= 0) || (height <= 0)) return; xEnd = x + width; yEnd = y + height; if ((xEnd > masterPtr->width) || (yEnd > masterPtr->height)) { ImgPictSetSize(masterPtr, MAX(xEnd, masterPtr->width), MAX(yEnd, masterPtr->height)); } if( masterPtr->data == NULL ) { #ifdef DEBUG printf("needs allocation \n"); #endif masterPtr->datatype = blockPtr->datatype; masterPtr->datasize = blockPtr->pixelSize; masterPtr->pixel_x = blockPtr->pixel_x; masterPtr->pixel_y = blockPtr->pixel_y; masterPtr->data = (char*)ckalloc((size_t)masterPtr->datasize* masterPtr->width* masterPtr->height); if( masterPtr->data == NULL ) { (void)fprintf(stderr,"Could not allocate memory \n"); return; } } else { if (masterPtr->datatype != blockPtr->datatype ) { (void)fprintf(stderr,"Type mismatch \n"); return; } if ((masterPtr->pixel_x != blockPtr->pixel_x) || (masterPtr->pixel_y != blockPtr->pixel_y) ) { printf("Warning : the physical dimensions of the block being read will not be saved \n"); } } destLinePtr = (unsigned char*)(masterPtr->data + (y * masterPtr->width + x)*masterPtr->datasize); pitch = masterPtr->width*masterPtr->datasize; srcLinePtr = blockPtr->pixelPtr; blockXSkip = blockPtr->pixelSize; blockYSkip = blockPtr->pitch * blockPtr->pixelSize; yRepeat = Yoff; for (hCopy=height; hCopy > 0; hCopy--) { destPtr = destLinePtr; srcPtr = srcLinePtr; xRepeat = Xoff; for (wCopy=width; wCopy > 0; wCopy--) { for(il=0;ildatasize;il++) *destPtr++ = srcPtr[il]; xRepeat--; while( xRepeat <= 0.0 ) { srcPtr += blockXSkip; xRepeat += zoomX; } } destLinePtr += pitch; yRepeat--; while( yRepeat <= 0.0 ) { srcLinePtr += blockYSkip; yRepeat += zoomY; } } normalize_data(masterPtr); blockPtr->pixelPtr = NULL; /* * Add this new block to the region that specifies which data is valid. */ rect.x = x; rect.y = y; rect.width = width; rect.height = height; XUnionRectWithRegion(&rect, masterPtr->validRegion, masterPtr->validRegion); /* * Update each instance. */ for(instancePtr = masterPtr->instancePtr; instancePtr != NULL; instancePtr = instancePtr->nextPtr) DitherInstance(instancePtr, x, y, width, height); /* * Tell the core image code that this image has changed. */ Tk_ImageChanged(masterPtr->tkMaster, x, y, width, height, masterPtr->width, masterPtr->height); } fv5.5/tcltk/pow/XRange.html0000644000220700000360000000341313224715130014514 0ustar birbylhea The POW X Range Selection

    The POW X Range Selection

    Overview

    POW provides the user with the ability to restrict the analysis to only those photons that were detected within certain time intervals.

    Creating a Range

    When the range dialog box is open, a new range can be created by placing the mouse at the desired location in the graph and click-and-drag with the left mouse button down.

    Current Range and Manipulation

    The current range is the one highlighted in the dialog's list of ranges and "tagged" on the plot. Upon selection (clicking the left mouse button on a range in the list or on the graph itself) or creation, the definition of the current range is placed in the current range portion of the dialog box. A range consists of 2 parts: beginning and ending value on the X axis.

    To move a range, simply click the left mouse button on tope of the range and drag it to the new location.

    The Delete button in the Range dialog deletes the current range and the next range in the list (or previous range if deleting the last range) becomes the current range. All the ranges can be deleted with the Clear All button.

    To Split a range into 2 pieces by holding down the 'shift' key while dragging the left mouse across the middle of the colored horizontal bar for that time range.

    To see finer details, zoom in on the plot by dragging out the area of interest with the right mouse button.

    'Double click' the right mouse button to unzoom and see the entire area of the plot.

    Saving/Opening Range Files

    At the bottom of the Region dialog are a pair of Open and Save buttons which will read and write range files. fv5.5/tcltk/pow/configure0000755000220700000360000024154613224715130014364 0ustar birbylhea#! /bin/sh # Guess values for system-dependent variables and create Makefiles. # Generated automatically using autoconf version 2.13 # Copyright (C) 1992, 93, 94, 95, 96 Free Software Foundation, Inc. # # This configure script is free software; the Free Software Foundation # gives unlimited permission to copy, distribute and modify it. # Defaults: ac_help= ac_default_prefix=/usr/local # Any additions from configure.in: ac_help="$ac_help --with-tcl Path to tcl source " ac_help="$ac_help --with-tk Path to tk source " ac_help="$ac_help --with-x use the X Window System" # Initialize some variables set by options. # The variables have the same names as the options, with # dashes changed to underlines. build=NONE cache_file=./config.cache exec_prefix=NONE host=NONE no_create= nonopt=NONE no_recursion= prefix=NONE program_prefix=NONE program_suffix=NONE program_transform_name=s,x,x, silent= site= srcdir= target=NONE verbose= x_includes=NONE x_libraries=NONE bindir='${exec_prefix}/bin' sbindir='${exec_prefix}/sbin' libexecdir='${exec_prefix}/libexec' datadir='${prefix}/share' sysconfdir='${prefix}/etc' sharedstatedir='${prefix}/com' localstatedir='${prefix}/var' libdir='${exec_prefix}/lib' includedir='${prefix}/include' oldincludedir='/usr/include' infodir='${prefix}/info' mandir='${prefix}/man' # Initialize some other variables. subdirs= MFLAGS= MAKEFLAGS= SHELL=${CONFIG_SHELL-/bin/sh} # Maximum number of lines to put in a shell here document. ac_max_here_lines=12 ac_prev= for ac_option do # If the previous option needs an argument, assign it. if test -n "$ac_prev"; then eval "$ac_prev=\$ac_option" ac_prev= continue fi case "$ac_option" in -*=*) ac_optarg=`echo "$ac_option" | sed 's/[-_a-zA-Z0-9]*=//'` ;; *) ac_optarg= ;; esac # Accept the important Cygnus configure options, so we can diagnose typos. case "$ac_option" in -bindir | --bindir | --bindi | --bind | --bin | --bi) ac_prev=bindir ;; -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*) bindir="$ac_optarg" ;; -build | --build | --buil | --bui | --bu) ac_prev=build ;; -build=* | --build=* | --buil=* | --bui=* | --bu=*) build="$ac_optarg" ;; -cache-file | --cache-file | --cache-fil | --cache-fi \ | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c) ac_prev=cache_file ;; -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \ | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*) cache_file="$ac_optarg" ;; -datadir | --datadir | --datadi | --datad | --data | --dat | --da) ac_prev=datadir ;; -datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \ | --da=*) datadir="$ac_optarg" ;; -disable-* | --disable-*) ac_feature=`echo $ac_option|sed -e 's/-*disable-//'` # Reject names that are not valid shell variable names. if test -n "`echo $ac_feature| sed 's/[-a-zA-Z0-9_]//g'`"; then { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; } fi ac_feature=`echo $ac_feature| sed 's/-/_/g'` eval "enable_${ac_feature}=no" ;; -enable-* | --enable-*) ac_feature=`echo $ac_option|sed -e 's/-*enable-//' -e 's/=.*//'` # Reject names that are not valid shell variable names. if test -n "`echo $ac_feature| sed 's/[-_a-zA-Z0-9]//g'`"; then { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; } fi ac_feature=`echo $ac_feature| sed 's/-/_/g'` case "$ac_option" in *=*) ;; *) ac_optarg=yes ;; esac eval "enable_${ac_feature}='$ac_optarg'" ;; -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \ | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \ | --exec | --exe | --ex) ac_prev=exec_prefix ;; -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \ | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \ | --exec=* | --exe=* | --ex=*) exec_prefix="$ac_optarg" ;; -gas | --gas | --ga | --g) # Obsolete; use --with-gas. with_gas=yes ;; -help | --help | --hel | --he) # Omit some internal or obsolete options to make the list less imposing. # This message is too long to be a string in the A/UX 3.1 sh. cat << EOF Usage: configure [options] [host] Options: [defaults in brackets after descriptions] Configuration: --cache-file=FILE cache test results in FILE --help print this message --no-create do not create output files --quiet, --silent do not print \`checking...' messages --version print the version of autoconf that created configure Directory and file names: --prefix=PREFIX install architecture-independent files in PREFIX [$ac_default_prefix] --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX [same as prefix] --bindir=DIR user executables in DIR [EPREFIX/bin] --sbindir=DIR system admin executables in DIR [EPREFIX/sbin] --libexecdir=DIR program executables in DIR [EPREFIX/libexec] --datadir=DIR read-only architecture-independent data in DIR [PREFIX/share] --sysconfdir=DIR read-only single-machine data in DIR [PREFIX/etc] --sharedstatedir=DIR modifiable architecture-independent data in DIR [PREFIX/com] --localstatedir=DIR modifiable single-machine data in DIR [PREFIX/var] --libdir=DIR object code libraries in DIR [EPREFIX/lib] --includedir=DIR C header files in DIR [PREFIX/include] --oldincludedir=DIR C header files for non-gcc in DIR [/usr/include] --infodir=DIR info documentation in DIR [PREFIX/info] --mandir=DIR man documentation in DIR [PREFIX/man] --srcdir=DIR find the sources in DIR [configure dir or ..] --program-prefix=PREFIX prepend PREFIX to installed program names --program-suffix=SUFFIX append SUFFIX to installed program names --program-transform-name=PROGRAM run sed PROGRAM on installed program names EOF cat << EOF Host type: --build=BUILD configure for building on BUILD [BUILD=HOST] --host=HOST configure for HOST [guessed] --target=TARGET configure for TARGET [TARGET=HOST] Features and packages: --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no) --enable-FEATURE[=ARG] include FEATURE [ARG=yes] --with-PACKAGE[=ARG] use PACKAGE [ARG=yes] --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no) --x-includes=DIR X include files are in DIR --x-libraries=DIR X library files are in DIR EOF if test -n "$ac_help"; then echo "--enable and --with options recognized:$ac_help" fi exit 0 ;; -host | --host | --hos | --ho) ac_prev=host ;; -host=* | --host=* | --hos=* | --ho=*) host="$ac_optarg" ;; -includedir | --includedir | --includedi | --included | --include \ | --includ | --inclu | --incl | --inc) ac_prev=includedir ;; -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \ | --includ=* | --inclu=* | --incl=* | --inc=*) includedir="$ac_optarg" ;; -infodir | --infodir | --infodi | --infod | --info | --inf) ac_prev=infodir ;; -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*) infodir="$ac_optarg" ;; -libdir | --libdir | --libdi | --libd) ac_prev=libdir ;; -libdir=* | --libdir=* | --libdi=* | --libd=*) libdir="$ac_optarg" ;; -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \ | --libexe | --libex | --libe) ac_prev=libexecdir ;; -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \ | --libexe=* | --libex=* | --libe=*) libexecdir="$ac_optarg" ;; -localstatedir | --localstatedir | --localstatedi | --localstated \ | --localstate | --localstat | --localsta | --localst \ | --locals | --local | --loca | --loc | --lo) ac_prev=localstatedir ;; -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \ | --localstate=* | --localstat=* | --localsta=* | --localst=* \ | --locals=* | --local=* | --loca=* | --loc=* | --lo=*) localstatedir="$ac_optarg" ;; -mandir | --mandir | --mandi | --mand | --man | --ma | --m) ac_prev=mandir ;; -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*) mandir="$ac_optarg" ;; -nfp | --nfp | --nf) # Obsolete; use --without-fp. with_fp=no ;; -no-create | --no-create | --no-creat | --no-crea | --no-cre \ | --no-cr | --no-c) no_create=yes ;; -no-recursion | --no-recursion | --no-recursio | --no-recursi \ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) no_recursion=yes ;; -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \ | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \ | --oldin | --oldi | --old | --ol | --o) ac_prev=oldincludedir ;; -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \ | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \ | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*) oldincludedir="$ac_optarg" ;; -prefix | --prefix | --prefi | --pref | --pre | --pr | --p) ac_prev=prefix ;; -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*) prefix="$ac_optarg" ;; -program-prefix | --program-prefix | --program-prefi | --program-pref \ | --program-pre | --program-pr | --program-p) ac_prev=program_prefix ;; -program-prefix=* | --program-prefix=* | --program-prefi=* \ | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*) program_prefix="$ac_optarg" ;; -program-suffix | --program-suffix | --program-suffi | --program-suff \ | --program-suf | --program-su | --program-s) ac_prev=program_suffix ;; -program-suffix=* | --program-suffix=* | --program-suffi=* \ | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*) program_suffix="$ac_optarg" ;; -program-transform-name | --program-transform-name \ | --program-transform-nam | --program-transform-na \ | --program-transform-n | --program-transform- \ | --program-transform | --program-transfor \ | --program-transfo | --program-transf \ | --program-trans | --program-tran \ | --progr-tra | --program-tr | --program-t) ac_prev=program_transform_name ;; -program-transform-name=* | --program-transform-name=* \ | --program-transform-nam=* | --program-transform-na=* \ | --program-transform-n=* | --program-transform-=* \ | --program-transform=* | --program-transfor=* \ | --program-transfo=* | --program-transf=* \ | --program-trans=* | --program-tran=* \ | --progr-tra=* | --program-tr=* | --program-t=*) program_transform_name="$ac_optarg" ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil) silent=yes ;; -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) ac_prev=sbindir ;; -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ | --sbi=* | --sb=*) sbindir="$ac_optarg" ;; -sharedstatedir | --sharedstatedir | --sharedstatedi \ | --sharedstated | --sharedstate | --sharedstat | --sharedsta \ | --sharedst | --shareds | --shared | --share | --shar \ | --sha | --sh) ac_prev=sharedstatedir ;; -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \ | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \ | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \ | --sha=* | --sh=*) sharedstatedir="$ac_optarg" ;; -site | --site | --sit) ac_prev=site ;; -site=* | --site=* | --sit=*) site="$ac_optarg" ;; -srcdir | --srcdir | --srcdi | --srcd | --src | --sr) ac_prev=srcdir ;; -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*) srcdir="$ac_optarg" ;; -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \ | --syscon | --sysco | --sysc | --sys | --sy) ac_prev=sysconfdir ;; -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \ | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*) sysconfdir="$ac_optarg" ;; -target | --target | --targe | --targ | --tar | --ta | --t) ac_prev=target ;; -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*) target="$ac_optarg" ;; -v | -verbose | --verbose | --verbos | --verbo | --verb) verbose=yes ;; -version | --version | --versio | --versi | --vers) echo "configure generated by autoconf version 2.13" exit 0 ;; -with-* | --with-*) ac_package=`echo $ac_option|sed -e 's/-*with-//' -e 's/=.*//'` # Reject names that are not valid shell variable names. if test -n "`echo $ac_package| sed 's/[-_a-zA-Z0-9]//g'`"; then { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; } fi ac_package=`echo $ac_package| sed 's/-/_/g'` case "$ac_option" in *=*) ;; *) ac_optarg=yes ;; esac eval "with_${ac_package}='$ac_optarg'" ;; -without-* | --without-*) ac_package=`echo $ac_option|sed -e 's/-*without-//'` # Reject names that are not valid shell variable names. if test -n "`echo $ac_package| sed 's/[-a-zA-Z0-9_]//g'`"; then { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; } fi ac_package=`echo $ac_package| sed 's/-/_/g'` eval "with_${ac_package}=no" ;; --x) # Obsolete; use --with-x. with_x=yes ;; -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \ | --x-incl | --x-inc | --x-in | --x-i) ac_prev=x_includes ;; -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \ | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*) x_includes="$ac_optarg" ;; -x-libraries | --x-libraries | --x-librarie | --x-librari \ | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l) ac_prev=x_libraries ;; -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \ | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*) x_libraries="$ac_optarg" ;; -*) { echo "configure: error: $ac_option: invalid option; use --help to show usage" 1>&2; exit 1; } ;; *) if test -n "`echo $ac_option| sed 's/[-a-z0-9.]//g'`"; then echo "configure: warning: $ac_option: invalid host type" 1>&2 fi if test "x$nonopt" != xNONE; then { echo "configure: error: can only configure for one host and one target at a time" 1>&2; exit 1; } fi nonopt="$ac_option" ;; esac done if test -n "$ac_prev"; then { echo "configure: error: missing argument to --`echo $ac_prev | sed 's/_/-/g'`" 1>&2; exit 1; } fi trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15 # File descriptor usage: # 0 standard input # 1 file creation # 2 errors and warnings # 3 some systems may open it to /dev/tty # 4 used on the Kubota Titan # 6 checking for... messages and results # 5 compiler messages saved in config.log if test "$silent" = yes; then exec 6>/dev/null else exec 6>&1 fi exec 5>./config.log echo "\ This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. " 1>&5 # Strip out --no-create and --no-recursion so they do not pile up. # Also quote any args containing shell metacharacters. ac_configure_args= for ac_arg do case "$ac_arg" in -no-create | --no-create | --no-creat | --no-crea | --no-cre \ | --no-cr | --no-c) ;; -no-recursion | --no-recursion | --no-recursio | --no-recursi \ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) ;; *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?]*) ac_configure_args="$ac_configure_args '$ac_arg'" ;; *) ac_configure_args="$ac_configure_args $ac_arg" ;; esac done # NLS nuisances. # Only set these to C if already set. These must not be set unconditionally # because not all systems understand e.g. LANG=C (notably SCO). # Fixing LC_MESSAGES prevents Solaris sh from translating var values in `set'! # Non-C LC_CTYPE values break the ctype check. if test "${LANG+set}" = set; then LANG=C; export LANG; fi if test "${LC_ALL+set}" = set; then LC_ALL=C; export LC_ALL; fi if test "${LC_MESSAGES+set}" = set; then LC_MESSAGES=C; export LC_MESSAGES; fi if test "${LC_CTYPE+set}" = set; then LC_CTYPE=C; export LC_CTYPE; fi # confdefs.h avoids OS command line length limits that DEFS can exceed. rm -rf conftest* confdefs.h # AIX cpp loses on an empty file, so make sure it contains at least a newline. echo > confdefs.h # A filename unique to this package, relative to the directory that # configure is in, which we can look for to find out if srcdir is correct. ac_unique_file=Makefile.in # Find the source files, if location was not specified. if test -z "$srcdir"; then ac_srcdir_defaulted=yes # Try the directory containing this script, then its parent. ac_prog=$0 ac_confdir=`echo $ac_prog|sed 's%/[^/][^/]*$%%'` test "x$ac_confdir" = "x$ac_prog" && ac_confdir=. srcdir=$ac_confdir if test ! -r $srcdir/$ac_unique_file; then srcdir=.. fi else ac_srcdir_defaulted=no fi if test ! -r $srcdir/$ac_unique_file; then if test "$ac_srcdir_defaulted" = yes; then { echo "configure: error: can not find sources in $ac_confdir or .." 1>&2; exit 1; } else { echo "configure: error: can not find sources in $srcdir" 1>&2; exit 1; } fi fi srcdir=`echo "${srcdir}" | sed 's%\([^/]\)/*$%\1%'` # Prefer explicitly selected file to automatically selected ones. if test -z "$CONFIG_SITE"; then if test "x$prefix" != xNONE; then CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site" else CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site" fi fi for ac_site_file in $CONFIG_SITE; do if test -r "$ac_site_file"; then echo "loading site script $ac_site_file" . "$ac_site_file" fi done if test -r "$cache_file"; then echo "loading cache $cache_file" . $cache_file else echo "creating cache $cache_file" > $cache_file fi ac_ext=c # CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options. ac_cpp='$CPP $CPPFLAGS' ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5' ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5' cross_compiling=$ac_cv_prog_cc_cross ac_exeext= ac_objext=o if (echo "testing\c"; echo 1,2,3) | grep c >/dev/null; then # Stardent Vistra SVR4 grep lacks -e, says ghazi@caip.rutgers.edu. if (echo -n testing; echo 1,2,3) | sed s/-n/xn/ | grep xn >/dev/null; then ac_n= ac_c=' ' ac_t=' ' else ac_n=-n ac_c= ac_t= fi else ac_n= ac_c='\c' ac_t= fi # From configure.in Revision: 1.22 if test $cache_file = ./config.cache; then cache_file=`pwd`/config.cache fi # Check whether --with-tcl or --without-tcl was given. if test "${with_tcl+set}" = set; then withval="$with_tcl" TCLPATH=$withval fi # Check whether --with-tk or --without-tk was given. if test "${with_tk+set}" = set; then withval="$with_tk" TKPATH=$withval fi #------------------------------------------------------------------------------- # Determine system type #------------------------------------------------------------------------------- BIN_EXT= if test "x$EXT" = x; then EXT=lnx; fi if test "x$BINDIR" = x; then # Extract the first word of "uname", so it can be a program name with args. set dummy uname; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 echo "configure:564: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_UNAME'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else if test -n "$UNAME"; then ac_cv_prog_UNAME="$UNAME" # Let the user override the test. else IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":" ac_dummy="$PATH" for ac_dir in $ac_dummy; do test -z "$ac_dir" && ac_dir=. if test -f $ac_dir/$ac_word; then ac_cv_prog_UNAME="uname" break fi done IFS="$ac_save_ifs" test -z "$ac_cv_prog_UNAME" && ac_cv_prog_UNAME="nouname" fi fi UNAME="$ac_cv_prog_UNAME" if test -n "$UNAME"; then echo "$ac_t""$UNAME" 1>&6 else echo "$ac_t""no" 1>&6 fi if test $UNAME = nouname; then { echo "configure: error: HEAsoft: Unable to guess system type. Please set it using --with-bindir option" 1>&2; exit 1; } fi BINDIR=`$UNAME -s 2> /dev/null`_`$UNAME -r 2> /dev/null | sed 's:[^0-9]*\([0-9][0-9]*\.[0-9]*\).*:\1:'` lhea_machine=`$UNAME -m 2> /dev/null` BIN_EXT= case $BINDIR in CYGWIN*) BINDIR=CYGWIN32_`$UNAME -a 2> /dev/null | awk '{ print $4 }'` lhea_machine= BIN_EXT=".exe" EXT=lnx ;; IRIX*) echo "configure: warning: IRIX support is marginal" 1>&2 EXT=sgi ;; HP-UX*) echo "configure: warning: HP-UX support is marginal" 1>&2 EXT=hpu lhea_machine=`$UNAME -m 2> /dev/null | tr '/' ' ' | awk '{ print $2 }'` ;; Linux*) EXT=lnx ;; OSF1*) EXT=osf ;; SunOS_4*) echo "configure: warning: SunOS 4.x is not supported!" 1>&2 echo "configure: warning: PROCEED AT YOUR OWN RISK!" 1>&2 EXT=sun lhea_machine=sparc ;; SunOS_5*) EXT=sol lhea_machine=`$UNAME -p` ;; Darwin_*) EXT=darwin lhea_machine=`$UNAME -p` ;; *) { echo "configure: error: Unable to recognize your system. Please make sure this platform is supported." 1>&2; exit 1; } ;; esac if test x$lhea_machine != x; then BINDIR=$BINDIR"_"$lhea_machine fi fi #------------------------------------------------------------------------------- # Checks for programs. #------------------------------------------------------------------------------- # Try first to find a proprietary C compiler, then gcc if test "x$CC" = x; then for ac_prog in cc do # Extract the first word of "$ac_prog", so it can be a program name with args. set dummy $ac_prog; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 echo "configure:657: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":" ac_dummy="$PATH" for ac_dir in $ac_dummy; do test -z "$ac_dir" && ac_dir=. if test -f $ac_dir/$ac_word; then ac_cv_prog_CC="$ac_prog" break fi done IFS="$ac_save_ifs" fi fi CC="$ac_cv_prog_CC" if test -n "$CC"; then echo "$ac_t""$CC" 1>&6 else echo "$ac_t""no" 1>&6 fi test -n "$CC" && break done fi # Set up flags to use the selected compiler # # Extract the first word of "gcc", so it can be a program name with args. set dummy gcc; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 echo "configure:692: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":" ac_dummy="$PATH" for ac_dir in $ac_dummy; do test -z "$ac_dir" && ac_dir=. if test -f $ac_dir/$ac_word; then ac_cv_prog_CC="gcc" break fi done IFS="$ac_save_ifs" fi fi CC="$ac_cv_prog_CC" if test -n "$CC"; then echo "$ac_t""$CC" 1>&6 else echo "$ac_t""no" 1>&6 fi if test -z "$CC"; then # Extract the first word of "cc", so it can be a program name with args. set dummy cc; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 echo "configure:722: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":" ac_prog_rejected=no ac_dummy="$PATH" for ac_dir in $ac_dummy; do test -z "$ac_dir" && ac_dir=. if test -f $ac_dir/$ac_word; then if test "$ac_dir/$ac_word" = "/usr/ucb/cc"; then ac_prog_rejected=yes continue fi ac_cv_prog_CC="cc" break fi done IFS="$ac_save_ifs" if test $ac_prog_rejected = yes; then # We found a bogon in the path, so make sure we never use it. set dummy $ac_cv_prog_CC shift if test $# -gt 0; then # We chose a different compiler from the bogus one. # However, it has the same basename, so the bogon will be chosen # first if we set CC to just the basename; use the full file name. shift set dummy "$ac_dir/$ac_word" "$@" shift ac_cv_prog_CC="$@" fi fi fi fi CC="$ac_cv_prog_CC" if test -n "$CC"; then echo "$ac_t""$CC" 1>&6 else echo "$ac_t""no" 1>&6 fi if test -z "$CC"; then case "`uname -s`" in *win32* | *WIN32*) # Extract the first word of "cl", so it can be a program name with args. set dummy cl; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 echo "configure:773: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":" ac_dummy="$PATH" for ac_dir in $ac_dummy; do test -z "$ac_dir" && ac_dir=. if test -f $ac_dir/$ac_word; then ac_cv_prog_CC="cl" break fi done IFS="$ac_save_ifs" fi fi CC="$ac_cv_prog_CC" if test -n "$CC"; then echo "$ac_t""$CC" 1>&6 else echo "$ac_t""no" 1>&6 fi ;; esac fi test -z "$CC" && { echo "configure: error: no acceptable cc found in \$PATH" 1>&2; exit 1; } fi echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works""... $ac_c" 1>&6 echo "configure:805: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5 ac_ext=c # CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options. ac_cpp='$CPP $CPPFLAGS' ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5' ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5' cross_compiling=$ac_cv_prog_cc_cross cat > conftest.$ac_ext << EOF #line 816 "configure" #include "confdefs.h" main(){return(0);} EOF if { (eval echo configure:821: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then ac_cv_prog_cc_works=yes # If we can't run a trivial program, we are probably using a cross compiler. if (./conftest; exit) 2>/dev/null; then ac_cv_prog_cc_cross=no else ac_cv_prog_cc_cross=yes fi else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 ac_cv_prog_cc_works=no fi rm -fr conftest* ac_ext=c # CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options. ac_cpp='$CPP $CPPFLAGS' ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5' ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5' cross_compiling=$ac_cv_prog_cc_cross echo "$ac_t""$ac_cv_prog_cc_works" 1>&6 if test $ac_cv_prog_cc_works = no; then { echo "configure: error: installation or configuration problem: C compiler cannot create executables." 1>&2; exit 1; } fi echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler""... $ac_c" 1>&6 echo "configure:847: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5 echo "$ac_t""$ac_cv_prog_cc_cross" 1>&6 cross_compiling=$ac_cv_prog_cc_cross echo $ac_n "checking whether we are using GNU C""... $ac_c" 1>&6 echo "configure:852: checking whether we are using GNU C" >&5 if eval "test \"`echo '$''{'ac_cv_prog_gcc'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.c <&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then ac_cv_prog_gcc=yes else ac_cv_prog_gcc=no fi fi echo "$ac_t""$ac_cv_prog_gcc" 1>&6 if test $ac_cv_prog_gcc = yes; then GCC=yes else GCC= fi ac_test_CFLAGS="${CFLAGS+set}" ac_save_CFLAGS="$CFLAGS" CFLAGS= echo $ac_n "checking whether ${CC-cc} accepts -g""... $ac_c" 1>&6 echo "configure:880: checking whether ${CC-cc} accepts -g" >&5 if eval "test \"`echo '$''{'ac_cv_prog_cc_g'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else echo 'void f(){}' > conftest.c if test -z "`${CC-cc} -g -c conftest.c 2>&1`"; then ac_cv_prog_cc_g=yes else ac_cv_prog_cc_g=no fi rm -f conftest* fi echo "$ac_t""$ac_cv_prog_cc_g" 1>&6 if test "$ac_test_CFLAGS" = set; then CFLAGS="$ac_save_CFLAGS" elif test $ac_cv_prog_cc_g = yes; then if test "$GCC" = yes; then CFLAGS="-g -O2" else CFLAGS="-g" fi else if test "$GCC" = yes; then CFLAGS="-O2" else CFLAGS= fi fi if test "$cross_compiling" = yes; then echo "configure: warning: Cannot run a simple C executable on your system:" 1>&2 echo "configure: warning: There may be something wrong with your compiler" 1>&2 echo "configure: warning: or perhaps you're trying to cross-compile?" 1>&2 echo "configure: warning: Cross-compiling is not supported within HEAsoft." 1>&2 echo "configure: warning: Please make sure your compiler is working." 1>&2 echo "configure: warning: Contact the FTOOLS help desk for further assistance." 1>&2 { echo "configure: error: Cross-compiling is not allowed." 1>&2; exit 1; } fi if test "x$GCC" = x; then GCC=no fi # Extract the first word of "ranlib", so it can be a program name with args. set dummy ranlib; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 echo "configure:927: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_RANLIB'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else if test -n "$RANLIB"; then ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test. else IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":" ac_dummy="$PATH" for ac_dir in $ac_dummy; do test -z "$ac_dir" && ac_dir=. if test -f $ac_dir/$ac_word; then ac_cv_prog_RANLIB="ranlib" break fi done IFS="$ac_save_ifs" test -z "$ac_cv_prog_RANLIB" && ac_cv_prog_RANLIB=":" fi fi RANLIB="$ac_cv_prog_RANLIB" if test -n "$RANLIB"; then echo "$ac_t""$RANLIB" 1>&6 else echo "$ac_t""no" 1>&6 fi if test $EXT = darwin; then RANLIB="$RANLIB -cs" fi # RANLIB on IRIX is flaky if test $EXT = sgi; then RANLIB=: fi #------------------------------------------------------------------------------- # Checks for libraries. #------------------------------------------------------------------------------- # X XLIBS= XLIBPTH= XINCLUDES= # socket and nsl libraries -- only if needed echo $ac_n "checking for gethostbyname""... $ac_c" 1>&6 echo "configure:974: checking for gethostbyname" >&5 if eval "test \"`echo '$''{'ac_cv_func_gethostbyname'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char gethostbyname(); int main() { /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_gethostbyname) || defined (__stub___gethostbyname) choke me #else gethostbyname(); #endif ; return 0; } EOF if { (eval echo configure:1002: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_gethostbyname=yes" else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* eval "ac_cv_func_gethostbyname=no" fi rm -f conftest* fi if eval "test \"`echo '$ac_cv_func_'gethostbyname`\" = yes"; then echo "$ac_t""yes" 1>&6 : else echo "$ac_t""no" 1>&6 echo $ac_n "checking for gethostbyname in -lnsl""... $ac_c" 1>&6 echo "configure:1020: checking for gethostbyname in -lnsl" >&5 ac_lib_var=`echo nsl'_'gethostbyname | sed 'y%./+-%__p_%'` if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else ac_save_LIBS="$LIBS" LIBS="-lnsl $LIBS" cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=no" fi rm -f conftest* LIBS="$ac_save_LIBS" fi if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then echo "$ac_t""yes" 1>&6 ac_tr_lib=HAVE_LIB`echo nsl | sed -e 's/^a-zA-Z0-9_/_/g' \ -e 'y/abcdefghijklmnopqrstuvwxyz/ABCDEFGHIJKLMNOPQRSTUVWXYZ/'` cat >> confdefs.h <&6 fi fi for ac_func in connect accept do echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 echo "configure:1071: checking for $ac_func" >&5 if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char $ac_func(); int main() { /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_$ac_func) || defined (__stub___$ac_func) choke me #else $ac_func(); #endif ; return 0; } EOF if { (eval echo configure:1099: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_$ac_func=yes" else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* eval "ac_cv_func_$ac_func=no" fi rm -f conftest* fi if eval "test \"`echo '$ac_cv_func_'$ac_func`\" = yes"; then echo "$ac_t""yes" 1>&6 ac_tr_func=HAVE_`echo $ac_func | tr 'abcdefghijklmnopqrstuvwxyz' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'` cat >> confdefs.h <&6 echo $ac_n "checking for main in -lsocket""... $ac_c" 1>&6 echo "configure:1121: checking for main in -lsocket" >&5 ac_lib_var=`echo socket'_'main | sed 'y%./+-%__p_%'` if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else ac_save_LIBS="$LIBS" LIBS="-lsocket $XLIBS $LIBS" cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=no" fi rm -f conftest* LIBS="$ac_save_LIBS" fi if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then echo "$ac_t""yes" 1>&6 ac_tr_lib=HAVE_LIB`echo socket | sed -e 's/^a-zA-Z0-9_/_/g' \ -e 'y/abcdefghijklmnopqrstuvwxyz/ABCDEFGHIJKLMNOPQRSTUVWXYZ/'` cat >> confdefs.h <&6 fi fi done echo $ac_n "checking how to run the C preprocessor""... $ac_c" 1>&6 echo "configure:1169: checking how to run the C preprocessor" >&5 # On Suns, sometimes $CPP names a directory. if test -n "$CPP" && test -d "$CPP"; then CPP= fi if test -z "$CPP"; then if eval "test \"`echo '$''{'ac_cv_prog_CPP'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else # This must be in double quotes, not single quotes, because CPP may get # substituted into the Makefile and "${CC-cc}" will confuse make. CPP="${CC-cc} -E" # On the NeXT, cc -E runs the code through the compiler's parser, # not just through cpp. cat > conftest.$ac_ext < Syntax Error EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" { (eval echo configure:1190: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then : else echo "$ac_err" >&5 echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* CPP="${CC-cc} -E -traditional-cpp" cat > conftest.$ac_ext < Syntax Error EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" { (eval echo configure:1207: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then : else echo "$ac_err" >&5 echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* CPP="${CC-cc} -nologo -E" cat > conftest.$ac_ext < Syntax Error EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" { (eval echo configure:1224: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then : else echo "$ac_err" >&5 echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* CPP=/lib/cpp fi rm -f conftest* fi rm -f conftest* fi rm -f conftest* ac_cv_prog_CPP="$CPP" fi CPP="$ac_cv_prog_CPP" else ac_cv_prog_CPP="$CPP" fi echo "$ac_t""$CPP" 1>&6 # If we find X, set shell vars x_includes and x_libraries to the # paths, otherwise set no_x=yes. # Uses ac_ vars as temps to allow command line to override cache and checks. # --without-x overrides everything else, but does not touch the cache. echo $ac_n "checking for X""... $ac_c" 1>&6 echo "configure:1253: checking for X" >&5 # Check whether --with-x or --without-x was given. if test "${with_x+set}" = set; then withval="$with_x" : fi # $have_x is `yes', `no', `disabled', or empty when we do not yet know. if test "x$with_x" = xno; then # The user explicitly disabled X. have_x=disabled else if test "x$x_includes" != xNONE && test "x$x_libraries" != xNONE; then # Both variables are already set. have_x=yes else if eval "test \"`echo '$''{'ac_cv_have_x'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else # One or both of the vars are not set, and there is no cached value. ac_x_includes=NO ac_x_libraries=NO rm -fr conftestdir if mkdir conftestdir; then cd conftestdir # Make sure to not put "make" in the Imakefile rules, since we grep it out. cat > Imakefile <<'EOF' acfindx: @echo 'ac_im_incroot="${INCROOT}"; ac_im_usrlibdir="${USRLIBDIR}"; ac_im_libdir="${LIBDIR}"' EOF if (xmkmf) >/dev/null 2>/dev/null && test -f Makefile; then # GNU make sometimes prints "make[1]: Entering...", which would confuse us. eval `${MAKE-make} acfindx 2>/dev/null | grep -v make` # Open Windows xmkmf reportedly sets LIBDIR instead of USRLIBDIR. for ac_extension in a so sl; do if test ! -f $ac_im_usrlibdir/libX11.$ac_extension && test -f $ac_im_libdir/libX11.$ac_extension; then ac_im_usrlibdir=$ac_im_libdir; break fi done # Screen out bogus values from the imake configuration. They are # bogus both because they are the default anyway, and because # using them would break gcc on systems where it needs fixed includes. case "$ac_im_incroot" in /usr/include) ;; *) test -f "$ac_im_incroot/X11/Xos.h" && ac_x_includes="$ac_im_incroot" ;; esac case "$ac_im_usrlibdir" in /usr/lib | /lib) ;; *) test -d "$ac_im_usrlibdir" && ac_x_libraries="$ac_im_usrlibdir" ;; esac fi cd .. rm -fr conftestdir fi if test "$ac_x_includes" = NO; then # Guess where to find include files, by looking for this one X11 .h file. test -z "$x_direct_test_include" && x_direct_test_include=X11/Intrinsic.h # First, try using that file with no special directory specified. cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" { (eval echo configure:1320: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* # We can compile using X headers with no special include directory. ac_x_includes= else echo "$ac_err" >&5 echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* # Look for the header file in a standard set of common directories. # Check X11 before X11Rn because it is often a symlink to the current release. for ac_dir in \ /usr/X11/include \ /usr/X11R6/include \ /usr/X11R5/include \ /usr/X11R4/include \ \ /usr/include/X11 \ /usr/include/X11R6 \ /usr/include/X11R5 \ /usr/include/X11R4 \ \ /usr/local/X11/include \ /usr/local/X11R6/include \ /usr/local/X11R5/include \ /usr/local/X11R4/include \ \ /usr/local/include/X11 \ /usr/local/include/X11R6 \ /usr/local/include/X11R5 \ /usr/local/include/X11R4 \ \ /usr/X386/include \ /usr/x386/include \ /usr/XFree86/include/X11 \ \ /usr/include \ /usr/local/include \ /usr/unsupported/include \ /usr/athena/include \ /usr/local/x11r5/include \ /usr/lpp/Xamples/include \ \ /usr/openwin/include \ /usr/openwin/share/include \ ; \ do if test -r "$ac_dir/$x_direct_test_include"; then ac_x_includes=$ac_dir break fi done fi rm -f conftest* fi # $ac_x_includes = NO if test "$ac_x_libraries" = NO; then # Check for the libraries. test -z "$x_direct_test_library" && x_direct_test_library=Xt test -z "$x_direct_test_function" && x_direct_test_function=XtMalloc # See if we find them without any special options. # Don't add to $LIBS permanently. ac_save_LIBS="$LIBS" LIBS="-l$x_direct_test_library $LIBS" cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* LIBS="$ac_save_LIBS" # We can link X programs with no special library path. ac_x_libraries= else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* LIBS="$ac_save_LIBS" # First see if replacing the include by lib works. # Check X11 before X11Rn because it is often a symlink to the current release. for ac_dir in `echo "$ac_x_includes" | sed s/include/lib/` \ /usr/X11/lib \ /usr/X11R6/lib \ /usr/X11R5/lib \ /usr/X11R4/lib \ \ /usr/lib/X11 \ /usr/lib/X11R6 \ /usr/lib/X11R5 \ /usr/lib/X11R4 \ \ /usr/local/X11/lib \ /usr/local/X11R6/lib \ /usr/local/X11R5/lib \ /usr/local/X11R4/lib \ \ /usr/local/lib/X11 \ /usr/local/lib/X11R6 \ /usr/local/lib/X11R5 \ /usr/local/lib/X11R4 \ \ /usr/X386/lib \ /usr/x386/lib \ /usr/XFree86/lib/X11 \ \ /usr/lib \ /usr/local/lib \ /usr/unsupported/lib \ /usr/athena/lib \ /usr/local/x11r5/lib \ /usr/lpp/Xamples/lib \ /lib/usr/lib/X11 \ \ /usr/openwin/lib \ /usr/openwin/share/lib \ ; \ do for ac_extension in a so sl; do if test -r $ac_dir/lib${x_direct_test_library}.$ac_extension; then ac_x_libraries=$ac_dir break 2 fi done done fi rm -f conftest* fi # $ac_x_libraries = NO if test "$ac_x_includes" = NO || test "$ac_x_libraries" = NO; then # Didn't find X anywhere. Cache the known absence of X. ac_cv_have_x="have_x=no" else # Record where we found X for the cache. ac_cv_have_x="have_x=yes \ ac_x_includes=$ac_x_includes ac_x_libraries=$ac_x_libraries" fi fi fi eval "$ac_cv_have_x" fi # $with_x != no if test "$have_x" != yes; then echo "$ac_t""$have_x" 1>&6 no_x=yes else # If each of the values was on the command line, it overrides each guess. test "x$x_includes" = xNONE && x_includes=$ac_x_includes test "x$x_libraries" = xNONE && x_libraries=$ac_x_libraries # Update the cache value to reflect the command line values. ac_cv_have_x="have_x=yes \ ac_x_includes=$x_includes ac_x_libraries=$x_libraries" echo "$ac_t""libraries $x_libraries, headers $x_includes" 1>&6 fi if test "x$no_x" != xyes; then USE_X=yes no_x=no if test `echo $x_includes | grep -c /` -ne 0; then XINCLUDES="-I$x_includes" fi if test `echo $x_libraries | grep -c /` -ne 0; then XLIBPTH="-L$x_libraries " fi XLIBS="$XLIBPTH-lX11" if test -f $x_libraries/libXt.a; then XLIBS="$XLIBS -lXt" fi # dnet_stub echo $ac_n "checking for getnodebyname in -ldnet_stub""... $ac_c" 1>&6 echo "configure:1497: checking for getnodebyname in -ldnet_stub" >&5 ac_lib_var=`echo dnet_stub'_'getnodebyname | sed 'y%./+-%__p_%'` if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else ac_save_LIBS="$LIBS" LIBS="-ldnet_stub $LIBS" cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=no" fi rm -f conftest* LIBS="$ac_save_LIBS" fi if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then echo "$ac_t""yes" 1>&6 XLIBS="$XLIBS -ldnet_stub" else echo "$ac_t""no" 1>&6 fi else USE_X=no fi # dl echo $ac_n "checking for dlopen in -ldl""... $ac_c" 1>&6 echo "configure:1546: checking for dlopen in -ldl" >&5 ac_lib_var=`echo dl'_'dlopen | sed 'y%./+-%__p_%'` if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else ac_save_LIBS="$LIBS" LIBS="-ldl $LIBS" cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=no" fi rm -f conftest* LIBS="$ac_save_LIBS" fi if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then echo "$ac_t""yes" 1>&6 ac_tr_lib=HAVE_LIB`echo dl | sed -e 's/[^a-zA-Z0-9_]/_/g' \ -e 'y/abcdefghijklmnopqrstuvwxyz/ABCDEFGHIJKLMNOPQRSTUVWXYZ/'` cat >> confdefs.h <&6 fi if test `echo $LIBS | grep -c '\-ldl'` -eq 0; then echo $ac_n "checking for dlopen in -ldld""... $ac_c" 1>&6 echo "configure:1594: checking for dlopen in -ldld" >&5 ac_lib_var=`echo dld'_'dlopen | sed 'y%./+-%__p_%'` if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else ac_save_LIBS="$LIBS" LIBS="-ldld $LIBS" cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=no" fi rm -f conftest* LIBS="$ac_save_LIBS" fi if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then echo "$ac_t""yes" 1>&6 ac_tr_lib=HAVE_LIB`echo dld | sed -e 's/[^a-zA-Z0-9_]/_/g' \ -e 'y/abcdefghijklmnopqrstuvwxyz/ABCDEFGHIJKLMNOPQRSTUVWXYZ/'` cat >> confdefs.h <&6 fi fi #------------------------------------------------------------------------------- # Checks for header files. #------------------------------------------------------------------------------- echo $ac_n "checking for ANSI C header files""... $ac_c" 1>&6 echo "configure:1646: checking for ANSI C header files" >&5 if eval "test \"`echo '$''{'ac_cv_header_stdc'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < #include #include #include EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" { (eval echo configure:1659: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* ac_cv_header_stdc=yes else echo "$ac_err" >&5 echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* ac_cv_header_stdc=no fi rm -f conftest* if test $ac_cv_header_stdc = yes; then # SunOS 4.x string.h does not declare mem*, contrary to ANSI. cat > conftest.$ac_ext < EOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | egrep "memchr" >/dev/null 2>&1; then : else rm -rf conftest* ac_cv_header_stdc=no fi rm -f conftest* fi if test $ac_cv_header_stdc = yes; then # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI. cat > conftest.$ac_ext < EOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | egrep "free" >/dev/null 2>&1; then : else rm -rf conftest* ac_cv_header_stdc=no fi rm -f conftest* fi if test $ac_cv_header_stdc = yes; then # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi. if test "$cross_compiling" = yes; then : else cat > conftest.$ac_ext < #define ISLOWER(c) ('a' <= (c) && (c) <= 'z') #define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c)) #define XOR(e, f) (((e) && !(f)) || (!(e) && (f))) int main () { int i; for (i = 0; i < 256; i++) if (XOR (islower (i), ISLOWER (i)) || toupper (i) != TOUPPER (i)) exit(2); exit (0); } EOF if { (eval echo configure:1726: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null then : else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -fr conftest* ac_cv_header_stdc=no fi rm -fr conftest* fi fi fi echo "$ac_t""$ac_cv_header_stdc" 1>&6 if test $ac_cv_header_stdc = yes; then cat >> confdefs.h <<\EOF #define STDC_HEADERS 1 EOF fi for ac_hdr in dirent.h fcntl.h limits.h malloc.h string.h sys/time.h unistd.h do ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'` echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6 echo "configure:1754: checking for $ac_hdr" >&5 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" { (eval echo configure:1764: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* eval "ac_cv_header_$ac_safe=yes" else echo "$ac_err" >&5 echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* eval "ac_cv_header_$ac_safe=no" fi rm -f conftest* fi if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then echo "$ac_t""yes" 1>&6 ac_tr_hdr=HAVE_`echo $ac_hdr | sed 'y%abcdefghijklmnopqrstuvwxyz./-%ABCDEFGHIJKLMNOPQRSTUVWXYZ___%'` cat >> confdefs.h <&6 fi done echo $ac_n "checking whether time.h and sys/time.h may both be included""... $ac_c" 1>&6 echo "configure:1791: checking whether time.h and sys/time.h may both be included" >&5 if eval "test \"`echo '$''{'ac_cv_header_time'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < #include #include int main() { struct tm *tp; ; return 0; } EOF if { (eval echo configure:1805: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_header_time=yes else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* ac_cv_header_time=no fi rm -f conftest* fi echo "$ac_t""$ac_cv_header_time" 1>&6 if test $ac_cv_header_time = yes; then cat >> confdefs.h <<\EOF #define TIME_WITH_SYS_TIME 1 EOF fi # The Ultrix 4.2 mips builtin alloca declared by alloca.h only works # for constant arguments. Useless! echo $ac_n "checking for working alloca.h""... $ac_c" 1>&6 echo "configure:1828: checking for working alloca.h" >&5 if eval "test \"`echo '$''{'ac_cv_header_alloca_h'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < int main() { char *p = alloca(2 * sizeof(int)); ; return 0; } EOF if { (eval echo configure:1840: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* ac_cv_header_alloca_h=yes else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* ac_cv_header_alloca_h=no fi rm -f conftest* fi echo "$ac_t""$ac_cv_header_alloca_h" 1>&6 if test $ac_cv_header_alloca_h = yes; then cat >> confdefs.h <<\EOF #define HAVE_ALLOCA_H 1 EOF fi echo $ac_n "checking for alloca""... $ac_c" 1>&6 echo "configure:1861: checking for alloca" >&5 if eval "test \"`echo '$''{'ac_cv_func_alloca_works'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < # define alloca _alloca # else # if HAVE_ALLOCA_H # include # else # ifdef _AIX #pragma alloca # else # ifndef alloca /* predefined by HP cc +Olibcalls */ char *alloca (); # endif # endif # endif # endif #endif int main() { char *p = (char *) alloca(1); ; return 0; } EOF if { (eval echo configure:1894: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* ac_cv_func_alloca_works=yes else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* ac_cv_func_alloca_works=no fi rm -f conftest* fi echo "$ac_t""$ac_cv_func_alloca_works" 1>&6 if test $ac_cv_func_alloca_works = yes; then cat >> confdefs.h <<\EOF #define HAVE_ALLOCA 1 EOF fi if test $ac_cv_func_alloca_works = no; then # The SVR3 libPW and SVR4 libucb both contain incompatible functions # that cause trouble. Some versions do not even contain alloca or # contain a buggy version. If you still want to use their alloca, # use ar to extract alloca.o from them instead of compiling alloca.c. ALLOCA=alloca.${ac_objext} cat >> confdefs.h <<\EOF #define C_ALLOCA 1 EOF echo $ac_n "checking whether alloca needs Cray hooks""... $ac_c" 1>&6 echo "configure:1926: checking whether alloca needs Cray hooks" >&5 if eval "test \"`echo '$''{'ac_cv_os_cray'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <&5 | egrep "webecray" >/dev/null 2>&1; then rm -rf conftest* ac_cv_os_cray=yes else rm -rf conftest* ac_cv_os_cray=no fi rm -f conftest* fi echo "$ac_t""$ac_cv_os_cray" 1>&6 if test $ac_cv_os_cray = yes; then for ac_func in _getb67 GETB67 getb67; do echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 echo "configure:1956: checking for $ac_func" >&5 if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char $ac_func(); int main() { /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_$ac_func) || defined (__stub___$ac_func) choke me #else $ac_func(); #endif ; return 0; } EOF if { (eval echo configure:1984: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_$ac_func=yes" else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* eval "ac_cv_func_$ac_func=no" fi rm -f conftest* fi if eval "test \"`echo '$ac_cv_func_'$ac_func`\" = yes"; then echo "$ac_t""yes" 1>&6 cat >> confdefs.h <&6 fi done fi echo $ac_n "checking stack direction for C alloca""... $ac_c" 1>&6 echo "configure:2011: checking stack direction for C alloca" >&5 if eval "test \"`echo '$''{'ac_cv_c_stack_direction'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else if test "$cross_compiling" = yes; then ac_cv_c_stack_direction=0 else cat > conftest.$ac_ext < addr) ? 1 : -1; } main () { exit (find_stack_direction() < 0); } EOF if { (eval echo configure:2038: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null then ac_cv_c_stack_direction=1 else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -fr conftest* ac_cv_c_stack_direction=-1 fi rm -fr conftest* fi fi echo "$ac_t""$ac_cv_c_stack_direction" 1>&6 cat >> confdefs.h <&6 echo "configure:2064: checking for working const" >&5 if eval "test \"`echo '$''{'ac_cv_c_const'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <j = 5; } { /* ULTRIX-32 V3.1 (Rev 9) vcc rejects this */ const int foo = 10; } ; return 0; } EOF if { (eval echo configure:2118: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_c_const=yes else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* ac_cv_c_const=no fi rm -f conftest* fi echo "$ac_t""$ac_cv_c_const" 1>&6 if test $ac_cv_c_const = no; then cat >> confdefs.h <<\EOF #define const EOF fi echo $ac_n "checking for mode_t""... $ac_c" 1>&6 echo "configure:2139: checking for mode_t" >&5 if eval "test \"`echo '$''{'ac_cv_type_mode_t'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < #if STDC_HEADERS #include #include #endif EOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | egrep "(^|[^a-zA-Z_0-9])mode_t[^a-zA-Z_0-9]" >/dev/null 2>&1; then rm -rf conftest* ac_cv_type_mode_t=yes else rm -rf conftest* ac_cv_type_mode_t=no fi rm -f conftest* fi echo "$ac_t""$ac_cv_type_mode_t" 1>&6 if test $ac_cv_type_mode_t = no; then cat >> confdefs.h <<\EOF #define mode_t int EOF fi echo $ac_n "checking for size_t""... $ac_c" 1>&6 echo "configure:2172: checking for size_t" >&5 if eval "test \"`echo '$''{'ac_cv_type_size_t'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < #if STDC_HEADERS #include #include #endif EOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | egrep "(^|[^a-zA-Z_0-9])size_t[^a-zA-Z_0-9]" >/dev/null 2>&1; then rm -rf conftest* ac_cv_type_size_t=yes else rm -rf conftest* ac_cv_type_size_t=no fi rm -f conftest* fi echo "$ac_t""$ac_cv_type_size_t" 1>&6 if test $ac_cv_type_size_t = no; then cat >> confdefs.h <<\EOF #define size_t unsigned EOF fi echo $ac_n "checking whether struct tm is in sys/time.h or time.h""... $ac_c" 1>&6 echo "configure:2205: checking whether struct tm is in sys/time.h or time.h" >&5 if eval "test \"`echo '$''{'ac_cv_struct_tm'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < #include int main() { struct tm *tp; tp->tm_sec; ; return 0; } EOF if { (eval echo configure:2218: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_struct_tm=time.h else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* ac_cv_struct_tm=sys/time.h fi rm -f conftest* fi echo "$ac_t""$ac_cv_struct_tm" 1>&6 if test $ac_cv_struct_tm = sys/time.h; then cat >> confdefs.h <<\EOF #define TM_IN_SYS_TIME 1 EOF fi #------------------------------------------------------------------------------- # Tweak compiler flags as needed #------------------------------------------------------------------------------- case $EXT in darwin) CFLAGS="$CFLAGS -Dunix" ;; lnx) ;; osf) if test $GCC = yes; then # Remove optimization on DEC systems CFLAGS=`echo $CFLAGS | sed 's:-O[0-9]* *::g'` else # Standard DEC cc behavior is *STILL* K&R -- force ANSI compliance CFLAGS="$CFLAGS -std1 -Dunix" fi ;; sgi) cat >> confdefs.h <<\EOF #define HAVE_POSIX_SIGNALS 1 EOF ;; sol) cat >> confdefs.h <<\EOF #define HAVE_POSIX_SIGNALS 1 EOF ;; *) ;; esac # Remove optimization on all systems for all older gcc if test $GCC = yes; then if test `$CC -v 2> /dev/null | grep -c 'version 2\.45678'` -ne 0; then CFLAGS=`echo $CFLAGS | sed 's:-O0-9* *::g'` fi fi #------------------------------------------------------------------------------- # Shared library section #------------------------------------------------------------------------------- LD_FLAGS= SHLIB_SUFFIX=".so" SHLIB_LD_LIBS="" if test $EXT = darwin; then SHLIB_SUFFIX=".dylib" fi lhea_shlib_cflags= lhea_shlib_cxxflags= lhea_shlib_fflags= case $EXT in darwin) SHLIB_LD="cc -dynamiclib" SHLIB_SUFFIX=".dylib" lhea_shlib_cflags='-fPIC -fno-common' lhea_shlib_fflags='-fPIC -fno-common' ;; hpu) SHLIB_LD="ld -b" SHLIB_LD_LIBS='${LIBS}' SHLIB_SUFFIX=".sl" ;; lnx) SHLIB_LD=":" ;; osf) SHLIB_LD="ld -shared -expect_unresolved '*'" ;; sol) SHLIB_LD="/usr/ccs/bin/ld -G" SHLIB_LD_LIBS='${LIBS}' lhea_shlib_cflags="-KPIC" lhea_shlib_cxxflags="-KPIC" lhea_shlib_fflags="-KPIC" ;; sgi) SHLIB_LD="ld -shared -rdata_shared" ;; *) echo "configure: warning: Unable to determine how to make a shared library" 1>&2 ;; esac # Darwin uses gcc, but uses -dynamiclib flag if test $GCC = yes -a $EXT != darwin; then SHLIB_LD="$CC -shared" lhea_shlib_cflags='-fPIC' fi if test "x$lhea_shlib_cflags" != x; then CFLAGS="$CFLAGS $lhea_shlib_cflags" fi #------------------------------------------------------------------------------- # Checks for library functions. #------------------------------------------------------------------------------- echo $ac_n "checking for 8-bit clean memcmp""... $ac_c" 1>&6 echo "configure:2343: checking for 8-bit clean memcmp" >&5 if eval "test \"`echo '$''{'ac_cv_func_memcmp_clean'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else if test "$cross_compiling" = yes; then ac_cv_func_memcmp_clean=no else cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null then ac_cv_func_memcmp_clean=yes else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -fr conftest* ac_cv_func_memcmp_clean=no fi rm -fr conftest* fi fi echo "$ac_t""$ac_cv_func_memcmp_clean" 1>&6 test $ac_cv_func_memcmp_clean = no && LIBOBJS="$LIBOBJS memcmp.${ac_objext}" echo $ac_n "checking return type of signal handlers""... $ac_c" 1>&6 echo "configure:2379: checking return type of signal handlers" >&5 if eval "test \"`echo '$''{'ac_cv_type_signal'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < #include #ifdef signal #undef signal #endif #ifdef __cplusplus extern "C" void (*signal (int, void (*)(int)))(int); #else void (*signal ()) (); #endif int main() { int i; ; return 0; } EOF if { (eval echo configure:2401: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_type_signal=void else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* ac_cv_type_signal=int fi rm -f conftest* fi echo "$ac_t""$ac_cv_type_signal" 1>&6 cat >> confdefs.h <&6 echo "configure:2420: checking for strftime" >&5 if eval "test \"`echo '$''{'ac_cv_func_strftime'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char strftime(); int main() { /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_strftime) || defined (__stub___strftime) choke me #else strftime(); #endif ; return 0; } EOF if { (eval echo configure:2448: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_strftime=yes" else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* eval "ac_cv_func_strftime=no" fi rm -f conftest* fi if eval "test \"`echo '$ac_cv_func_'strftime`\" = yes"; then echo "$ac_t""yes" 1>&6 cat >> confdefs.h <<\EOF #define HAVE_STRFTIME 1 EOF else echo "$ac_t""no" 1>&6 # strftime is in -lintl on SCO UNIX. echo $ac_n "checking for strftime in -lintl""... $ac_c" 1>&6 echo "configure:2470: checking for strftime in -lintl" >&5 ac_lib_var=`echo intl'_'strftime | sed 'y%./+-%__p_%'` if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else ac_save_LIBS="$LIBS" LIBS="-lintl $LIBS" cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=no" fi rm -f conftest* LIBS="$ac_save_LIBS" fi if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then echo "$ac_t""yes" 1>&6 cat >> confdefs.h <<\EOF #define HAVE_STRFTIME 1 EOF LIBS="-lintl $LIBS" else echo "$ac_t""no" 1>&6 fi fi for ac_func in getcwd socket strcspn strspn strstr strtod strtol do echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 echo "configure:2518: checking for $ac_func" >&5 if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char $ac_func(); int main() { /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_$ac_func) || defined (__stub___$ac_func) choke me #else $ac_func(); #endif ; return 0; } EOF if { (eval echo configure:2546: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_$ac_func=yes" else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* eval "ac_cv_func_$ac_func=no" fi rm -f conftest* fi if eval "test \"`echo '$ac_cv_func_'$ac_func`\" = yes"; then echo "$ac_t""yes" 1>&6 ac_tr_func=HAVE_`echo $ac_func | tr 'abcdefghijklmnopqrstuvwxyz' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'` cat >> confdefs.h <&6 fi done #------------------------------------------------------------------------------- trap '' 1 2 15 cat > confcache <<\EOF # This file is a shell script that caches the results of configure # tests run on this system so they can be shared between configure # scripts and configure runs. It is not useful on other systems. # If it contains results you don't want to keep, you may remove or edit it. # # By default, configure uses ./config.cache as the cache file, # creating it if it does not exist already. You can give configure # the --cache-file=FILE option to use a different cache file; that is # what configure does when it calls configure scripts in # subdirectories, so they share the cache. # Giving --cache-file=/dev/null disables caching, for debugging configure. # config.status only pays attention to the cache file if you give it the # --recheck option to rerun configure. # EOF # The following way of writing the cache mishandles newlines in values, # but we know of no workaround that is simple, portable, and efficient. # So, don't put newlines in cache variables' values. # Ultrix sh set writes to stderr and can't be redirected directly, # and sets the high bit in the cache file unless we assign to the vars. (set) 2>&1 | case `(ac_space=' '; set | grep ac_space) 2>&1` in *ac_space=\ *) # `set' does not quote correctly, so add quotes (double-quote substitution # turns \\\\ into \\, and sed turns \\ into \). sed -n \ -e "s/'/'\\\\''/g" \ -e "s/^\\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\\)=\\(.*\\)/\\1=\${\\1='\\2'}/p" ;; *) # `set' quotes correctly as required by POSIX, so do not add quotes. sed -n -e 's/^\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\)=\(.*\)/\1=${\1=\2}/p' ;; esac >> confcache if cmp -s $cache_file confcache; then : else if test -w $cache_file; then echo "updating cache $cache_file" cat confcache > $cache_file else echo "not updating unwritable cache $cache_file" fi fi rm -f confcache trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15 test "x$prefix" = xNONE && prefix=$ac_default_prefix # Let make expand exec_prefix. test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' # Any assignment to VPATH causes Sun make to only execute # the first set of double-colon rules, so remove it if not needed. # If there is a colon in the path, we need to keep it. if test "x$srcdir" = x.; then ac_vpsub='/^[ ]*VPATH[ ]*=[^:]*$/d' fi trap 'rm -f $CONFIG_STATUS conftest*; exit 1' 1 2 15 # Transform confdefs.h into DEFS. # Protect against shell expansion while executing Makefile rules. # Protect against Makefile macro expansion. cat > conftest.defs <<\EOF s%#define \([A-Za-z_][A-Za-z0-9_]*\) *\(.*\)%-D\1=\2%g s%[ `~#$^&*(){}\\|;'"<>?]%\\&%g s%\[%\\&%g s%\]%\\&%g s%\$%$$%g EOF DEFS=`sed -f conftest.defs confdefs.h | tr '\012' ' '` rm -f conftest.defs # Without the "./", some shells look in PATH for config.status. : ${CONFIG_STATUS=./config.status} echo creating $CONFIG_STATUS rm -f $CONFIG_STATUS cat > $CONFIG_STATUS </dev/null | sed 1q`: # # $0 $ac_configure_args # # Compiler output produced by configure, useful for debugging # configure, is in ./config.log if it exists. ac_cs_usage="Usage: $CONFIG_STATUS [--recheck] [--version] [--help]" for ac_option do case "\$ac_option" in -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) echo "running \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion" exec \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion ;; -version | --version | --versio | --versi | --vers | --ver | --ve | --v) echo "$CONFIG_STATUS generated by autoconf version 2.13" exit 0 ;; -help | --help | --hel | --he | --h) echo "\$ac_cs_usage"; exit 0 ;; *) echo "\$ac_cs_usage"; exit 1 ;; esac done ac_given_srcdir=$srcdir trap 'rm -fr `echo "Makefile" | sed "s/:[^ ]*//g"` conftest*; exit 1' 1 2 15 EOF cat >> $CONFIG_STATUS < conftest.subs <<\\CEOF $ac_vpsub $extrasub s%@SHELL@%$SHELL%g s%@CFLAGS@%$CFLAGS%g s%@CPPFLAGS@%$CPPFLAGS%g s%@CXXFLAGS@%$CXXFLAGS%g s%@FFLAGS@%$FFLAGS%g s%@DEFS@%$DEFS%g s%@LDFLAGS@%$LDFLAGS%g s%@LIBS@%$LIBS%g s%@exec_prefix@%$exec_prefix%g s%@prefix@%$prefix%g s%@program_transform_name@%$program_transform_name%g s%@bindir@%$bindir%g s%@sbindir@%$sbindir%g s%@libexecdir@%$libexecdir%g s%@datadir@%$datadir%g s%@sysconfdir@%$sysconfdir%g s%@sharedstatedir@%$sharedstatedir%g s%@localstatedir@%$localstatedir%g s%@libdir@%$libdir%g s%@includedir@%$includedir%g s%@oldincludedir@%$oldincludedir%g s%@infodir@%$infodir%g s%@mandir@%$mandir%g s%@UNAME@%$UNAME%g s%@BINDIR@%$BINDIR%g s%@BIN_EXT@%$BIN_EXT%g s%@EXT@%$EXT%g s%@CC@%$CC%g s%@RANLIB@%$RANLIB%g s%@CPP@%$CPP%g s%@USE_X@%$USE_X%g s%@XINCLUDES@%$XINCLUDES%g s%@XLIBPTH@%$XLIBPTH%g s%@XLIBS@%$XLIBS%g s%@ALLOCA@%$ALLOCA%g s%@LD_FLAGS@%$LD_FLAGS%g s%@SHLIB_LD@%$SHLIB_LD%g s%@SHLIB_LD_LIBS@%$SHLIB_LD_LIBS%g s%@SHLIB_SUFFIX@%$SHLIB_SUFFIX%g s%@LIBOBJS@%$LIBOBJS%g s%@TCLPATH@%$TCLPATH%g s%@TKPATH@%$TKPATH%g CEOF EOF cat >> $CONFIG_STATUS <<\EOF # Split the substitutions into bite-sized pieces for seds with # small command number limits, like on Digital OSF/1 and HP-UX. ac_max_sed_cmds=90 # Maximum number of lines to put in a sed script. ac_file=1 # Number of current file. ac_beg=1 # First line for current file. ac_end=$ac_max_sed_cmds # Line after last line for current file. ac_more_lines=: ac_sed_cmds="" while $ac_more_lines; do if test $ac_beg -gt 1; then sed "1,${ac_beg}d; ${ac_end}q" conftest.subs > conftest.s$ac_file else sed "${ac_end}q" conftest.subs > conftest.s$ac_file fi if test ! -s conftest.s$ac_file; then ac_more_lines=false rm -f conftest.s$ac_file else if test -z "$ac_sed_cmds"; then ac_sed_cmds="sed -f conftest.s$ac_file" else ac_sed_cmds="$ac_sed_cmds | sed -f conftest.s$ac_file" fi ac_file=`expr $ac_file + 1` ac_beg=$ac_end ac_end=`expr $ac_end + $ac_max_sed_cmds` fi done if test -z "$ac_sed_cmds"; then ac_sed_cmds=cat fi EOF cat >> $CONFIG_STATUS <> $CONFIG_STATUS <<\EOF for ac_file in .. $CONFIG_FILES; do if test "x$ac_file" != x..; then # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in". case "$ac_file" in *:*) ac_file_in=`echo "$ac_file"|sed 's%[^:]*:%%'` ac_file=`echo "$ac_file"|sed 's%:.*%%'` ;; *) ac_file_in="${ac_file}.in" ;; esac # Adjust a relative srcdir, top_srcdir, and INSTALL for subdirectories. # Remove last slash and all that follows it. Not all systems have dirname. ac_dir=`echo $ac_file|sed 's%/[^/][^/]*$%%'` if test "$ac_dir" != "$ac_file" && test "$ac_dir" != .; then # The file is in a subdirectory. test ! -d "$ac_dir" && mkdir "$ac_dir" ac_dir_suffix="/`echo $ac_dir|sed 's%^\./%%'`" # A "../" for each directory in $ac_dir_suffix. ac_dots=`echo $ac_dir_suffix|sed 's%/[^/]*%../%g'` else ac_dir_suffix= ac_dots= fi case "$ac_given_srcdir" in .) srcdir=. if test -z "$ac_dots"; then top_srcdir=. else top_srcdir=`echo $ac_dots|sed 's%/$%%'`; fi ;; /*) srcdir="$ac_given_srcdir$ac_dir_suffix"; top_srcdir="$ac_given_srcdir" ;; *) # Relative path. srcdir="$ac_dots$ac_given_srcdir$ac_dir_suffix" top_srcdir="$ac_dots$ac_given_srcdir" ;; esac echo creating "$ac_file" rm -f "$ac_file" configure_input="Generated automatically from `echo $ac_file_in|sed 's%.*/%%'` by configure." case "$ac_file" in *Makefile*) ac_comsub="1i\\ # $configure_input" ;; *) ac_comsub= ;; esac ac_file_inputs=`echo $ac_file_in|sed -e "s%^%$ac_given_srcdir/%" -e "s%:% $ac_given_srcdir/%g"` sed -e "$ac_comsub s%@configure_input@%$configure_input%g s%@srcdir@%$srcdir%g s%@top_srcdir@%$top_srcdir%g " $ac_file_inputs | (eval "$ac_sed_cmds") > $ac_file fi; done rm -f conftest.s* EOF cat >> $CONFIG_STATUS <> $CONFIG_STATUS <<\EOF exit 0 EOF chmod +x $CONFIG_STATUS rm -fr confdefs* $ac_clean_files test "$no_create" = yes || ${CONFIG_SHELL-/bin/sh} $CONFIG_STATUS || exit 1 fv5.5/tcltk/pow/configure.in0000644000220700000360000001722213224715130014756 0ustar birbylheadnl Process this file with autoconf to produce a configure script. dnl disable caching to avoid sticky mistakes dnl ---------------------------------------------------------------------------- dnl define([AC_CACHE_LOAD], ) dnl define([AC_CACHE_SAVE], ) dnl ---------------------------------------------------------------------------- AC_INIT(Makefile.in) AC_REVISION($Revision$) AC_PREREQ(2.13) if test $cache_file = ./config.cache; then cache_file=`pwd`/config.cache fi AC_ARG_WITH( tcl, [ --with-tcl Path to tcl source ], TCLPATH=$withval ) AC_ARG_WITH( tk, [ --with-tk Path to tk source ], TKPATH=$withval ) #------------------------------------------------------------------------------- # Determine system type #------------------------------------------------------------------------------- BIN_EXT= if test "x$EXT" = x; then EXT=lnx; fi if test "x$BINDIR" = x; then AC_CHECK_PROG(UNAME, uname, uname, nouname) if test $UNAME = nouname; then AC_MSG_ERROR(HEAsoft: Unable to guess system type. Please set it using --with-bindir option) fi changequote(,) BINDIR=`$UNAME -s 2> /dev/null`_`$UNAME -r 2> /dev/null | sed 's:[^0-9]*\([0-9][0-9]*\.[0-9]*\).*:\1:'` changequote([,]) lhea_machine=`$UNAME -m 2> /dev/null` BIN_EXT= case $BINDIR in CYGWIN*) BINDIR=CYGWIN32_`$UNAME -a 2> /dev/null | awk '{ print $4 }'` lhea_machine= BIN_EXT=".exe" EXT=lnx ;; IRIX*) AC_MSG_WARN(IRIX support is marginal) EXT=sgi ;; HP-UX*) AC_MSG_WARN(HP-UX support is marginal) EXT=hpu lhea_machine=`$UNAME -m 2> /dev/null | tr '/' ' ' | awk '{ print $2 }'` ;; Linux*) EXT=lnx ;; OSF1*) EXT=osf ;; SunOS_4*) AC_MSG_WARN(SunOS 4.x is not supported!) AC_MSG_WARN(PROCEED AT YOUR OWN RISK!) EXT=sun lhea_machine=sparc ;; SunOS_5*) EXT=sol lhea_machine=`$UNAME -p` ;; Darwin_*) EXT=darwin lhea_machine=`$UNAME -p` ;; *) AC_MSG_ERROR(Unable to recognize your system. Please make sure this platform is supported.) ;; esac if test x$lhea_machine != x; then BINDIR=$BINDIR"_"$lhea_machine fi fi AC_SUBST(BINDIR) AC_SUBST(BIN_EXT) AC_SUBST(EXT) #------------------------------------------------------------------------------- # Checks for programs. #------------------------------------------------------------------------------- # Try first to find a proprietary C compiler, then gcc if test "x$CC" = x; then AC_CHECK_PROGS(CC, cc) fi # Set up flags to use the selected compiler # AC_PROG_CC if test "$cross_compiling" = yes; then AC_MSG_WARN(Cannot run a simple C executable on your system:) AC_MSG_WARN(There may be something wrong with your compiler,) AC_MSG_WARN(or perhaps you're trying to cross-compile?) AC_MSG_WARN(Cross-compiling is not supported within HEAsoft.) AC_MSG_WARN(Please make sure your compiler is working.) AC_MSG_WARN(Contact the FTOOLS help desk for further assistance.) AC_MSG_ERROR(Cross-compiling is not allowed.) fi if test "x$GCC" = x; then GCC=no fi AC_PROG_RANLIB if test $EXT = darwin; then RANLIB="$RANLIB -cs" fi # RANLIB on IRIX is flaky if test $EXT = sgi; then RANLIB=: fi #------------------------------------------------------------------------------- # Checks for libraries. #------------------------------------------------------------------------------- # X XLIBS= XLIBPTH= XINCLUDES= # socket and nsl libraries -- only if needed AC_CHECK_FUNC(gethostbyname, , AC_CHECK_LIB(nsl, gethostbyname)) AC_CHECK_FUNCS( connect accept, , AC_CHECK_LIB(socket, main, , , [ $XLIBS ]) ) AC_PATH_X if test "x$no_x" != xyes; then USE_X=yes no_x=no if test `echo $x_includes | grep -c /` -ne 0; then XINCLUDES="-I$x_includes" fi if test `echo $x_libraries | grep -c /` -ne 0; then XLIBPTH="-L$x_libraries " fi XLIBS="$XLIBPTH-lX11" dnl xpa sometimes needs Xt dnl this doesn't work at the moment: dnl AC_CHECK_LIB(Xt, main, XLIBS="$XLIBS -lXt") if test -f $x_libraries/libXt.a; then XLIBS="$XLIBS -lXt" fi # dnet_stub AC_CHECK_LIB(dnet_stub, getnodebyname, XLIBS="$XLIBS -ldnet_stub") else USE_X=no fi AC_SUBST(USE_X) AC_SUBST(XINCLUDES) AC_SUBST(XLIBPTH) AC_SUBST(XLIBS) # dl AC_CHECK_LIB(dl, dlopen) if test `echo $LIBS | grep -c '\-ldl'` -eq 0; then AC_CHECK_LIB(dld, dlopen) fi #------------------------------------------------------------------------------- # Checks for header files. #------------------------------------------------------------------------------- AC_HEADER_STDC AC_CHECK_HEADERS( dirent.h fcntl.h limits.h malloc.h string.h sys/time.h unistd.h ) AC_HEADER_TIME AC_FUNC_ALLOCA #------------------------------------------------------------------------------- # Checks for typedefs, structures, and compiler characteristics. #------------------------------------------------------------------------------- AC_C_CONST AC_TYPE_MODE_T AC_TYPE_SIZE_T AC_STRUCT_TM #------------------------------------------------------------------------------- # Tweak compiler flags as needed #------------------------------------------------------------------------------- case $EXT in darwin) CFLAGS="$CFLAGS -Dunix" ;; lnx) ;; osf) changequote(,) if test $GCC = yes; then # Remove optimization on DEC systems CFLAGS=`echo $CFLAGS | sed 's:-O[0-9]* *::g'` else # Standard DEC cc behavior is *STILL* K&R -- force ANSI compliance CFLAGS="$CFLAGS -std1 -Dunix" fi changequote([,]) ;; sgi) AC_DEFINE(HAVE_POSIX_SIGNALS) ;; sol) AC_DEFINE(HAVE_POSIX_SIGNALS) ;; *) ;; esac # Remove optimization on all systems for all older gcc if test $GCC = yes; then if test `$CC -v 2> /dev/null | grep -c 'version 2\.[45678]'` -ne 0; then CFLAGS=`echo $CFLAGS | sed 's:-O[0-9]* *::g'` fi fi #------------------------------------------------------------------------------- # Shared library section #------------------------------------------------------------------------------- LD_FLAGS= SHLIB_SUFFIX=".so" SHLIB_LD_LIBS="" if test $EXT = darwin; then SHLIB_SUFFIX=".dylib" fi lhea_shlib_cflags= lhea_shlib_cxxflags= lhea_shlib_fflags= dnl if test $lhea_shared = yes; then case $EXT in darwin) SHLIB_LD="cc -dynamiclib" SHLIB_SUFFIX=".dylib" lhea_shlib_cflags='-fPIC -fno-common' lhea_shlib_fflags='-fPIC -fno-common' ;; hpu) SHLIB_LD="ld -b" SHLIB_LD_LIBS='${LIBS}' SHLIB_SUFFIX=".sl" ;; lnx) SHLIB_LD=":" ;; osf) SHLIB_LD="ld -shared -expect_unresolved '*'" ;; sol) SHLIB_LD="/usr/ccs/bin/ld -G" SHLIB_LD_LIBS='${LIBS}' lhea_shlib_cflags="-KPIC" lhea_shlib_cxxflags="-KPIC" lhea_shlib_fflags="-KPIC" ;; sgi) SHLIB_LD="ld -shared -rdata_shared" ;; *) AC_MSG_WARN(Unable to determine how to make a shared library) ;; esac # Darwin uses gcc, but uses -dynamiclib flag if test $GCC = yes -a $EXT != darwin; then SHLIB_LD="$CC -shared" lhea_shlib_cflags='-fPIC' fi if test "x$lhea_shlib_cflags" != x; then CFLAGS="$CFLAGS $lhea_shlib_cflags" fi dnl else dnl SHLIB_LD=: dnl fi AC_SUBST(LD_FLAGS) AC_SUBST(SHLIB_LD) AC_SUBST(SHLIB_LD_LIBS) AC_SUBST(SHLIB_SUFFIX) #------------------------------------------------------------------------------- # Checks for library functions. #------------------------------------------------------------------------------- AC_FUNC_MEMCMP AC_TYPE_SIGNAL AC_FUNC_STRFTIME AC_CHECK_FUNCS(getcwd socket strcspn strspn strstr strtod strtol) #------------------------------------------------------------------------------- AC_SUBST(TCLPATH) AC_SUBST(TKPATH) AC_OUTPUT(Makefile) fv5.5/tcltk/pow/html_library.tcl0000644000220700000360000011764513224715130015653 0ustar birbylhea# Simple HTML display library by Stephen Uhler (stephen.uhler@sun.com) # Copyright (c) 1995 by Sun Microsystems # Version 0.3 Fri Sep 1 10:47:17 PDT 1995 # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # To use this package, create a text widget (say, .text) # and set a variable full of html, (say $html), and issue: # HMinit_win .text # HMparse_html $html "HMrender .text" # You also need to supply the routine: # proc HMlink_callback {win href} { ...} # win: The name of the text widget # href The name of the link # which will be called anytime the user "clicks" on a link. # The supplied version just prints the link to stdout. # In addition, if you wish to use embedded images, you will need to write # proc HMset_image {handle src} # handle an arbitrary handle (not really) # src The name of the image # Which calls # HMgot_image $handle $image # with the TK image. # # To return a "used" text widget to its initialized state, call: # HMreset_win .text # See "sample.tcl" for sample usage ################################################################## ############################################ # mapping of html tags to text tag properties # properties beginning with "T" map directly to text tags # These are Defined in HTML 2.0 array set HMtag_map { b {weight bold} blockquote {style i indent 1 Trindent rindent} bq {style i indent 1 Trindent rindent} cite {style i} code {family courier} dfn {style i} dir {indent 1} dl {indent 1} em {style i} h1 {size 24 weight bold} h2 {size 22} h3 {size 20} h4 {size 18} h5 {size 16} h6 {style i} i {style i} kbd {family courier weight bold} menu {indent 1} ol {indent 1} pre {fill 0 family courier Tnowrap nowrap} samp {family courier} strong {weight bold} tt {family courier} u {Tunderline underline} ul {indent 1} var {style i} } # These are in common(?) use, but not defined in html2.0 array set HMtag_map { center {Tcenter center} strike {Tstrike strike} u {Tunderline underline} } # initial values set HMtag_map(hmstart) { family times weight medium style r size 14 Tcenter "" Tlink "" Tnowrap "" Tunderline "" list list fill 1 indent "" counter 0 adjust 0 } # html tags that insert white space array set HMinsert_map { blockquote "\n\n" /blockquote "\n" br "\n" dd "\n" /dd "\n" dl "\n" /dl "\n" dt "\n" form "\n" /form "\n" h1 "\n\n" /h1 "\n" h2 "\n\n" /h2 "\n" h3 "\n\n" /h3 "\n" h4 "\n" /h4 "\n" h5 "\n" /h5 "\n" h6 "\n" /h6 "\n" li "\n" /dir "\n" /ul "\n" /ol "\n" /menu "\n" p "\n\n" pre "\n" /pre "\n" } # tags that are list elements, that support "compact" rendering array set HMlist_elements { ol 1 ul 1 menu 1 dl 1 dir 1 } ############################################ # initialize the window and stack state proc HMinit_win {win} { upvar #0 HM$win var HMinit_state $win $win tag configure underline -underline 1 $win tag configure center -justify center $win tag configure nowrap -wrap none $win tag configure rindent -rmargin $var(S_tab)c $win tag configure strike -overstrike 1 $win tag configure mark -foreground red ;# list markers $win tag configure list -spacing1 3p -spacing3 3p ;# regular lists $win tag configure compact -spacing1 0p ;# compact lists $win tag configure link -borderwidth 2 -foreground blue ;# hypertext links HMset_indent $win $var(S_tab) $win configure -wrap word # configure the text insertion point $win mark set $var(S_insert) 1.0 # for horizontal rules $win tag configure thin -font [HMx_font times 2 medium r] $win tag configure hr -relief sunken -borderwidth 2 -wrap none \ -tabs [winfo width $win] bind $win { %W tag configure hr -tabs %w %W tag configure last -spacing3 %h } # generic link enter callback $win tag bind link <1> "HMlink_hit $win %x %y" } # set the indent spacing (in cm) for lists # TK uses a "weird" tabbing model that causes \t to insert a single # space if the current line position is past the tab setting proc HMset_indent {win cm} { set tabs [expr $cm / 2.0] $win configure -tabs ${tabs}c foreach i {1 2 3 4 5 6 7 8 9} { set tab [expr $i * $cm] $win tag configure indent$i -lmargin1 ${tab}c -lmargin2 ${tab}c \ -tabs "[expr $tab + $tabs]c [expr $tab + 2*$tabs]c" } } # reset the state of window - get ready for the next page # remove all but the font tags, and remove all form state proc HMreset_win {win} { upvar #0 HM$win var regsub -all { +[^L ][^ ]*} " [$win tag names] " {} tags catch "$win tag delete $tags" eval $win mark unset [$win mark names] $win delete 0.0 end $win tag configure hr -tabs [winfo width $win] # configure the text insertion point $win mark set $var(S_insert) 1.0 # remove form state. If any check/radio buttons still exists, # their variables will be magically re-created, and never get # cleaned up. catch unset [info globals HM$win.form*] HMinit_state $win return HM$win } # initialize the window's state array # Parameters beginning with S_ are NOT reset # adjust_size: global font size adjuster # unknown: character to use for unknown entities # tab: tab stop (in cm) # stop: enabled to stop processing # update: how many tags between update calls # tags: number of tags processed so far # symbols: Symbols to use on un-ordered lists proc HMinit_state {win} { upvar #0 HM$win var array set tmp [array get var S_*] catch {unset var} array set var { stop 0 tags 0 fill 0 list list S_adjust_size 0 S_tab 1.0 S_unknown \xb7 S_update 10 S_symbols O*=+-o\xd7\xb0>:\xb7 S_insert Insert } array set var [array get tmp] } # alter the parameters of the text state # this allows an application to over-ride the default settings # it is called as: HMset_state -param value -param value ... array set HMparam_map { -update S_update -tab S_tab -unknown S_unknown -stop S_stop -size S_adjust_size -symbols S_symbols -insert S_insert } proc HMset_state {win args} { upvar #0 HM$win var global HMparam_map set bad 0 if {[catch {array set params $args}]} {return 0} foreach i [array names params] { incr bad [catch {set var($HMparam_map($i)) $params($i)}] } return [expr $bad == 0] } ############################################ # manage the display of html # HMrender gets called for every html tag # win: The name of the text widget to render into # tag: The html tag (in arbitrary case) # not: a "/" or the empty string # param: The un-interpreted parameter list # text: The plain text until the next html tag proc HMrender {win tag not param text} { upvar #0 HM$win var if {$var(stop)} return global HMtag_map HMinsert_map HMlist_elements set tag [string tolower $tag] set text [HMmap_esc $text] # manage compact rendering of lists if {[info exists HMlist_elements($tag)]} { set list "list [expr {[HMextract_param $param compact] ? "compact" : "list"}]" } else { set list "" } # Allow text to be diverted to a different window (for tables) # this is not currently used if {[info exists var(divert)]} { set win $var(divert) upvar #0 HM$win var } # adjust (push or pop) tag state catch {HMstack $win $not "$HMtag_map($tag) $list"} # insert white space (with current font) # adding white space can get a bit tricky. This isn't quite right set bad [catch {$win insert $var(S_insert) $HMinsert_map($not$tag) "space $var(font)"}] if {!$bad && [lindex $var(fill) end]} { set text [string trimleft $text] } # to fill or not to fill if {[lindex $var(fill) end]} { set text [HMzap_white $text] } # generic mark hook catch {HMmark $not$tag $win $param text} err # do any special tag processing catch {HMtag_$not$tag $win $param text} msg # add the text with proper tags set tags [HMcurrent_tags $win] $win insert $var(S_insert) $text $tags # We need to do an update every so often to insure interactive response. # This can cause us to re-enter the event loop, and cause recursive # invocations of HMrender, so we need to be careful. if {!([incr var(tags)] % $var(S_update))} { update } } # html tags requiring special processing # Procs of the form HMtag_ or HMtag_ get called just before # the text for this tag is displayed. These procs are called inside a # "catch" so it is OK to fail. # win: The name of the text widget to render into # param: The un-interpreted parameter list # text: A pass-by-reference name of the plain text until the next html tag # Tag commands may change this to affect what text will be inserted # next. # A pair of pseudo tags are added automatically as the 1st and last html # tags in the document. The default is and . # Append enough blank space at the end of the text widget while # rendering so HMgoto can place the target near the top of the page, # then remove the extra space when done rendering. proc HMtag_hmstart {win param text} { upvar #0 HM$win var $win mark gravity $var(S_insert) left $win insert end "\n " last $win mark gravity $var(S_insert) right } proc HMtag_/hmstart {win param text} { $win delete last.first end } # put the document title in the window banner, and remove the title text # from the document proc HMtag_title {win param text} { upvar $text data wm title [winfo toplevel $win] $data set data "" } proc HMtag_hr {win param text} { upvar #0 HM$win var $win insert $var(S_insert) "\n" space "\n" thin "\t" "thin hr" "\n" thin } # list element tags proc HMtag_ol {win param text} { upvar #0 HM$win var set var(count$var(level)) 0 } proc HMtag_ul {win param text} { upvar #0 HM$win var catch {unset var(count$var(level))} } proc HMtag_menu {win param text} { upvar #0 HM$win var set var(menu) -> set var(compact) 1 } proc HMtag_/menu {win param text} { upvar #0 HM$win var catch {unset var(menu)} catch {unset var(compact)} } proc HMtag_dt {win param text} { upvar #0 HM$win var upvar $text data set level $var(level) incr level -1 $win insert $var(S_insert) "$data" \ "hi [lindex $var(list) end] indent$level $var(font)" set data {} } proc HMtag_li {win param text} { upvar #0 HM$win var set level $var(level) incr level -1 set x [string index $var(S_symbols)+-+-+-+-" $level] catch {set x [incr var(count$level)]} catch {set x $var(menu)} $win insert $var(S_insert) \t$x\t "mark [lindex $var(list) end] indent$level $var(font)" } # Manage hypertext "anchor" links. A link can be either a source (href) # a destination (name) or both. If its a source, register it via a callback, # and set its default behavior. If its a destination, check to see if we need # to go there now, as a result of a previous HMgoto request. If so, schedule # it to happen with the closing tag, so we can highlight the text up to # the . proc HMtag_a {win param text} { upvar #0 HM$win var # a source if {[HMextract_param $param href]} { set var(Tref) [list L:$href] HMstack $win "" "Tlink link" HMlink_setup $win $href } # a destination if {[HMextract_param $param name]} { set var(Tname) [list N:$name] HMstack $win "" "Tanchor anchor" $win mark set N:$name "$var(S_insert) - 1 chars" $win mark gravity N:$name left if {[info exists var(goto)] && $var(goto) == $name} { unset var(goto) set var(going) $name } } } # The application should call here with the fragment name # to cause the display to go to this spot. # If the target exists, go there (and do the callback), # otherwise schedule the goto to happen when we see the reference. proc HMgoto {win where {callback HMwent_to}} { upvar #0 HM$win var if {[regexp N:$where [$win mark names]]} { $win see N:$where update eval $callback $win [list $where] return 1 } else { set var(goto) $where return 0 } } # We actually got to the spot, so highlight it! # This should/could be replaced by the application # We'll flash it orange a couple of times. proc HMwent_to {win where {count 0} {color orange}} { upvar #0 HM$win var if {$count > 5} return catch {$win tag configure N:$where -foreground $color} update after 200 [list HMwent_to $win $where [incr count] \ [expr {$color=="orange" ? "" : "orange"}]] } proc HMtag_/a {win param text} { upvar #0 HM$win var if {[info exists var(Tref)]} { unset var(Tref) HMstack $win / "Tlink link" } # goto this link, then invoke the call-back. if {[info exists var(going)]} { $win yview N:$var(going) update HMwent_to $win $var(going) unset var(going) } if {[info exists var(Tname)]} { unset var(Tname) HMstack $win / "Tanchor anchor" } } # Inline Images # This interface is subject to change # Most of the work is getting around a limitation of TK that prevents # setting the size of a label to a widthxheight in pixels # # Images have the following parameters: # align: top,middle,bottom # alt: alternate text # ismap: A clickable image map # src: The URL link # Netscape supports (and so do we) # width: A width hint (in pixels) # height: A height hint (in pixels) # border: The size of the window border proc HMtag_img {win param text} { upvar #0 HM$win var # get alignment array set align_map {top top middle center bottom bottom} set align bottom ;# The spec isn't clear what the default should be HMextract_param $param align catch {set align $align_map([string tolower $align])} # get alternate text set alt "" HMextract_param $param alt set alt [HMmap_esc $alt] # get the border width set border 1 HMextract_param $param border # see if we have an image size hint # If so, make a frame the "hint" size to put the label in # otherwise just make the label set item $win.$var(tags) # catch {destroy $item} if {[HMextract_param $param width] && [HMextract_param $param height]} { frame $item -width $width -height $height pack propagate $item 0 set label $item.label label $label pack $label -expand 1 -fill both } else { set label $item label $label } $label configure -relief ridge -fg orange -text $alt catch {$label configure -bd $border} $win window create $var(S_insert) -align $align -window $item -pady 2 -padx 2 # add in all the current tags (this is overkill) set tags [HMcurrent_tags $win] foreach tag $tags { $win tag add $tag $item } # set imagemap callbacks if {[HMextract_param $param ismap]} { # regsub -all {[^L]*L:([^ ]*).*} $tags {\1} link set link [lindex $tags [lsearch -glob $tags L:*]] regsub L: $link {} link global HMevents regsub -all {%} $link {%%} link2 foreach i [array names HMevents] { bind $label <$i> "catch \{%W configure $HMevents($i)\}" } bind $label <1> "+HMlink_callback $win $link2?%x,%y" } # now callback to the application set src "" HMextract_param $param src HMset_image $win $label $src return $label ;# used by the forms package for input_image types } # The app needs to supply one of these proc HMset_image {win handle src} { HMgot_image $handle "can't get\n$src" } # When the image is available, the application should call back here. # If we have the image, put it in the label, otherwise display the error # message. If we don't get a callback, the "alt" text remains. # if we have a clickable image, arrange for a callback proc HMgot_image {win image_error} { # if we're in a frame turn on geometry propogation if {[winfo name $win] == "label"} { pack propagate [winfo parent $win] 1 } if {[catch {$win configure -image $image_error}]} { $win configure -image {} $win configure -text $image_error } } # Sample hypertext link callback routine - should be replaced by app # This proc is called once for each tag. # Applications can overwrite this procedure, as required, or # replace the HMevents array # win: The name of the text widget to render into # href: The HREF link for this tag. array set HMevents { Enter {-borderwidth 2 -relief raised } Leave {-borderwidth 2 -relief flat } 1 {-borderwidth 2 -relief sunken} ButtonRelease-1 {-borderwidth 2 -relief raised} } # We need to escape any %'s in the href tag name so the bind command # doesn't try to substitute them. proc HMlink_setup {win href} { global HMevents regsub -all {%} $href {%%} href2 foreach i [array names HMevents] { eval {$win tag bind L:$href <$i>} \ \{$win tag configure \{L:$href2\} $HMevents($i)\} } } # generic link-hit callback # This gets called upon button hits on hypertext links # Applications are expected to supply ther own HMlink_callback routine # win: The name of the text widget to render into # x,y: The cursor position at the "click" proc HMlink_hit {win x y} { set tags [$win tag names @$x,$y] set link [lindex $tags [lsearch -glob $tags L:*]] # regsub -all {[^L]*L:([^ ]*).*} $tags {\1} link regsub L: $link {} link HMlink_callback $win $link } # replace this! # win: The name of the text widget to render into # href: The HREF link for this tag. if { [info commands HMlink_callback]=="" } { proc HMlink_callback {win href} { puts "Got hit on $win, link $href" } } # extract a value from parameter list (this needs a re-do) # returns "1" if the keyword is found, "0" otherwise # param: A parameter list. It should alredy have been processed to # remove any entity references # key: The parameter name # val: The variable to put the value into (use key as default) proc HMextract_param {param key {val ""}} { if {$val == ""} { upvar $key result } else { upvar $val result } set ws " \n\r" # look for name=value combinations. Either (') or (") are valid delimeters if { [regsub -nocase [format {.*%s[%s]*=[%s]*"([^"]*).*} $key $ws $ws] $param {\1} value] || [regsub -nocase [format {.*%s[%s]*=[%s]*'([^']*).*} $key $ws $ws] $param {\1} value] || [regsub -nocase [format {.*%s[%s]*=[%s]*([^%s]+).*} $key $ws $ws $ws] $param {\1} value] } { set result $value return 1 } # now look for valueless names # I should strip out name=value pairs, so we don't end up with "name" # inside the "value" part of some other key word - some day set bad \[^a-zA-Z\]+ if {[regexp -nocase "$bad$key$bad" -$param-]} { return 1 } else { return 0 } } # These next two routines manage the display state of the page. # Push or pop tags to/from stack. # Each orthogonal text property has its own stack, stored as a list. # The current (most recent) tag is the last item on the list. # Push is {} for pushing and {/} for popping proc HMstack {win push list} { upvar #0 HM$win var array set tags $list if {$push == ""} { foreach tag [array names tags] { lappend var($tag) $tags($tag) } } else { foreach tag [array names tags] { # set cnt [regsub { *[^ ]+$} $var($tag) {} var($tag)] set var($tag) [lreplace $var($tag) end end] } } } # extract set of current text tags # tags starting with T map directly to text tags, all others are # handled specially. There is an application callback, HMset_font # to allow the application to do font error handling proc HMcurrent_tags {win} { upvar #0 HM$win var set font font foreach i {family size weight style} { set $i [lindex $var($i) end] append font :[set $i] } set xfont [HMx_font $family $size $weight $style $var(S_adjust_size)] HMset_font $win $font $xfont set indent [llength $var(indent)] incr indent -1 lappend tags $font indent$indent foreach tag [array names var T*] { lappend tags [lindex $var($tag) end] ;# test } set var(font) $font set var(xfont) [$win tag cget $font -font] set var(level) $indent return $tags } # allow the application to do do better font management # by overriding this procedure proc HMset_font {win tag font} { catch {$win tag configure $tag -font $font} msg } # generate an X font name proc HMx_font {family size weight style {adjust_size 0}} { catch {incr size $adjust_size} return "-*-$family-$weight-$style-normal-*-*-${size}0-*-*-*-*-*-*" } # Optimize HMrender (hee hee) # This is experimental proc HMoptimize {} { regsub -all "\n\[ \]*#\[^\n\]*" [info body HMrender] {} body regsub -all ";\[ \]*#\[^\n]*" $body {} body regsub -all "\n\n+" $body \n body proc HMrender {win tag not param text} $body } ############################################ # Turn HTML into TCL commands # html A string containing an html document # cmd A command to run for each html tag found # start The name of the dummy html start/stop tags proc HMparse_html {html {cmd HMtest_parse} {start hmstart}} { regsub -all \{ $html {\&ob;} html regsub -all \} $html {\&cb;} html set w " \t\r\n" ;# white space proc HMcl x {return "\[$x\]"} set exp <(/?)([HMcl ^$w>]+)[HMcl $w]*([HMcl ^>]*)> set sub "\}\n$cmd {\\2} {\\1} {\\3} \{" regsub -all $exp $html $sub html eval "$cmd {$start} {} {} \{ $html \}" eval "$cmd {$start} / {} {}" } proc HMtest_parse {command tag slash text_after_tag} { puts "==> $command $tag $slash $text_after_tag" } # Convert multiple white space into a single space proc HMzap_white {data} { regsub -all "\[ \t\r\n\]+" $data " " data return $data } # find HTML escape characters of the form &xxx; proc HMmap_esc {text} { if {![regexp & $text]} {return $text} regsub -all {([][$\\])} $text {\\\1} new regsub -all {&#([0-9][0-9]?[0-9]?);?} \ $new {[format %c [scan \1 %d tmp;set tmp]]} new regsub -all {&([a-zA-Z]+);?} $new {[HMdo_map \1]} new return [subst $new] } # convert an HTML escape sequence into character proc HMdo_map {text {unknown ?}} { global HMesc_map set result $unknown catch {set result $HMesc_map($text)} return $result } # table of escape characters (ISO latin-1 esc's are in a different table) array set HMesc_map { lt < gt > amp & quot \" copy \xa9 reg \xae ob \x7b cb \x7d nbsp \xa0 } ############################################################# # ISO Latin-1 escape codes array set HMesc_map { nbsp \xa0 iexcl \xa1 cent \xa2 pound \xa3 curren \xa4 yen \xa5 brvbar \xa6 sect \xa7 uml \xa8 copy \xa9 ordf \xaa laquo \xab not \xac shy \xad reg \xae hibar \xaf deg \xb0 plusmn \xb1 sup2 \xb2 sup3 \xb3 acute \xb4 micro \xb5 para \xb6 middot \xb7 cedil \xb8 sup1 \xb9 ordm \xba raquo \xbb frac14 \xbc frac12 \xbd frac34 \xbe iquest \xbf Agrave \xc0 Aacute \xc1 Acirc \xc2 Atilde \xc3 Auml \xc4 Aring \xc5 AElig \xc6 Ccedil \xc7 Egrave \xc8 Eacute \xc9 Ecirc \xca Euml \xcb Igrave \xcc Iacute \xcd Icirc \xce Iuml \xcf ETH \xd0 Ntilde \xd1 Ograve \xd2 Oacute \xd3 Ocirc \xd4 Otilde \xd5 Ouml \xd6 times \xd7 Oslash \xd8 Ugrave \xd9 Uacute \xda Ucirc \xdb Uuml \xdc Yacute \xdd THORN \xde szlig \xdf agrave \xe0 aacute \xe1 acirc \xe2 atilde \xe3 auml \xe4 aring \xe5 aelig \xe6 ccedil \xe7 egrave \xe8 eacute \xe9 ecirc \xea euml \xeb igrave \xec iacute \xed icirc \xee iuml \xef eth \xf0 ntilde \xf1 ograve \xf2 oacute \xf3 ocirc \xf4 otilde \xf5 ouml \xf6 divide \xf7 oslash \xf8 ugrave \xf9 uacute \xfa ucirc \xfb uuml \xfc yacute \xfd thorn \xfe yuml \xff } ########################################################## # html forms management commands # As each form element is located, it is created and rendered. Additional # state is stored in a form specific global variable to be processed at # the end of the form, including the "reset" and "submit" options. # Remember, there can be multiple forms existing on multiple pages. When # HTML tables are added, a single form could be spread out over multiple # text widgets, which makes it impractical to hang the form state off the # HM$win structure. We don't need to check for the existance of required # parameters, we just "fail" and get caught in HMrender # This causes line breaks to be preserved in the inital values # of text areas array set HMtag_map { textarea {fill 0} } ########################################################## # html isindex tag. Although not strictly forms, they're close enough # to be in this file # is-index forms # make a frame with a label, entry, and submit button proc HMtag_isindex {win param text} { upvar #0 HM$win var set item $win.$var(tags) if {[winfo exists $item]} { destroy $item } frame $item -relief ridge -bd 3 set prompt "Enter search keywords here" HMextract_param $param prompt label $item.label -text [HMmap_esc $prompt] -font $var(xfont) entry $item.entry bind $item.entry "$item.submit invoke" button $item.submit -text search -font $var(xfont) -command \ [format {HMsubmit_index %s {%s} [HMmap_reply [%s get]]} \ $win $param $item.entry] pack $item.label -side top pack $item.entry $item.submit -side left # insert window into text widget $win insert $var(S_insert) \n isindex HMwin_install $win $item $win insert $var(S_insert) \n isindex bind $item {focus %W.entry} } # This is called when the isindex form is submitted. # The default version calls HMlink_callback. Isindex tags should either # be deprecated, or fully supported (e.g. they need an href parameter) proc HMsubmit_index {win param text} { HMlink_callback $win ?$text } # initialize form state. All of the state for this form is kept # in a global array whose name is stored in the form_id field of # the main window array. # Parameters: ACTION, METHOD, ENCTYPE proc HMtag_form {win param text} { upvar #0 HM$win var # create a global array for the form set id HM$win.form$var(tags) upvar #0 $id form # missing /form tag, simulate it if {[info exists var(form_id)]} { puts "Missing end-form tag !!!! $var(form_id)" HMtag_/form $win {} {} } catch {unset form} set var(form_id) $id set form(param) $param ;# form initial parameter list set form(reset) "" ;# command to reset the form set form(reset_button) "" ;# list of all reset buttons set form(submit) "" ;# command to submit the form set form(submit_button) "" ;# list of all submit buttons } # Where we're done try to get all of the state into the widgets so # we can free up the form structure here. Unfortunately, we can't! proc HMtag_/form {win param text} { upvar #0 HM$win var upvar #0 $var(form_id) form # make submit button entries for all radio buttons foreach name [array names form radio_*] { regsub radio_ $name {} name lappend form(submit) [list $name \$form(radio_$name)] } # process the reset button(s) foreach item $form(reset_button) { $item configure -command $form(reset) } # no submit button - add one if {$form(submit_button) == ""} { HMinput_submit $win {} } # process the "submit" command(s) # each submit button could have its own name,value pair foreach item $form(submit_button) { set submit $form(submit) catch {lappend submit $form(submit_$item)} $item configure -command \ [list HMsubmit_button $win $var(form_id) $form(param) \ $submit] } # unset all unused fields here unset form(reset) form(submit) form(reset_button) form(submit_button) unset var(form_id) } ################################################################### # handle form input items # each item type is handled in a separate procedure # Each "type" procedure needs to: # - create the window # - initialize it # - add the "submit" and "reset" commands onto the proper Q's # "submit" is subst'd # "reset" is eval'd proc HMtag_input {win param text} { upvar #0 HM$win var set type text ;# the default HMextract_param $param type set type [string tolower $type] if {[catch {HMinput_$type $win $param} err]} { puts stderr $err } } # input type=text # parameters NAME (reqd), MAXLENGTH, SIZE, VALUE proc HMinput_text {win param {show {}}} { upvar #0 HM$win var upvar #0 $var(form_id) form # make the entry HMextract_param $param name ;# required set item $win.input_text,$var(tags) set size 20; HMextract_param $param size set maxlength 0; HMextract_param $param maxlength entry $item -width $size -show $show # set the initial value set value ""; HMextract_param $param value $item insert 0 $value # insert the entry HMwin_install $win $item # set the "reset" and "submit" commands append form(reset) ";$item delete 0 end;$item insert 0 [list $value]" lappend form(submit) [list $name "\[$item get]"] # handle the maximum length (broken - no way to cleanup bindtags state) if {$maxlength} { bindtags $item "[bindtags $item] max$maxlength" bind max$maxlength "%W delete $maxlength end" } } # password fields - same as text, only don't show data # parameters NAME (reqd), MAXLENGTH, SIZE, VALUE proc HMinput_password {win param} { HMinput_text $win $param * } # checkbuttons are missing a "get" option, so we must use a global # variable to store the value. # Parameters NAME, VALUE, (reqd), CHECKED proc HMinput_checkbox {win param} { upvar #0 HM$win var upvar #0 $var(form_id) form HMextract_param $param name HMextract_param $param value # Set the global variable, don't use the "form" alias as it is not # defined in the global scope of the button set variable $var(form_id)(check_$var(tags)) set item $win.input_checkbutton,$var(tags) checkbutton $item -variable $variable -off {} -on $value -text " " if {[HMextract_param $param checked]} { $item select append form(reset) ";$item select" } else { append form(reset) ";$item deselect" } HMwin_install $win $item lappend form(submit) [list $name \$form(check_$var(tags))] } # radio buttons. These are like check buttons, but only one can be selected proc HMinput_radio {win param} { upvar #0 HM$win var upvar #0 $var(form_id) form HMextract_param $param name HMextract_param $param value set first [expr ![info exists form(radio_$name)]] set variable $var(form_id)(radio_$name) set variable $var(form_id)(radio_$name) set item $win.input_radiobutton,$var(tags) radiobutton $item -variable $variable -value $value -text " " HMwin_install $win $item if {$first || [HMextract_param $param checked]} { $item select append form(reset) ";$item select" } else { append form(reset) ";$item deselect" } # do the "submit" actions in /form so we only end up with 1 per button grouping # contributing to the submission } # hidden fields, just append to the "submit" data # params: NAME, VALUE (reqd) proc HMinput_hidden {win param} { upvar #0 HM$win var upvar #0 $var(form_id) form HMextract_param $param name HMextract_param $param value lappend form(submit) [list $name $value] } # handle input images. The spec isn't very clear on these, so I'm not # sure its quite right # Use std image tag, only set up our own callbacks # (e.g. make sure ismap isn't set) # params: NAME, SRC (reqd) ALIGN proc HMinput_image {win param} { upvar #0 HM$win var upvar #0 $var(form_id) form HMextract_param $param name set name ;# barf if no name is specified set item [HMtag_img $win $param {}] $item configure -relief raised -bd 2 -bg blue # make a dummy "submit" button, and invoke it to send the form. # We have to get the %x,%y in the value somehow, so calculate it during # binding, and save it in the form array for later processing set submit $win.dummy_submit,$var(tags) if {[winfo exists $submit]} { destroy $submit } button $submit -takefocus 0;# this never gets mapped! lappend form(submit_button) $submit set form(submit_$submit) [list $name $name.\$form(X).\$form(Y)] $item configure -takefocus 1 bind $item "catch \{$win see $item\}" bind $item <1> "$item configure -relief sunken" bind $item " set $var(form_id)(X) 0 set $var(form_id)(Y) 0 $submit invoke " bind $item " set $var(form_id)(X) %x set $var(form_id)(Y) %y $item configure -relief raised $submit invoke " } # Set up the reset button. Wait for the /form to attach # the -command option. There could be more that 1 reset button # params VALUE proc HMinput_reset {win param} { upvar #0 HM$win var upvar #0 $var(form_id) form set value reset HMextract_param $param value set item $win.input_reset,$var(tags) button $item -text [HMmap_esc $value] HMwin_install $win $item lappend form(reset_button) $item } # Set up the submit button. Wait for the /form to attach # the -command option. There could be more that 1 submit button # params: NAME, VALUE proc HMinput_submit {win param} { upvar #0 HM$win var upvar #0 $var(form_id) form HMextract_param $param name set value submit HMextract_param $param value set item $win.input_submit,$var(tags) button $item -text [HMmap_esc $value] -fg blue HMwin_install $win $item lappend form(submit_button) $item # need to tie the "name=value" to this button # save the pair and do it when we finish the submit button catch {set form(submit_$item) [list $name $value]} } ######################################################################### # selection items # They all go into a list box. We don't what to do with the listbox until # we know how many items end up in it. Gather up the data for the "options" # and finish up in the /select tag # params: NAME (reqd), MULTIPLE, SIZE proc HMtag_select {win param text} { upvar #0 HM$win var upvar #0 $var(form_id) form HMextract_param $param name set size 5; HMextract_param $param size set form(select_size) $size set form(select_name) $name set form(select_values) "" ;# list of values to submit if {[HMextract_param $param multiple]} { set mode multiple } else { set mode single } set item $win.select,$var(tags) frame $item set form(select_frame) $item listbox $item.list -selectmode $mode -width 0 -exportselection 0 HMwin_install $win $item } # select options # The values returned in the query may be different from those # displayed in the listbox, so we need to keep a separate list of # query values. # form(select_default) - contains the default query value # form(select_frame) - name of the listbox's containing frame # form(select_values) - list of query values # params: VALUE, SELECTED proc HMtag_option {win param text} { upvar #0 HM$win var upvar #0 $var(form_id) form upvar $text data set frame $form(select_frame) # set default option (or options) if {[HMextract_param $param selected]} { lappend form(select_default) [$form(select_frame).list size] } set value [string trimright $data " \n"] $frame.list insert end $value HMextract_param $param value lappend form(select_values) $value set data "" } # do most of the work here! # if SIZE>1, make the listbox. Otherwise make a "drop-down" # listbox with a label in it # If the # of items > size, add a scroll bar # This should probably be broken up into callbacks to make it # easier to override the "look". proc HMtag_/select {win param text} { upvar #0 HM$win var upvar #0 $var(form_id) form set frame $form(select_frame) set size $form(select_size) set items [$frame.list size] # set the defaults and reset button append form(reset) ";$frame.list selection clear 0 $items" if {[info exists form(select_default)]} { foreach i $form(select_default) { $frame.list selection set $i append form(reset) ";$frame.list selection set $i" } } else { $frame.list selection set 0 append form(reset) ";$frame.list selection set 0" } # set up the submit button. This is the general case. For single # selections we could be smarter for {set i 0} {$i < $size} {incr i} { set value [format {[expr {[%s selection includes %s] ? {%s} : {}}]} \ $frame.list $i [lindex $form(select_values) $i]] lappend form(submit) [list $form(select_name) $value] } # show the listbox - no scroll bar if {$size > 1 && $items <= $size} { $frame.list configure -height $items pack $frame.list # Listbox with scrollbar } elseif {$size > 1} { scrollbar $frame.scroll -command "$frame.list yview" \ -orient v -takefocus 0 $frame.list configure -height $size \ -yscrollcommand "$frame.scroll set" pack $frame.list $frame.scroll -side right -fill y # This is a joke! } else { scrollbar $frame.scroll -command "$frame.list yview" \ -orient h -takefocus 0 $frame.list configure -height 1 \ -yscrollcommand "$frame.scroll set" pack $frame.list $frame.scroll -side top -fill x } # cleanup foreach i [array names form select_*] { unset form($i) } } # do a text area (multi-line text) # params: COLS, NAME, ROWS (all reqd, but default rows and cols anyway) proc HMtag_textarea {win param text} { upvar #0 HM$win var upvar #0 $var(form_id) form upvar $text data set rows 5; HMextract_param $param rows set cols 30; HMextract_param $param cols HMextract_param $param name set item $win.textarea,$var(tags) frame $item text $item.text -width $cols -height $rows -wrap none \ -yscrollcommand "$item.scroll set" -padx 3 -pady 3 scrollbar $item.scroll -command "$item.text yview" -orient v $item.text insert 1.0 $data HMwin_install $win $item pack $item.text $item.scroll -side right -fill y lappend form(submit) [list $name "\[$item.text get 0.0 end]"] append form(reset) ";$item.text delete 1.0 end; \ $item.text insert 1.0 [list $data]" set data "" } # procedure to install windows into the text widget # - win: name of the text widget # - item: name of widget to install proc HMwin_install {win item} { upvar #0 HM$win var $win window create $var(S_insert) -window $item -align bottom $win tag add indent$var(level) $item set focus [expr {[winfo class $item] != "Frame"}] $item configure -takefocus $focus bind $item "$win see $item" } ##################################################################### # Assemble and submit the query # each list element in "stuff" is a name/value pair # - The names are the NAME parameters of the various fields # - The values get run through "subst" to extract the values # - We do the user callback with the list of name value pairs proc HMsubmit_button {win form_id param stuff} { upvar #0 HM$win var upvar #0 $form_id form set query "" foreach pair $stuff { set value [subst [lindex $pair 1]] if {$value != ""} { set item [lindex $pair 0] lappend query $item $value } } # this is the user callback. HMsubmit_form $win $param $query } # sample user callback for form submission # should be replaced by the application # Sample version generates a string suitable for http proc HMsubmit_form {win param query} { set result "" set sep "" foreach i $query { append result $sep [HMmap_reply $i] if {$sep != "="} {set sep =} {set sep &} } puts $result } # do x-www-urlencoded character mapping # The spec says: "non-alphanumeric characters are replaced by '%HH'" set HMalphanumeric a-zA-Z0-9 ;# definition of alphanumeric character class for {set i 1} {$i <= 256} {incr i} { set c [format %c $i] if {![string match \[$HMalphanumeric\] $c]} { set HMform_map($c) %[format %.2x $i] } } # These are handled specially array set HMform_map { " " + \n %0d%0a } # 1 leave alphanumerics characters alone # 2 Convert every other character to an array lookup # 3 Escape constructs that are "special" to the tcl parser # 4 "subst" the result, doing all the array substitutions proc HMmap_reply {string} { global HMform_map HMalphanumeric regsub -all \[^$HMalphanumeric\] $string {$HMform_map(&)} string regsub -all \n $string {\\n} string regsub -all \t $string {\\t} string regsub -all {[][{})\\]\)} $string {\\&} string return [subst $string] } # convert a x-www-urlencoded string int a a list of name/value pairs # 1 convert a=b&c=d... to {a} {b} {c} {d}... # 2, convert + to " " # 3, convert %xx to char equiv proc HMcgiDecode {data} { set data [split $data "&="] foreach i $data { lappend result [cgiMap $i] } return $result } proc HMcgiMap {data} { regsub -all {\+} $data " " data if {[regexp % $data]} { regsub -all {([][$\\])} $data {\\\1} data regsub -all {%([0-9a-fA-F][0-9a-fA-F])} $data {[format %c 0x\1]} data return [subst $data] } else { return $data } } # There is a bug in the tcl library focus routines that prevents focus # from every reaching an un-viewable window. Use our *own* # version of the library routine, until the bug is fixed, make sure we # over-ride the library version, and not the otherway around if { [info commands tkFocusOK]=="" } { auto_load tkFocusOK } proc tkFocusOK w { set code [catch {$w cget -takefocus} value] if {($code == 0) && ($value != "")} { if {$value == 0} { return 0 } elseif {$value == 1} { return 1 } else { set value [uplevel #0 $value $w] if {$value != ""} { return $value } } } set code [catch {$w cget -state} value] if {($code == 0) && ($value == "disabled")} { return 0 } regexp Key|Focus "[bind $w] [bind [winfo class $w]]" } fv5.5/tcltk/pow/install-sh0000755000220700000360000000421213224715130014444 0ustar birbylhea#!/bin/sh # # install - install a program, script, or datafile # This comes from X11R5; it is not part of GNU. # # $XConsortium: install.sh,v 1.2 89/12/18 14:47:22 jim Exp $ # # This script is compatible with the BSD install script, but was written # from scratch. # # set DOITPROG to echo to test this script # Don't use :- since 4.3BSD and earlier shells don't like it. doit="${DOITPROG-}" # put in absolute paths if you don't have them in your path; or use env. vars. mvprog="${MVPROG-mv}" cpprog="${CPPROG-cp}" chmodprog="${CHMODPROG-chmod}" chownprog="${CHOWNPROG-chown}" chgrpprog="${CHGRPPROG-chgrp}" stripprog="${STRIPPROG-strip}" rmprog="${RMPROG-rm}" instcmd="$mvprog" chmodcmd="" chowncmd="" chgrpcmd="" stripcmd="" rmcmd="$rmprog -f" mvcmd="$mvprog" src="" dst="" while [ x"$1" != x ]; do case $1 in -c) instcmd="$cpprog" shift continue;; -m) chmodcmd="$chmodprog $2" shift shift continue;; -o) chowncmd="$chownprog $2" shift shift continue;; -g) chgrpcmd="$chgrpprog $2" shift shift continue;; -s) stripcmd="$stripprog" shift continue;; *) if [ x"$src" = x ] then src=$1 else dst=$1 fi shift continue;; esac done if [ x"$src" = x ] then echo "install: no input file specified" exit 1 fi if [ x"$dst" = x ] then echo "install: no destination specified" exit 1 fi # If destination is a directory, append the input filename; if your system # does not like double slashes in filenames, you may need to add some logic if [ -d $dst ] then dst="$dst"/`basename $src` fi # Make a temp file name in the proper directory. dstdir=`dirname $dst` dsttmp=$dstdir/#inst.$$# # Move or copy the file name to the temp name $doit $instcmd $src $dsttmp # and set any options; do chmod last to preserve setuid bits if [ x"$chowncmd" != x ]; then $doit $chowncmd $dsttmp; fi if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dsttmp; fi if [ x"$stripcmd" != x ]; then $doit $stripcmd $dsttmp; fi if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dsttmp; fi # Now rename the file to the real destination. $doit $rmcmd $dst $doit $mvcmd $dsttmp $dst exit 0 fv5.5/tcltk/pow/makefile.bc50000644000220700000360000001104213224715130014607 0ustar birbylhea# # Borland C++ IDE generated makefile # Generated 10/6/98 at 11:20:32 AM # .AUTODEPEND # # Borland C++ tools # IMPLIB = Implib BCC32 = Bcc32 +BccW32.cfg BCC32I = Bcc32i +BccW32.cfg TLINK32 = TLink32 TLIB = TLib BRC32 = Brc32 TASM32 = Tasm32 # # IDE macros # # # Options # IDE_LinkFLAGS32 = -LD:\bc5\LIB LinkerLocalOptsAtC32_powtcldlib = -Tpd -ap -c /w-inq ResLocalOptsAtC32_powtcldlib = BLocalOptsAtC32_powtcldlib = CompInheritOptsAt_powtcldlib = -ID:\bc5\INCLUDE;C:\FV_SRC\TCL8.0.4\GENERIC;C:\FV_SRC\TK8.0.4\GENERIC;C:\FV_SRC\TK8.0.4\XLIB;C:\FV_SRC\TK8.0.4\WIN -D_RTLDLL;_BIDSDLL; -w-sig -w-stu -w-par -w-use -w-aus LinkerInheritOptsAt_powtcldlib = -x LinkerOptsAt_powtcldlib = $(LinkerLocalOptsAtC32_powtcldlib) ResOptsAt_powtcldlib = $(ResLocalOptsAtC32_powtcldlib) BOptsAt_powtcldlib = $(BLocalOptsAtC32_powtcldlib) # # Dependency List # Dep_pow = \ powtcl.lib pow : BccW32.cfg $(Dep_pow) echo MakeNode powtcl.lib : powtcl.dll $(IMPLIB) $@ powtcl.dll Dep_powtclddll = \ ..\tcl8.0.4\win\tcl80.lib\ ..\tk8.0.4\win\tk80.lib\ dllentrypoint.obj\ powutils.obj\ visu_lut.obj\ visu_init.obj\ visu_generic.obj\ tclshared.obj\ powwcs.obj\ powcanvcurve.obj\ powgrid.obj\ powcreatevector.obj\ powcreateimage.obj\ powcreategraph.obj\ powcreatedata.obj\ powcreatecurve.obj\ powcommands.obj\ powcolormap.obj\ powinit.obj powtcl.dll : $(Dep_powtclddll) powtcl.def $(TLINK32) @&&| /v $(IDE_LinkFLAGS32) $(LinkerOptsAt_powtcldlib) $(LinkerInheritOptsAt_powtcldlib) + D:\bc5\LIB\c0d32.obj+ dllentrypoint.obj+ powutils.obj+ visu_lut.obj+ visu_init.obj+ visu_generic.obj+ tclshared.obj+ powwcs.obj+ powcanvcurve.obj+ powgrid.obj+ powcreatevector.obj+ powcreateimage.obj+ powcreategraph.obj+ powcreatedata.obj+ powcreatecurve.obj+ powcommands.obj+ powcolormap.obj+ powinit.obj $<,$* ..\tcl8.0.4\win\tcl80.lib+ ..\tk8.0.4\win\tk80.lib+ D:\bc5\LIB\bidsfi.lib+ D:\bc5\LIB\import32.lib+ D:\bc5\LIB\cw32i.lib | dllentrypoint.obj : dllentrypoint.c $(BCC32) -P- -c @&&| $(CompOptsAt_powtcldlib) $(CompInheritOptsAt_powtcldlib) -o$@ dllentrypoint.c | powutils.obj : powutils.c $(BCC32) -P- -c @&&| $(CompOptsAt_powtcldlib) $(CompInheritOptsAt_powtcldlib) -o$@ powutils.c | visu_lut.obj : visu_lut.c $(BCC32) -P- -c @&&| $(CompOptsAt_powtcldlib) $(CompInheritOptsAt_powtcldlib) -o$@ visu_lut.c | visu_init.obj : visu_init.c $(BCC32) -P- -c @&&| $(CompOptsAt_powtcldlib) $(CompInheritOptsAt_powtcldlib) -o$@ visu_init.c | visu_generic.obj : visu_generic.c $(BCC32) -P- -c @&&| $(CompOptsAt_powtcldlib) $(CompInheritOptsAt_powtcldlib) -o$@ visu_generic.c | tclshared.obj : tclshared.c $(BCC32) -P- -c @&&| $(CompOptsAt_powtcldlib) $(CompInheritOptsAt_powtcldlib) -o$@ tclshared.c | powwcs.obj : powwcs.c $(BCC32) -P- -c @&&| $(CompOptsAt_powtcldlib) $(CompInheritOptsAt_powtcldlib) -o$@ powwcs.c | powcanvcurve.obj : powcanvcurve.c $(BCC32) -P- -c @&&| $(CompOptsAt_powtcldlib) $(CompInheritOptsAt_powtcldlib) -o$@ powcanvcurve.c | powgrid.obj : powgrid.c $(BCC32) -P- -c @&&| $(CompOptsAt_powtcldlib) $(CompInheritOptsAt_powtcldlib) -o$@ powgrid.c | powcreatevector.obj : powcreatevector.c $(BCC32) -P- -c @&&| $(CompOptsAt_powtcldlib) $(CompInheritOptsAt_powtcldlib) -o$@ powcreatevector.c | powcreateimage.obj : powcreateimage.c $(BCC32) -P- -c @&&| $(CompOptsAt_powtcldlib) $(CompInheritOptsAt_powtcldlib) -o$@ powcreateimage.c | powcreategraph.obj : powcreategraph.c $(BCC32) -P- -c @&&| $(CompOptsAt_powtcldlib) $(CompInheritOptsAt_powtcldlib) -o$@ powcreategraph.c | powcreatedata.obj : powcreatedata.c $(BCC32) -P- -c @&&| $(CompOptsAt_powtcldlib) $(CompInheritOptsAt_powtcldlib) -o$@ powcreatedata.c | powcreatecurve.obj : powcreatecurve.c $(BCC32) -P- -c @&&| $(CompOptsAt_powtcldlib) $(CompInheritOptsAt_powtcldlib) -o$@ powcreatecurve.c | powcommands.obj : powcommands.c $(BCC32) -P- -c @&&| $(CompOptsAt_powtcldlib) $(CompInheritOptsAt_powtcldlib) -o$@ powcommands.c | powcolormap.obj : powcolormap.c $(BCC32) -P- -c @&&| $(CompOptsAt_powtcldlib) $(CompInheritOptsAt_powtcldlib) -o$@ powcolormap.c | powinit.obj : powinit.c $(BCC32) -P- -c @&&| $(CompOptsAt_powtcldlib) $(CompInheritOptsAt_powtcldlib) -o$@ powinit.c | orbit.obj : orbit.c $(BCC32) -P- -c @&&| $(CompOptsAt_powtcldlib) $(CompInheritOptsAt_powtcldlib) -o$@ orbit.c | vcclib: powtcl.def lib/def:powtcl.def powtcl.def: ..\tcl8.0\win\DUMPEXTS -o powtcl.def powtcl.dll @&&| $(Dep_powtclddll) | # Compiler configuration file BccW32.cfg : Copy &&| -w -R -v -vi -H -H=pow.csm -WCD -g250 | $@ fv5.5/tcltk/pow/makefile.vc0000644000220700000360000002056513224715130014560 0ustar birbylhea# Microsoft Developer Studio Generated NMAKE File, Based on pow.dsp !IF "$(CFG)" == "" CFG=pow - Win32 Debug !MESSAGE No configuration specified. Defaulting to pow - Win32 Debug. !ENDIF !IF "$(CFG)" != "pow - Win32 Release" && "$(CFG)" != "pow - Win32 Debug" !MESSAGE Invalid configuration "$(CFG)" specified. !MESSAGE You can specify a configuration when running NMAKE !MESSAGE by defining the macro CFG on the command line. For example: !MESSAGE !MESSAGE NMAKE /f "pow.mak" CFG="pow - Win32 Debug" !MESSAGE !MESSAGE Possible choices for configuration are: !MESSAGE !MESSAGE "pow - Win32 Release" (based on "Win32 (x86) Dynamic-Link Library") !MESSAGE "pow - Win32 Debug" (based on "Win32 (x86) Dynamic-Link Library") !MESSAGE !ERROR An invalid configuration is specified. !ENDIF !IF "$(OS)" == "Windows_NT" NULL= !ELSE NULL=nul !ENDIF CPP=cl.exe MTL=midl.exe RSC=rc.exe !IF "$(CFG)" == "pow - Win32 Release" OUTDIR=. INTDIR=. # Begin Custom Macros OutDir=. # End Custom Macros ALL : "$(OUTDIR)\powtcl.dll" CLEAN : -@erase "$(INTDIR)\PowCanvCurve.obj" -@erase "$(INTDIR)\PowColormap.obj" -@erase "$(INTDIR)\PowCommands.obj" -@erase "$(INTDIR)\PowCreateCurve.obj" -@erase "$(INTDIR)\PowCreateData.obj" -@erase "$(INTDIR)\PowCreateGraph.obj" -@erase "$(INTDIR)\PowCreateImage.obj" -@erase "$(INTDIR)\PowCreateVector.obj" -@erase "$(INTDIR)\PowGrid.obj" -@erase "$(INTDIR)\PowInit.obj" -@erase "$(INTDIR)\PowUtils.obj" -@erase "$(INTDIR)\PowWCS.obj" -@erase "$(INTDIR)\vc60.idb" -@erase "$(INTDIR)\Visu_generic.obj" -@erase "$(INTDIR)\Visu_Init.obj" -@erase "$(INTDIR)\Visu_lut.obj" -@erase "$(OUTDIR)\powtcl.dll" -@erase "$(OUTDIR)\pow.exp" -@erase "$(OUTDIR)\powtcl.lib" "$(OUTDIR)" : if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)" CPP_PROJ=/nologo /MT /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /D "POW_EXPORTS" /Fp"$(INTDIR)\pow.pch" /YX /Fo"$(INTDIR)\\" /Fd"$(INTDIR)\\" /FD /c MTL_PROJ=/nologo /D "NDEBUG" /mktyplib203 /win32 BSC32=bscmake.exe BSC32_FLAGS=/nologo /o"$(OUTDIR)\pow.bsc" BSC32_SBRS= \ LINK32=link.exe LINK32_FLAGS=kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /dll /incremental:no /pdb:"$(OUTDIR)\pow.pdb" /machine:I386 /def:"powtcl.def" /out:"$(OUTDIR)\powtcl.dll" /implib:"$(OUTDIR)\powtcl.lib" DEF_FILE= \ "powtcl.def" LINK32_OBJS= \ "$(INTDIR)\PowWCS.obj" \ "$(INTDIR)\PowCanvCurve.obj" \ "$(INTDIR)\PowColormap.obj" \ "$(INTDIR)\PowCommands.obj" \ "$(INTDIR)\PowCreateCurve.obj" \ "$(INTDIR)\PowCreateData.obj" \ "$(INTDIR)\PowCreateGraph.obj" \ "$(INTDIR)\PowCreateImage.obj" \ "$(INTDIR)\PowCreateVector.obj" \ "$(INTDIR)\PowGrid.obj" \ "$(INTDIR)\PowUtils.obj" \ "$(INTDIR)\Visu_lut.obj" \ "$(INTDIR)\Visu_Init.obj" \ "$(INTDIR)\Visu_generic.obj" \ "$(INTDIR)\PowInit.obj" "$(OUTDIR)\powtcl.dll" : "$(OUTDIR)" $(LINK32_OBJS) $(DEF_FILE) $(LINK32) @<< $(LINK32_FLAGS) $(LINK32_OBJS) << $(DEF_FILE): ..\tcl8.2.2\win\Release\DUMPEXTS -o $(DEF_FILE) powtcl.dll $(LINK32_OBJS) !ELSEIF "$(CFG)" == "pow - Win32 Debug" OUTDIR=. INTDIR=. # Begin Custom Macros OutDir=. # End Custom Macros ALL : "$(OUTDIR)\powtcl.dll" CLEAN : -@erase "$(INTDIR)\PowCanvCurve.obj" -@erase "$(INTDIR)\PowColormap.obj" -@erase "$(INTDIR)\PowCommands.obj" -@erase "$(INTDIR)\PowCreateCurve.obj" -@erase "$(INTDIR)\PowCreateData.obj" -@erase "$(INTDIR)\PowCreateGraph.obj" -@erase "$(INTDIR)\PowCreateImage.obj" -@erase "$(INTDIR)\PowCreateVector.obj" -@erase "$(INTDIR)\PowGrid.obj" -@erase "$(INTDIR)\PowInit.obj" -@erase "$(INTDIR)\PowUtils.obj" -@erase "$(INTDIR)\PowWCS.obj" -@erase "$(INTDIR)\vc60.idb" -@erase "$(INTDIR)\vc60.pdb" -@erase "$(INTDIR)\Visu_generic.obj" -@erase "$(INTDIR)\Visu_Init.obj" -@erase "$(INTDIR)\Visu_lut.obj" -@erase "$(OUTDIR)\powtcl.dll" -@erase "$(OUTDIR)\pow.exp" -@erase "$(OUTDIR)\pow.ilk" -@erase "$(OUTDIR)\powtcl.lib" -@erase "$(OUTDIR)\pow.pdb" "$(OUTDIR)" : if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)" CPP_PROJ=/nologo /MTd /W3 /Gm /GX /ZI /Od /I "d:\fv_src\tcl8.2.2\generic" /I "d:\fv_src\tk8.2.2\generic\\" /I "d:\fv_src\tk8.2.2\xlib" /I "d:\fv_src\tk8.2.2\win" /D "__WIN32__" /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /D "POW_EXPORTS" /Fp"$(INTDIR)\pow.pch" /YX /Fo"$(INTDIR)\\" /Fd"$(INTDIR)\\" /FD /GZ /c MTL_PROJ=/nologo /D "_DEBUG" /mktyplib203 /win32 BSC32=bscmake.exe BSC32_FLAGS=/nologo /o"$(OUTDIR)\pow.bsc" BSC32_SBRS= \ LINK32=link.exe LINK32_FLAGS=d:\fv_src\tcl8.2.2\win\Release\tcl82.lib d:\fv_src\tk8.2.2\win\Release\tk82.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /dll /incremental:yes /pdb:"$(OUTDIR)\pow.pdb" /debug /machine:I386 /def:"powtcl.def" /out:"$(OUTDIR)\powtcl.dll" /implib:"$(OUTDIR)\powtcl.lib" /pdbtype:sept DEF_FILE= \ "powtcl.def" LINK32_OBJS= \ "$(INTDIR)\PowWCS.obj" \ "$(INTDIR)\PowCanvCurve.obj" \ "$(INTDIR)\PowColormap.obj" \ "$(INTDIR)\PowCommands.obj" \ "$(INTDIR)\PowCreateCurve.obj" \ "$(INTDIR)\PowCreateData.obj" \ "$(INTDIR)\PowCreateGraph.obj" \ "$(INTDIR)\PowCreateImage.obj" \ "$(INTDIR)\PowCreateVector.obj" \ "$(INTDIR)\PowGrid.obj" \ "$(INTDIR)\PowUtils.obj" \ "$(INTDIR)\Visu_lut.obj" \ "$(INTDIR)\Visu_Init.obj" \ "$(INTDIR)\Visu_generic.obj" \ "$(INTDIR)\PowInit.obj" "$(OUTDIR)\powtcl.dll" : "$(OUTDIR)" $(LINK32_OBJS) $(DEF_FILE) $(LINK32) @<< $(LINK32_FLAGS) $(LINK32_OBJS) << $(DEF_FILE): ..\tcl8.2.2\win\Release\DUMPEXTS -o $(DEF_FILE) powtcl.dll $(LINK32_OBJS) !ENDIF .c{$(INTDIR)}.obj:: $(CPP) @<< $(CPP_PROJ) $< << .cpp{$(INTDIR)}.obj:: $(CPP) @<< $(CPP_PROJ) $< << .cxx{$(INTDIR)}.obj:: $(CPP) @<< $(CPP_PROJ) $< << .c{$(INTDIR)}.sbr:: $(CPP) @<< $(CPP_PROJ) $< << .cpp{$(INTDIR)}.sbr:: $(CPP) @<< $(CPP_PROJ) $< << .cxx{$(INTDIR)}.sbr:: $(CPP) @<< $(CPP_PROJ) $< << !IF "$(NO_EXTERNAL_DEPS)" != "1" !IF EXISTS("pow.dep") !INCLUDE "pow.dep" !ELSE !MESSAGE Warning: cannot find "pow.dep" !ENDIF !ENDIF !IF "$(CFG)" == "pow - Win32 Release" || "$(CFG)" == "pow - Win32 Debug" SOURCE=PowCanvCurve.c !IF "$(CFG)" == "pow - Win32 Release" CPP_SWITCHES=/nologo /MT /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /D "POW_EXPORTS" /Fp"$(INTDIR)\pow.pch" /YX /Fo"$(INTDIR)\\" /Fd"$(INTDIR)\\" /FD /c "$(INTDIR)\PowCanvCurve.obj" : $(SOURCE) "$(INTDIR)" $(CPP) @<< $(CPP_SWITCHES) $(SOURCE) << !ELSEIF "$(CFG)" == "pow - Win32 Debug" CPP_SWITCHES=/nologo /MTd /W3 /Gm /GX /ZI /Od /I "d:\fv_src\tcl8.2.2\generic" /I "d:\fv_src\tk8.2.2\generic\\" /I "d:\fv_src\tk8.2.2\xlib" /I "d:\fv_src\tk8.2.2\win" /D "__WIN32__" /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /D "POW_EXPORTS" /Fp"$(INTDIR)\pow.pch" /YX /Fo"$(INTDIR)\\" /Fd"$(INTDIR)\\" /FD /GZ /c "$(INTDIR)\PowCanvCurve.obj" : $(SOURCE) "$(INTDIR)" $(CPP) @<< $(CPP_SWITCHES) $(SOURCE) << !ENDIF SOURCE=PowColormap.c "$(INTDIR)\PowColormap.obj" : $(SOURCE) "$(INTDIR)" $(CPP) $(CPP_PROJ) $(SOURCE) SOURCE=PowCommands.c "$(INTDIR)\PowCommands.obj" : $(SOURCE) "$(INTDIR)" $(CPP) $(CPP_PROJ) $(SOURCE) SOURCE=PowCreateCurve.c "$(INTDIR)\PowCreateCurve.obj" : $(SOURCE) "$(INTDIR)" $(CPP) $(CPP_PROJ) $(SOURCE) SOURCE=PowCreateData.c "$(INTDIR)\PowCreateData.obj" : $(SOURCE) "$(INTDIR)" $(CPP) $(CPP_PROJ) $(SOURCE) SOURCE=PowCreateGraph.c "$(INTDIR)\PowCreateGraph.obj" : $(SOURCE) "$(INTDIR)" $(CPP) $(CPP_PROJ) $(SOURCE) SOURCE=PowCreateImage.c "$(INTDIR)\PowCreateImage.obj" : $(SOURCE) "$(INTDIR)" $(CPP) $(CPP_PROJ) $(SOURCE) SOURCE=PowCreateVector.c "$(INTDIR)\PowCreateVector.obj" : $(SOURCE) "$(INTDIR)" $(CPP) $(CPP_PROJ) $(SOURCE) SOURCE=PowGrid.c "$(INTDIR)\PowGrid.obj" : $(SOURCE) "$(INTDIR)" $(CPP) $(CPP_PROJ) $(SOURCE) SOURCE=PowInit.c "$(INTDIR)\PowInit.obj" : $(SOURCE) "$(INTDIR)" $(CPP) $(CPP_PROJ) $(SOURCE) SOURCE=PowUtils.c "$(INTDIR)\PowUtils.obj" : $(SOURCE) "$(INTDIR)" $(CPP) $(CPP_PROJ) $(SOURCE) SOURCE=PowWCS.c "$(INTDIR)\PowWCS.obj" : $(SOURCE) "$(INTDIR)" $(CPP) $(CPP_PROJ) $(SOURCE) SOURCE=Visu_generic.c "$(INTDIR)\Visu_generic.obj" : $(SOURCE) "$(INTDIR)" $(CPP) $(CPP_PROJ) $(SOURCE) SOURCE=Visu_Init.c "$(INTDIR)\Visu_Init.obj" : $(SOURCE) "$(INTDIR)" $(CPP) $(CPP_PROJ) $(SOURCE) SOURCE=Visu_lut.c "$(INTDIR)\Visu_lut.obj" : $(SOURCE) "$(INTDIR)" $(CPP) $(CPP_PROJ) $(SOURCE) !ENDIF fv5.5/tcltk/pow/makefile_plugin.bc50000644000220700000360000001066313224715130016175 0ustar birbylhea# # Borland C++ IDE generated makefile # Generated 10/6/98 at 11:20:32 AM # .AUTODEPEND # # Borland C++ tools # IMPLIB = Implib BCC32 = Bcc32 +BccW32.cfg BCC32I = Bcc32i +BccW32.cfg TLINK32 = TLink32 TLIB = TLib BRC32 = Brc32 TASM32 = Tasm32 # # IDE macros # # # Options # IDE_LinkFLAGS32 = -LD:\bc5\LIB LinkerLocalOptsAtC32_powtcldlib = -Tpd -ap -c /w-inq ResLocalOptsAtC32_powtcldlib = BLocalOptsAtC32_powtcldlib = CompInheritOptsAt_powtcldlib = -ID:\bc5\INCLUDE;C:\LHEAPLUGIN\TCL8.0\GENERIC;C:\LHEAPLUGIN\TK8.0\GENERIC;C:\LHEAPLUGIN\TK8.0\XLIB;C:\LHEAPLUGIN\TK8.0\WIN -D_RTLDLL;_BIDSDLL; -w-sig -w-stu -w-par -w-use -w-aus LinkerInheritOptsAt_powtcldlib = -x LinkerOptsAt_powtcldlib = $(LinkerLocalOptsAtC32_powtcldlib) ResOptsAt_powtcldlib = $(ResLocalOptsAtC32_powtcldlib) BOptsAt_powtcldlib = $(BLocalOptsAtC32_powtcldlib) # # Dependency List # Dep_pow = \ powtcl.lib pow : BccW32.cfg $(Dep_pow) echo MakeNode powtcl.lib : powtcl.dll $(IMPLIB) $@ powtcl.dll Dep_powtclddll = \ ..\tcl8.0\win\tcl80.lib\ ..\tk8.0\win\tk80.lib\ powutils.obj\ visu_lut.obj\ visu_init.obj\ visu_generic.obj\ tclshared.obj\ powwcs.obj\ powcanvcurve.obj\ powgrid.obj\ powcreatevector.obj\ powcreateimage.obj\ powcreategraph.obj\ powcreatedata.obj\ powcreatecurve.obj\ powcommands.obj\ powcolormap.obj\ powinit_plugin.obj\ orbit.obj powtcl.dll : $(Dep_powtclddll) powtcl.def $(TLINK32) @&&| /v $(IDE_LinkFLAGS32) $(LinkerOptsAt_powtcldlib) $(LinkerInheritOptsAt_powtcldlib) + D:\bc5\LIB\c0d32.obj+ powutils.obj+ visu_lut.obj+ visu_init.obj+ visu_generic.obj+ tclshared.obj+ powwcs.obj+ powcanvcurve.obj+ powgrid.obj+ powcreatevector.obj+ powcreateimage.obj+ powcreategraph.obj+ powcreatedata.obj+ powcreatecurve.obj+ powcommands.obj+ powcolormap.obj+ powinit_plugin.obj+ orbit.obj $<,$* ..\tcl8.0\win\tcl80.lib+ ..\tk8.0\win\tk80.lib+ D:\bc5\LIB\bidsfi.lib+ D:\bc5\LIB\import32.lib+ D:\bc5\LIB\cw32i.lib,powtcl.def | powutils.obj : powutils.c $(BCC32) -P- -c @&&| $(CompOptsAt_powtcldlib) $(CompInheritOptsAt_powtcldlib) -o$@ powutils.c | visu_lut.obj : visu_lut.c $(BCC32) -P- -c @&&| $(CompOptsAt_powtcldlib) $(CompInheritOptsAt_powtcldlib) -o$@ visu_lut.c | visu_init.obj : visu_init.c $(BCC32) -P- -c @&&| $(CompOptsAt_powtcldlib) $(CompInheritOptsAt_powtcldlib) -o$@ visu_init.c | visu_generic.obj : visu_generic.c $(BCC32) -P- -c @&&| $(CompOptsAt_powtcldlib) $(CompInheritOptsAt_powtcldlib) -o$@ visu_generic.c | tclshared.obj : tclshared.c $(BCC32) -P- -c @&&| $(CompOptsAt_powtcldlib) $(CompInheritOptsAt_powtcldlib) -o$@ tclshared.c | powwcs.obj : powwcs.c $(BCC32) -P- -c @&&| $(CompOptsAt_powtcldlib) $(CompInheritOptsAt_powtcldlib) -o$@ powwcs.c | powcanvcurve.obj : powcanvcurve.c $(BCC32) -P- -c @&&| $(CompOptsAt_powtcldlib) $(CompInheritOptsAt_powtcldlib) -o$@ powcanvcurve.c | powgrid.obj : powgrid.c $(BCC32) -P- -c @&&| $(CompOptsAt_powtcldlib) $(CompInheritOptsAt_powtcldlib) -o$@ powgrid.c | powcreatevector.obj : powcreatevector.c $(BCC32) -P- -c @&&| $(CompOptsAt_powtcldlib) $(CompInheritOptsAt_powtcldlib) -o$@ powcreatevector.c | powcreateimage.obj : powcreateimage.c $(BCC32) -P- -c @&&| $(CompOptsAt_powtcldlib) $(CompInheritOptsAt_powtcldlib) -o$@ powcreateimage.c | powcreategraph.obj : powcreategraph.c $(BCC32) -P- -c @&&| $(CompOptsAt_powtcldlib) $(CompInheritOptsAt_powtcldlib) -o$@ powcreategraph.c | powcreatedata.obj : powcreatedata.c $(BCC32) -P- -c @&&| $(CompOptsAt_powtcldlib) $(CompInheritOptsAt_powtcldlib) -o$@ powcreatedata.c | powcreatecurve.obj : powcreatecurve.c $(BCC32) -P- -c @&&| $(CompOptsAt_powtcldlib) $(CompInheritOptsAt_powtcldlib) -o$@ powcreatecurve.c | powcommands.obj : powcommands.c $(BCC32) -P- -c @&&| $(CompOptsAt_powtcldlib) $(CompInheritOptsAt_powtcldlib) -o$@ powcommands.c | powcolormap.obj : powcolormap.c $(BCC32) -P- -c @&&| $(CompOptsAt_powtcldlib) $(CompInheritOptsAt_powtcldlib) -o$@ powcolormap.c | powinit_plugin.obj : powinit_plugin.c $(BCC32) -P- -c @&&| $(CompOptsAt_powtcldlib) $(CompInheritOptsAt_powtcldlib) -o$@ powinit_plugin.c | orbit.obj : orbit.c $(BCC32) -P- -c @&&| $(CompOptsAt_powtcldlib) $(CompInheritOptsAt_powtcldlib) -o$@ orbit.c | vcclib: powtcl.def lib/def:powtcl.def powtcl.def: ..\tcl8.0\win\DUMPEXTS -o powtcl.def powtcl.dll @&&| $(Dep_powtclddll) | # Compiler configuration file BccW32.cfg : Copy &&| -w -R -v -vi -H -H=pow.csm -WCD -g250 | $@ fv5.5/tcltk/pow/mhh7.gif0000644000220700000360000054016213224715130014003 0ustar birbylheaGIF87a]ø÷üìÓÿïÖÿñØúêÑýíÔþîÕÿëÐûëÒÿð×üé×üæÏùéÐïàÈüåÓÿòßøèÏþéÒýèÎýõÜÿñÓýçÑûîÙÿñÙÿíÎÿô×þøÜ÷çÎôàÌõäÐüåÇþòÕëÜÁÿíÒÿïÒõíÝÿíÑÿñÔÿöÛ÷íÒùäÇúñÚèÒ»áβúíÑôßÆé×½ÿóÚüçÏ÷åÔúíÛìÝÄëÜÈøéÊÿîÙÑ¿µ£ØŲíßÄõçÉýçËöæÍìÙ½þûèøãËþéËýêÔêå×îåÒñåËøçÓþúßûíÎéÙÈõåÌðàÅáϾõéÑÝϺÿìÔãÔ¼õéØÐÁ²Û˱ÿïÔÀ´›«£›Åµ® ‰Õ˹¹©šÈÊʯ£Šã×Ȳ¿ËóæÊɽ¥†t^”¢ª‘¥µÑÀ«´¾¿houÏÑÍÕÅ«8*{‡“‡yž‹u]\XLA2whT¬³¿‡™¦®®¬ zØÒÅz{zéÕ¿“š£—‰w–‘ƒ_fl­œŠ¢¬±¥±´lz†ÿõ᯴³¬›€ÆÆÉ£´ÂÄÁă›—‡n˹¦q`KQPKž®¾‰ze£”ƒ¹º½·¶ºÅ·§¥™’€kbR?®¹Ã½¿½¤šŽ¤”yŠkÆÀµ›§¶}o[ê×ÄŸ¤¥¼ÂËñæÖ»° Ê·›»¶«Û˹ÐƸä׽°›âÜл­žÝÕÆóâÏ»¨øéͶ¨÷áƪ¨¦óçÖ¾­‘ïÚÆÿøçòÜÀïÝËüêÙôäËÿòÙýìØëÙÁôÝÉúäÌþêÌüæÊþüßóãÉÿýããÓ¿ÿôÛþýêÿéÑýêÏûáÅøåÍëàÌûäÎôáÆùéÓÑÀ§òÜÄÙȳýîÏðßÍüæÌýòÚêàÔõåÔâиÿîÝðáÎÿïÞþòÞêÜÎÿôÞ÷áÌúáÎÿíÖòâÈÿöÝøèÕüèÐýìÑþøàüèÕÿõäÿïØÿõÛýíÝýêÒýîÒøêÚõäÉøêÐþðØþèÎûìÑøéÏõäÍóãÎÿòØÿòÚýíÖÿõØûëÑþæÎüæÎúèÐÿêÐ,]øþ (ðÁƒ*y> T€-Á\( À„§P'8›Juª‡«X¯FÝʵëÓªU½fÍzD H¨;2«Ø¶º†p†Ó#Íξ: 1ÁÚ{œé Ã_Œûõ I"GÞ¸°²å/%RäXQ(ΠÖ 9²äIˆÞEˆ9æL›wGëôÜ“hP¡¶}uá¦N¹†N|8ܸ^“sKõmÛ²gÓ®UÎõ¸\ºuc_È+•/Ô«Gîþõêåf¾¹Ðp ˜dÉ”-ËGˆõÄw¡ Íz´i’tí0‚J0ÔÚ;»\MÌM5mM!á„z–[ìfKàuOY"uê”hb‰^‘ âŠ*îÕW\sWœsc]× ƒSy5œ3½”0ÁÎ`Á/çDÖ›QÁ  ¤’ñÍ7_}*i†xFeGþ™à;0BDñs`‚ Ùàƒ¦‰Û…Ú"Àc|Õq"Ž˜œŒÄÙùÔpQíØ YÙÈŽÜM€rS1¤`@ƒø¢ÄpD5éäe8%V^i‘ì²I!p¹ A_h‚þ .Øà^jÖZ›m`(Ào, çwt¶¥ç°wâéÝŒRýÙU}ÎJ¨wW‘0:ÎÐDÂ=÷¨ÃŽ/êd`Ä/¿Ó`®¹šnº”~š_¨¢64B–§^êñ㥫F+lgÚ Q«[˜¹bšØ¿*Ç,±P±È¢W'ž£ƒ}ë]upéx£™.îB‰T‘àÁ=FqÏa90@Þð bÔL@ºê&Ä®”WÂï@mÀ©#„0ôjø¹šÒ«þ–©±ÀŸuº¦mûÄÔ Ëeìÿ(lW³JG“Y ˵Èxâ¸ñø@Íæ>À°,“ [¢Èþ xÀnŽsÎ Iå}=ï÷3«A·:4E Mïð3`…LÿkÓÓC¹Ó…oçzµ 'ËÜÙÄ¢¶ZcŸ…:ê«â €OÕüBܸÀg Æ¿hàÍ9»ÍÏò!½.øAà ðP…ü@ÃKã_²Ë4üDÀË º€Ÿ™jÚ´ZKиôê;܃ɟ¾ L@J#Ð3ÅJ–OA*4ÉTQ¤Exk>CˆÔÏ'øóŒ` 1¾ëÕ!§Œ,Ñ‘JÍâ´˜-™:øâC‘@0B`¨ _°ã)t h0{è°þGt¨ƒ#¼Ð¢`|8•ÎE„Y ƒ@¸Â¨˜ŒC4L|B ” $8'à‹C倠Št ƒÈ kp|€4 ŒŒCøÅ–¡| oÀà“屄}•áG!¡Q%PN_á…. IÉJRr`Yž}¼N_ûâ&ïcÉåÅ/~œ„H$y1¹–H’ RÇLf@g ÐÞ Fü’ÉFr²BñÌ°€b r\KúM21ÒÀ$ÎYJ`„Š™È&ÎeÕ¡ %°c-JP…Ø¡ Y0:PGƒ¤ úEFTE<ðr¶sˆ(þšåžf­¹ Fy9¶txz€: <Ëâ¨GÅ€+c;²ÉF¦À>±ÇË|à2HÁã¨D!¾0 À V€L¢O’ë‹iX1Vœ #` lÊÊñ€@ *PÛGÔ¢:oy©a^tqV¬F{º`ê ¦Z¾Êq²{‡ªP!ÀÕ®zõ«¨óÆÇ ó) ÙfÛXºÌs<ÆðÆ&W¹ËÓ”õÃOFR¿nk(€ ¾Áƒ8íê¯À‡‹BpΉV«&T´fM†lù› ­,ë€tµø0yÉÀt „"ñG:˜VÔ¡ƒ ¨%Og¹þZ 9­jð%ÀÖ/0€Ù† ÙZKh—œCfFà7|Q;h€ PÆ-jPƒ[(£8ð6žá`ø ¸@dð, µoK%">©µ¨Ìà ¨‘¤à=ÅN§ÚTþú—|Q pT§Ç ›ê‚•úž,zjôàÁŽp~ujS¬¢ÿå/26Ìá{üe ÜòAà Ð`*;’ ¹= %Åã Ÿ|—û RëG¹}¥&¥$F=|“¡ÁŽ½Ë íðQ&%øb¡…q­ÄTÄŽ„Â&.G`cY²)Fx’µ+t²:h F )ªÀ¡þ¤î@1jyG EâÊ XÎh:ãÞ A9ïA_ŒBA̲*’P o$! Þ¨E-ÀÐNXÀ3PQe\ÏpÀ3–  Ô 8ÐSÚyã+%@Dޑ⦲B«AÀX ¤`7˜pwÍk^gxª–…,tºSa3ƒ N ZÀl ·Âú-°@¾Ô^ïzzØζ¶,ìd78 ®5}S %,פ–ž[@–))¶M'Ç@¤U‰•be5/dº>'@IÀyAo(¡¶s&<û‚ôÚ– ¸žË²(V+â:ôEe-UHK J`ì^þøRY܆@ - zñ‹‘‚ñ™ÙøÏ…ÞãG¯¡3J€m‰Ñ¾ø…ŒˆEUÔ,Øà0yF÷±¨€8pÀ€3H€0ÀŠf´Á£ÈA-ž‹R%DpX5†EÌ  ø§²ˆ7+z°Œh‡x§Ö¶é¯»ÝícûWÄÆÆö®]=UV>’Ú’Ì;+ŽÍøÆ;þظÈï‚[Ð`SCÜñÆ… úæ àbg Æ–¡jPÃà–÷TU#ÉSÎÄ(f*¬%¹Ü$ð ø@ –q†Þó~Ù9È5Þo¢Üô-ø€ò—¯|sKÔ9hÁtŸü'HA —oÁ Uþáô€´4`‡éƒOÚ€¼ oc z@ ,zƒ-¨¡i½ìŒG™¿£èÌ}ñ'L j€J 9`KÐ7 à ÞpAà æ ph ´@uTG ´p Hà00h  3À›whÞàhL§ï0>,€ln`Èö`'ãs`ÚãjŠ7{>ÅkÓ#I„7UFUíÃ>ë“®ÔzŠÇ¹Ð„Nø„Oø‚Æm¿ö›' &X¡'Í0 £Ð‘'yûu`L5„VxíãS1¨ ?Ày È §y-p¯p€p« ¯Ð‡7€‡T° ØG O4À|þÌWz¦'£÷ *p}R° ¯p©p7Ї©° {H Rð*ð _p}ÞÄ~œÈ{Ê7 Ÿn° _«`Ÿ@}H‘ ‡ ŠP²H6 =àWÀ{g‰_@R@[pUVcpŒË ˆg0Ô€ ŸW‰&ÀÏ0 ³ð åpm°~€ è @LµÀÎU;à#@¼ð/( ?pýø'ð'pl? /`ï0 üðù¨xeõ^íÃ<ï°¼ÐxÝfSŒÇÉðù‘)Qì@ pn¨b¬À)™’ì° ÛÀ /þ“09“1i`;;  yc Ù¬ð ðÌ€ ÔÀxà )€ ÇV`¹;ÐÅàkІ nø“þ¸•)pÆÆ'pjà Ô0Óø=à ì Ô° Ÿ ÚGÉ èDsxYsA90 µ¦=€P=€ m)-ðˆ* G 40ªðO4°lOÐ<@IàFÉð€ -à9ð g€ J {æwªz¼G -ÀjY 5„FP¢'£ ¸0Oð2€ æ'‡ê–;Œ Nì…)PLÎX:À@äÌ‹]³ »ÆàÓæYÝ`àÚPP`¹°Ê?pê:dÖe£ µlNÉJaÚÓÛÚŸ@•ÃÀ g+˜ì’þß¼ ѬÎk{­ïŒ /͔̰·'0Ó àg-P us†9¬ÐÛÝ­n@ç¡âù›¾àhµ`”P •î7ƒU‡vLÑbè6v}tvêEÒ²}lÉÌ „.Í̼®UZÍM›Ýp ; 5àEPÏ@ÊPʤQõ‘† ±- ð…€YŠ 7Ï üí¼ïÐ;`* ÊëçÞ»†°Ü @ …:£› ÀgŠê–|£ðõL _ðšgh<°¸´3LP˜ËÂúP‘'°ä\åäPåÊ5€ ÷ZзÀÊP PšP±Ðþ np¯`hƒµ:pG@L{{.6óªp`ÞÜa´Œ ú@9ïà?ÀÀ†° ê\³¥[`ô‹¶·èô[ôÖj ´:v[\Xè&ìfz_ðg@ k g°ÝFŒ51hEŒÅ¸`€ðWˆfh à6¦î —Ž&)ò(HÃ4HæBë‹GlE9ôúx¥¾î²ù 30Wšp 3 YÐ’¼ä@ I¿­:U¤¸ 8jÂ`hàY°ŽŒã~î@à%Oú”úK ‘€c ¼£3 Ž7ª œØš¥ù3d(§-tJÀ U› ¯öÙãÃÈÐOþÐTWÊääÏoÀ‹·ÐñKph Òµá@ H€i8@ 5ÐèµÀæì Ãd¢vÄ3ïbm`µû[š´õ° ¤@ ë º~èR@‚ é2Èì‡'~üx!ƒA-I¼åИ#G­x(Ñ EÊ)¯pü€+G’jÝL’“ÇΛ‚! (“¢¹ñ“`ŒH¡`Tþ»¦‰Ãµ[KÔ˜[ DÅdÑ}ýz5¶Hm Íâ†N7Xš64€ƒ twu…üxb@:t`ÕÜy±XMÕÃÃY@6K ÀX„=N욢ËÂMwR™ €ŒÕ¯‰È~`ÁL‹ Ö4AC‘Lôh£ Ch¡E`¬Ð‰r4‰mp9 oj9B%h8—_Áo| @,¢êP ›n pÂ' Z€ ›zX0‚X`ˆ‚‡tAf! ¾úÁ¡„XÑ¥ VX@Æ cv¢r§x`àA*”ø j¤h&_Œú2‰|ñ¥–$xÐàÈþ`d …’$5P›FÁÅ›jZ€\–)„¯Êj+ŠÙ†j¨Iá±mXaæ—Þ1à^xU–X^Xy‚,iCpü°†&f‡?žAœ`Ù‡mjè–šÑfƒꈤpnñÃY„ 8à`–rn©†xé!˜wœ¨+€bò— å%riàš @'{àF8 .xç.h®º¦Ã ¸Š£Ž;Y<B–ŠáÆ^^0`Š ¸óðrBAÃ%`&€$)À‘™m´ i CŽ ® 嬙Æ4"#0n~Æþx €VPÇtX€Æ‘ÇCÑÈyâ´|aÉeSfô3h›m6È%XôË… ²ï‡"!`å­?¦GtÙæ}rÂoH§Z|Éé¨pyÂQÀÿ®EƒØtN9XÀ›s4@@$ 8à.Èé£.ÜÉ…¬ 8ãx€T+†œpˆL·ƒ s‚q[¡­Yaˆfbæ‡n‚qÂHÐð .ˆ!–!:é‰c†@ÂBäC‘3jPf–|¨ƒMä¿P™!BtÀ©F·[`8Í YR‡™œÈÇÊç]R(Ð`A,ª¶ l€ h2þváœçl£ËsŠÁ¯†ÅèÁh„lƒ} x€@p¨Âµ¨†n˜CG@‚‘VP‡Ý Ùà‚ ±Ž!ø€ \ð0bp³8 6WpÀ:Ö"˜@$í`‚rð eÄb3 ÐPÔA4ÊàÀ3hÑúˆÃxB(€@Ö` €Œ˜A2ƒ$!™î´aUÄm?È[ÞBx%0p‡À4P ÌäoIx@"5À¸7Åé(.P€täÞ@0À€$€(‹Œ àðo à ‹ËAê`£´@€8¨Ã ñƒûÃC¸Â4þLeÔà Ø€2,  Ì`‘ÈB'…& #Pˆ+†PŽlpìf‹¸C(ÆàÃÊ@…"Œjq€ @Ç,À! `\¨@G 4mP lÚØF ‚p–mt#cPª‹4 ø2 <É‘ ^ÐÅ¢ÏÙÚÀ@S€ ¦Ð|ƒÈé X°Ðâò”*” _ÔÁ>pC$bŒ8¢… á¥|p± !‡ø†`rCKXEî‹D"è8…B1 T` xÀ„y8 K(ÂÜ 8ÀäãÀ-hñŒk8€äËE†Ñþ†r ´8Y~V‡ ‡\ä"ÈÀÑŒì€ø%„!AÆ n2YÊÂ) ¾Ý¡°¥DAò(<ÈÊ.Û¦JÊé h7€º\Î`@ €Z<KÞPÂkƒñ$A%2€,}47'°`u8Ä+’Ä ¤—Qƒ)` CX¡ ·ÆÐ SHµèÀ‚#b0„!8" XÂxÑ HŒÁš¸8¦e$D!‹èUäêt<õÖš*nŒˆQŸ~("ƒ Äâ³ÐÄ^ÆP Þг(àoÈ ¯å#xÇAXðŽ÷ñR/2†1‚P x­8ø„1j ,þrôŠà@E€ÎH ÐQ²@H¼t‚-!0]à¨pÄ,"!CˆA6 tÍlD ÂȆ0\±Žc  ‘D FaYôê3H€¬ TÀÀåx²€t b2Ì€2Á ÐÛpáp† ¥®ÕHmÒÖ,@XºÕm!N`S¦3í H &FyS–Ù7£¼¶@¦gÉ<…0Ôðö|ŽJ É>{xc‘Í°‚‡„» 9†ÔÀ R‹o°@Šˆ(áôFÁ”…R=!Šcdb‹?lÃ!bÁ…% A Çh†p CþD ¤€Á<‘€ kàà7+Ö€`P÷¤X!tƒŒAÈÆ– t, 7(GpÀÏ6è>H€&BSÒ‚^¹˜E`pì¨*`ñ ð(´±@E6ÖkdcèØË4`-Üœ¨à@0¾€$¸[ÂÐñ|°.ˆ°À ?øÅ/¶Á ðÒ ‚Â5¹Ð‰tbMˆ„„ƒCè4Ù@G ÖÁm90Á/šÀ€[ä*Œà€–ð¬1@"kàÂ5ü }€ ÄÛh@5Êq tT„ˆ â6V°ÂÑÛÀE¾A:ãF¼¼ßŒ!"Ò“þÞ#¹Š¼Ñ&8u¤ô:€)U]Úã ãpr2€ZpVh;ù\ëg[ Ë`„ $ÜÕ!*p‚¬7é6¬ "Â)ª€‡SHà \о':! hZS m¸„áˆH¨ßÜÂ8Eä߆+Ì@ÂØyînGh Yà€r…Hpƒ6@9`¯C0À;¸ö Ì‚u(B‡rð„6X‚ 0n¨Mx(/R<2ú9<†u˜$p€PÈ`7kˆ6,aNri@„E†X D»k@…i†$8Hhƒ_À†hƒL(Ànø8X0„eÐþÇx`$°4†((‡´“†X€‚;¨a°À60tcˆ*ó$`€_È)ø&P+¯œ³+BŸ%ƒC8„,€r ‡(.]8}€€(4ö0HLé‰0ˆ,l"±‚Ðm`…I«£"ùXHÒ+½jx% 5؉81 Üb% €œR£$ÇyXƒ°_XÞ#€ †0‰Üb“7©0 ÅQqЬHQ2 I+ÀfÀ¨‡xEÀk0QÀƒ,ð!0èÎW¸7((X„C…³ó4¨‚Xp„C`ž(È‚äY…C(‡Yþ˜M »BhRø™6@lP†/p0„+x†/ƒhH(‡(@O†P „PX<`hÇlȆ;ˆG¸A‚Y€9¸7È„,h3•Ì˜G?ô65¸KÀGP6aO(¸„*@D°„*˜ƒó[‚u §yЀ1XE(»{‹HX3î¹R(À3ðeØØj9P°Ú°*AŒ<nr4aP¡Lp7@;¸p ‚L°›AH`Ѓi0Á%ˆ‚18ž¼ŽÔÃè0€ €+Ѓ,p„iƒfàC'lဠÛl™Ep·jh¦þTà 8Ä[‚1ˆ ÍÙ´\8ƒ1x‚y˜P†ÞT†"˜™ÂxeH€"°kÐMÝ”‡Õ,‚x„6hyа˜‡h†WxPy@N˜Mx‚Z‚OX¶°j¥n¸‘!ÅÀ…áІ€€``&°‚+†f°„EK°lhEÈ‚&ÈK€6Ghƒyt„õsl˜78…9†;€¸‡eÈ„+8qH…W_˜4Ø"˜s€Kpƒ' ‡Ê(°KTx†·ú¹Xˆ‚C0ap8Cà‚r°„Lˆ`8` 2à(<`þ¹¼4P§6ˆ„HèÂR4`ƒHoS„Eà‚.ƒ6ƒ¨‡¥QCx„›È„C*0@a8†,‡1h³iˆ$ØÊYK°*4Àƒ/Ui†9@J(‡NÀs+@ÀK‚E(I@ñúÔq[…ÚPÑ íh*ÀgØ€$ÀШeàTOX„6Q¸5@ƒ6pQp…,Pƒ;È„*ˆ‚(€0X„dÍ‚²Ë²,H8E@W°†u°Éc@‚˜†+ØRñ³r(R.Àn2,xËX¸·6¯U€lÂ,sKh*s…lˆ‡ÓQˆWþ˜G°„-ƒ= †58EX†«À5Åñ´ŠX ‹:02f°f8¶è5…/‚'8o0jX `”Up, „;˜OÈ„:JÅÀPà:°„Rp `ø…¨J(†5x 9@ƒ¸ÃQpÉWpƒQ0&ˆ†+pƒcÝT¸†À–˜…cEkpÐ(Sˆ$à‚LE(@i*@„,Àƒ60ÒCp…½X…QˆR EÊX·_Fý4 oè“Q’H@ƒ$€qP°_.õƒZ„(È„&€‚²cX`hƒo´‚HÈ\0غÿþ.¨‚6ð'mõ³,ˆ,À‚/¨Ó;X‚6ˆ…+ÝW-Ë„EÐ7ˆ@<˜*Sx¸g‡ †™b€,PC0«‚R`7·í6XÂCX„–UƒH(À‚6°Gð5àQPÔ(Ë„/ðO808a¸Eø`à6lX×l°Á*p5`li8 lƒSøRE.ˆJ†H¸iÀ†lp€‚N(‡Ž²ô/ó„;(‡e}R *…8A¤Õ9’:HfÀfèd H€hQð€F€YP"ç±$Xöcàt75…Òµ"hþ*ÄO) ‚/ØR"0‚Qx„Úp‡ø4P·&E kà€iH€X`¹“„„©žu°¯H8†+‹‚iBèQ[JP`<8`xì*pmƒ0‹‚EX‡t0ÂH8ƒB_ÐP‚(€+@ƒsx+8@øh½S0ƒQØH(‡c¨€iWp¸›caи­‚Lð6¨‚Nh‚6À‚ Ê„6X‡-XBN-@a°™ LVChX!†Yp· #8ƒQXKxQJˆRD¨J8„(†6È‚õCƒX(‡E¸³ûшB=°„çKˆ-þ¸&°†h°/9XSXm˜úJ°É½à6òÝ¢lØ"Wð^ê‰SØ‚Cð„ ¼ÖiŠ… žN@ƒ:Ž„% Õ$­®Q¸‰xNûˆ¤8€…0‡ªKx¶¡æó ¨‡‹x:\¨:'}°€ @…Y°0k¹†Yñƒ%°°éæ*¨œtÀ$ÝCH)pù$€Z )°…†/X…GØ‚ex‚Bp*0…EÀ7‡PÉPÀh…„ÆDS@…,Ѓ;pB$à3T(ph©öP„1Ào+„[@-ò4°„iPÞjFæ@ãGø€8ŠÞ€_x‚þŽ †WÐ")øƒ»„Ù”‡f`{)ø‚v‰„_8ƒŽ±€B8„gHÓU ÉÉ­ÕÎ]\@ƒðƒ„QXƒ6?€O}†psƒ૬†,;=ð6Mð¢{‚8ðM¸´´„CøÞ1\¡ u7X‚/]„ …ª\¼Þ1(RØk›ù‚s`‚3X˺Ո‡rÀ#D‚?ŽÐZ…õƒuPfEƒÞÕnRà˜ók WÈK»6˜×CÈW¿–M«À…Ž%†=†ˆ£H:ÐuY醂Бi`†´ùVð©nN‰«”«XþÝ~„;…* @@@e‚Pƒ€X&Á…è†ep\ð…­ç9a˜†c¨pP(rR…¨€° 6qº•¨ƒ[PUcºCèeH…6PØ4(„ (~´eh7x…O m0ø„O | ¥È‚6x_øE€„7‚¸+Xƒ+ƒ5à“B±‚g+„BR€RPExãõ7hoXƒf)@H„e¨…oÐ¥zhm4¨J'FƒöHƒJHSRзjg‚ÔÖë:å‚x6Sh†ƒBƒL…kXhºHþ0MèÝ5(‚[P+¸™Yð@°ªUÈ„'ø…ZW„+p`RÊÐTHíE¨CXRN-D$ˆ9ˆ…fX_R¨׃*z°" ‡"¨ó6¸h‚L°mPp…q8†¸ƒ`j …+„U,H2Ÿn2ý°q?â Š€ ȇ\è Xˆ\ȇA«Ù®À…\¨K#…J8@p×,è”c  À?`a\І°'xø†àéH…œÇQ (BC…XÐnÐñj €q¨›º©ÈÆÿUéŽm8ƒ\€r …ÆÛ€%(ÑþH0›F¾JȎЇ„|¨…€xvø€U€™x€}0`€`h€0€Ha#ÈŸoHè€n†:0ãg~@þø„€fY˜‚p‚:˜O ¡‰)@C¨‡aF‚Ÿ,ÑÐÅ„l¨h‚EXƒ˜YXh‚«ƒBˆHg I´,=€µðó*Ò O ½ÊôèuÜ<ʱÂ[mäªM$Hk¨eA£§AO‘µðqèÐdNrý€À,W74Š¨4)4&Ú9 –})TiM;#-¾P]¦¢Ö‚ 0þ‚̘!û¡KdÛ(tƒ-«mù–-Ë×›ÛbÚ‚XÐé„Y¾ã¤üˆÄìÛ/\P†@9¤ç9M3|£"V5nXa!Ë+\¨më¡Ì¡H3¿XƒœäPÑò‘€‹`¬†Éêñ«GÙn ÈÊGU‡ Xôð+—X~r%¨³¡ÛVÌvÈbÆŠ_ä¬T¹' ‰’Ôú0_ߌ:Ço? ¬Fì:ÑòðBÍ…×Áö1Ã,õ-#KÌ9±L7¨†´É,°çÍ£(c :ÓDaE¨Þ°Ìfªjà )hÆ ×߶ *ô4L ¿°ÀL ½¨ÐËGLðÁ4ÐpÄšÉÐðB ªŽÓC €CSC 5ôP¿ïÈŒ.ô`¿N¼#€.h˜ ^0ðÁ(^´ü/RðàA ¾ø‚ .ðþ€¨€ß¡Ì  (`A.5p#+ÅÔ ^©Ç 7?°ÒMsRM>¬ürF*` ‘$©Ìr ,r17 ä~X9¤ÃŠ|X`AÈG> Y¤*ÈD&< kpáH fÓ€ $ È€ÆX~Ðq¼£߀€"ÐPˆˆÌc “+ñ=@‚·aÈ: ÄìbP»? P n¸I!T€ø" 8@-|¡^`­˜ÀLSY1‚ø1V°¿@†4Q„"tCdEîÁ0"&,a².8Œ@ŒêúEý ð $Xþ«Áh Œà s8WˆD&Ð C ðW @|p£Ȉ Ù ÜäRŒ.`‡€#Ü#ž“ t`Ëdè`sÁ Xà^èb-èw~p6æà |U>†a¨ ÒØûE%Z@ Á ’7^a…-ä^ð€À€@ˆÞôÚâ½´øIõPÀ\šmÈ"*ß8TÐ d%AàF3-C,i»éÆV%…D‚ u€7¸‘€"ø€ m°D,f@ tPà}˜ËRê׃HÈ€&0Å„/¼B‚r·`þÀÅà€¶¤%¢¸H Tõîiƒõ(ÝhÕ ]lC-ÃùA7œ`ˆWÔÝhÁ6¾õ:¬(>xÄxð\äB£@Å"ÐÀ…NtÕè.´ñƒŽãX`ñ €!\X‡5\фؔ㨽*–‹êù,Û`,pft¦¼=1œð‚Cf m,` 6²ñnöO2zR¤Â €À… ˜çN-àIÈ’à bhçf2XÑ]Œ`º….xÑ|¼cºø/‚  eƒ†˜Æ< ^(ó¼=F@0ç&XApÂf¶ Bmc ¤þÉ!² Œ% ¢¯@>³ ´h€ðÀ¾0é^ðhVŒ2ËبG†?!…¼`§ƒ& Aì`(X‹¢B È/iŽ*š|C ò Ь.ð@<@˜Ø‚/´@-xƒ€“<<ÀÛž ð1À˜ƒ(@8@@:(Ãp<ƒþ5,pÌA9XC-(¼2`…,@˜ƒ2ÈÌ8 Á,Ì‚HŸ@â,4-À0d Û8àB[ùÂ-h‚5CdBCÈÀ(ÁɃ7Ô>Ô,\â-Ì@Ü@âkÀ€5Ì‚5V7È‹Á÷¨žêylȃ/ì¢= À;=t£ôÌ*¼*Ì#B" x &DÁ"Ì@5bÃ4pÁ4\A@5:ÃZ@ ¾ €Ù[XÔ ÆQC à,°5PÃ2ƒ78¼‚ŒÃ'œ <5¤¨€dAœ‚c”C\4A¬0d þ.$2iÈ‘ ˆ@ UmùÁ(¨ 0Bœ *¸Á"ÄÃ:Ж€×5@XÁ, ÜÁ"4Á*,:¬pƒ+ t‚œ‚4 :Ü,‚XÃ<ŒC¬€:LÀ xS˜@ dC,@ižDÀØÂ8€ (Á8xü<Àz`ÃDÀ[pC5¸Tˆ@, ‚ˆ@¨0…BúÀ<dA9|þÜ(Bàhý݂º‚ÜBB°VÌ(d‚`ˆ@9`Á‚%P˜B°A$p`‚Af&О)´€ºt¯=@0€ËÁB‚ ÁDÁ ¸0d)p&\ƒ"@‚ÜÁ!¬ƒÚ)ƒ/ð@xƒ H <À€@Oœ2‰…ØW€¤÷@À2Ü5ÔÁ+|B Œäš* ¨1PC!Â+¬ÂØomIÁÓ­Á•ÔÀMÖ_ƒ/Dì *ð´Xƒ].#<Ã"´V‡ÂƒPÒçD±¡C„Þð³8@l6X |&B¸Â>g‚ðu,,A$˜ÂÙŠ¯"Ì€ €käÀ€A4Á/þä€ÜO$d€*èÀ̃&x9¤k(à d>Èà #÷t„ð^ Ã0À8ŒƒÄG X·üˆu;'(ÅÎh ¬MQƱ)o,ȯ#ü‚ Ì `ƒ'”á®©Ë Ä-\õœ8 lá"ø0ð³6PÂS  TÀ:˜à!à34õXŸÄ" ø!è!ƒc‚_ò„B*²&BÐB,,‚€Á dDÊÝ^C,<ö Üq$Ì0È ¸A9 ƒš(b9€ÁÀ@BÂÌB&è5ÜÂ-,ÀœÇy¤UÅÙ6îØÛfȹåVOª¨22ƒô þTaû C ,H°Ã=°ƒô@„€Ø $C„€ P»àÂ-TC38@3l6$,A9À¦µÐB €ƒ20€$Xj#A XA$\fÁ"€(_]îB‹cPÁôã!(‚´ÁoÜ?Ö»%´]R0CK‚ÉðÀ ”ÀôµXÁ*¬‚:¤Æ/*<€/ØXµnÁ/‚!”CÄKC6p-AÇ.ÓÆ@(`x3´ÀÐ,m-XA‘EBΪæ8ø&ðã!Œp€…¯ƒ0¬C6\´A4DÃ#!04%B9dƒ€/;"8@º£þ‚ºXö!ÃÏ‘z(C épá/è)pz.„BÜ‚FBS#¬]€:ÈÁ!8XC(”Ã,€Ôõ!¬ì»Gcâ"=C6ÐV@9B‚!;€ÈÁ ÌÂ-`´0T€Á"”*´)À€KÊÃ<ÀÀÌÜì €àúãxGª,oÇN\p Dmƒ >öÔC$Ãu9{odÀˆ¤@oì‚6±±Œ$@ÏÂ: 4¬7À€181ˆË¤@.àB ÔÁX@=äB3XžÄ@©ƒ«[m–Q6‹”°[V¬ÍZrmŒ&Tr¬ÌŠ„þÒ«H‡*YY†æP=†*µYuξ9VµqSÌ+ ÞÐDò¦$Ù‹`éi£HεWh¨ñBsãF¤;àáÈr Œim9Š„À¡+µ¼ý’‚¦œJŸ’¸Ô¤ e2VÊLÃEŠ^ݺáÈÓ0¤Ü¸Y“sM¦C‡ -*ÉÊ äÉ«Å`L¡Lg´i€œCk`àÍ—¶nŒéút(µˆaÆ‚®:G™iã‘]dae^¨Á”5 Á¡ŽBÚ8!„WT0Ä Í D±,|F,4aà o"yÆ©…‡¤@À–`F©$RÆù¦2¤#‰nÆY&•HÀ€‰ìþÀå ØùÄ jhæŽ%žx’3V¡†4¾ÈÄ @ Éä#|ÒÁ‡¬O>°@‰$pa`™HHYæ•”pè5nW.À@CÄ  †EÐcZ8¸e H"YåC®pÃ`ÆÀ ‡P¹HŽhq$&7FD‘;6†k`p ‹B–Ï(ž±9q¤ˆž "“Sà!‰( €! àVdå „™Rø+ýäŠ+>û„jèOz„t9aj@`á^XI„)là 0 iF*¬pä˜u–€YÞ@YøA  ÈçwN^:pbþX)„wX(†Ÿ|òÙ tfÉ…–`i`€…ƒjÀ"ˆ@—sg…¦8hdÙƒx!!…]zÀÀ³U¡ƒ :0Qòa¦(&… ÜF@Fºq¢\~°Efz€ÀHâ•~Y …‚9 @'˜dXá’gž+“@ƒ¹ˆ,T€L 3j°`l€b¹‡î1v(áÔ` îÑ‚^è⿸Á!Øу`à‚z¸À/ !$'X ž[B5bQŽN8" C²¡‰%,a€ à$€#0ˆÅ|®bÚÀþ.> Œ$Èc8xSti³pàƒƒX€ã0xÆ5H hÂ×@0B1DTÔ@-XÆ#|Ao 8н¢‘0AL‚И ]Àâ u0+pð H¨@Rº0„ZR¡Väï`+ºñ'äC?èF ‹y­¡gh€1œ%0;èÁ¦ÀŠˆ-Qï(F1Þ±”`ü ÇŽY¹tàp=xPê0Äj8 ÜØ@56ÀÒá»ØÁŠÁ‚œ Ê A € NYx²˜f:0¨à!ABÐ]€@™ßÈÇ8œÀŒ)Ð*0Âþ0ÐÞ,HA/&w¼,´µ`ɨáªüB2p.ÎqŽÆ¥,Á Tp,ƒ¬èráfŒƒèitñ´À ±`Eh ÐÀJèA<Ó#èxR(D%XÐ#¨ yïHT/ÞQÁÀ"VâÀBà€c ¡QÂÊ1 MÄ¢ÀÈØY9À$\ã8G0HAhp€4c dBÇüð pÐbà€ÐŽgø`KЄpYpôˆ-Š ŒdQch|Áƒ ²CE{Ò ô ]0#Ô FÓt¡ üà`þ´ H‚¨8¥daÉn”OB:A—HÔH‚ ˜0ƒ;|! ;€æ.: ‹ô@ ‚z‹Ñ Ä—¢²(Æ.Ž‰ß÷"€‹ˆÄ"Ðorƒ ÈÅ5¶Áé2ﾜ|‚{Äw¾(+7_ L ø¼°ƒ‹‚¤@ØAåìÛÌWséí¢<€Áy€!x¦ ßZá `À [_ŒÔê (R°< P³îÈç„8.=øTð€Ã`ê=z $Ãg8C/z¡‚ L€68Š ‚-烺q Xá}üÀݨÒ,€þã. AwðPaWh ™E,‹¦%Ü¢ôàÁ¼‘„(¡Ç.È@ F)øa¡p8 p„â~†š@ ”Íâ·8Ï-ZV0˜jñØæ@ .ˆ-€àsÔ#B‚,° '< ÒË3.aV­= ²$Öp¦±È…Ó,Pr#ÃH(+€‚'ÜC¸`š†fð€Ð,ü=bØóEo|-|LõÊâɲÁœ RÈ„Õ( \àkP@@`Å=0Ì üâ3½§ìÝ'* 7€à”æÝ…xa€b Óq2OïÌùþ^{²Û¹HErAT*¸È €9€jèl h(Ä* Q ˜ôI!ù.˜Çð}z|Ÿ¿;¥ ~0 Ed¢²?Ì+ jpZJpFZÐt4 Á ¬ÙÈ HIÊ ¦ ? F> Ë!'$¨5(Â-P!8  hÆÀ±YÜͨ-ÀaÄ` pðá 3\ïi£kP,6 €zÝ€…1Îÿþþ¬†ÀÉ€†/¼ ÃYˆD,‚¡ßTÌÂð©’)s.l ,gì˼.Ç«LɼX  ÖÀ`ãÀªáò¸¡N©lǼN€§ŠáfŽQXÁ AwÇ ` ‡bŽòáÂX̾ 휠( 4!á^ª!È! ¬¶A(@ @ ” d`n ¾àx`$Þ–|©ÄÜ ¡XAwxátaºáÐ ¡ðŒNàvA ¨rà’ä AÊ/!°Á¶!6€ŒŽ¸!¹p¡ïi6 ¯Â "!:þ!bÐfÎ ŒÈ²N¦÷~áxÀÀà>€\à€4`K|÷Dq€ Ͳ`/÷`¬`À¬äá|!±Î@ `ùšiºf Œ>!RΠ„ ¤èÀà ,@ Œä®€”á6 Œn¡ˆ|±Š`  ta @Š ¼Á °A~€nL‡AÇ”ÀЂޡ¦x¡d¬x†¡€²àp c œRF7àdR€åXÞbòˆAz"^ 2áZÀB  ~ €C~þªŽ©. ¾ @òÁ8Ç4 o ü€`¡äà Úà ÐÀjapá ¢„mXa¡NÀ’¡$¨!Kz¡)6 Ú€t ÄqTA h@tÀTÁB`Ož@ Ta¤Æ²²®A+sáj Æ rÁ :D°I”ÁÐa€ 2¡Àfà®á@ǪaÑ\ïˆPÜ€€5dà`2|aTK8àô dMQò2¦²Ð(¯`x*«j,”@ 4à ¨¨Ñu@ @¶aiddð¤¤HáþnÀ¹˜aÛÖ–p€ AÆ€¬a”¡Š9ýÀ5‹àðä!~AX`Âá;Q†`ábr!Jšï¤ï ¤/ŽN˜äi(À˜I$B!Ú` üM| 6%Ë€؇ÀjÁ¤¼Z p¡ Þ‚Àé”!º6€/ƒjàÙÈ¡JtÁFN`x¡¡ü`rŽB!ü 6à@óÊ8QaùZàÇjá Ð@x@ÐWZà’`’€àœÀT¼# rÀ` >àºA á2u`´è |aê‚þAVA à%xà¨á¦Nf@h¦á,âðÈT«!óR XÀ‚¢å „á²Á_ÏàÀ³rÒ& óTU ¡°a šÁ\8Š \Ó:qo:Š(ö€±<‘À¤<*Ë×À¡fÀ’À¾`¼!<€AŠ&JB´!p¡HazÀí´Áá·,ÀêÀ¦¡N¡:¢ @8s "J ŒêÀRa(` `ýpraÜotvJUdÊLþLÕ⊎P¡|¡´a d€–V@žü œbbhApoÊ¡â”ÃÔºç’Áw^ œ ü öÏÌ‚A‚í~ó`xäV "¡’`Ü`'4€; ôêÍ”|à 6q?äABCÊÁáÁŽ~•,À@|Àô d`ùÀ”¡à äÁ:€ ²¡cŸ!2a€ ¦|àXÀÁÄ f  ô –ÑhA:PÆt-Œˆ6„!pÏbLÊÈõhá¬8ªzOÒž²¦ãpÏ:c!þná`JÐ7÷”Áüt¿àÚ•ùlñ¸@g絺–Á¢,J®`€qáA ¨œÆ (¥  àa®€¶àáÆ€ a„á=ÇÀf!®! îÀ¡$„¡LáW­à @&õ5½ƒ$â Æ@|` ¡háš €€¡ ¸<¡ ¦Á¢ c­„a– * F! *@€* €a ÀAŒE¶‰ÑÁÖ!l#LÓ°€*²@5 r€B@ öDv P³t—´\á`bÀxý nA |Áb ã~þž`4À4aÆa8 ¬!’8ü€ ¸`i‰€(¢`…!J „ÁÀaž ŠàÜ`<ª¡Š` b”]ANaÊAÐáD@|D²Á«OÌZf!—MÁ¢  ¢€híª[ÉUö\Óhò4aPa¬x”3cŠqº· æ1òjíW`ü€NU–¨r°ܵ@¦MA&Ä ´AkêÁ{˜áú(Ç îBê`t!Fá a~á ¶ÀFá,áÆ1€} xС A Ê×Á,ÁŽá@ a Áá ,ábR¯¡_„ÁÐ ¾`šÀ$ÚÀ`ÙÀˆ L‚ñLÁ°  ® °z(š@Ú ba\ ÊA<² ð¼ V¬c ža 4@ˆAþþ¨  =r¼ËÛÀÐ@ ÖAÀ³! †Bì¡´¡Á ä¡.Àà¾AÐ “WA”+è<ÎõÀW‘`Ö ¼D ä† Öá fÆa „ÚôÀhÓp@Ú` ÆÚ€ÊÁÚ7 ®ÛÀ  °à¤ |ào ¤Ý[L¡BÛ`àAB¡*Ëü` nàô€Р¦A<8V¼?¢ñÆ€2=fA* Ïá:+—ÀÞ› !îèxC6q ªaÔådÀätD-T€( !€–AFV~Àš„H¡Tþ^ἡVä€?¡Ô[¾@ Va fáêàž¡·¯!8BÐ# € Lá-ba2A(jæ@¢ îÀ"A„XÜ b!,÷†àô@| 'Ê¡ "á üËÆ áø+Ä š æAˆ€‰EÔ  „Á¿Ê¡bÂ"ÏEq:€HàÀÀ ¦Á)ŒÁ ¤€ü²8 p š 0Öž¡ÊüΨÔ$ ÐÀª!Рª£RýîT,À8­¡:àì - !¸«õà|À "á @´AÌá`T Ì,AþÚ Ô¾ D@Ð@y'Hø¬PÁv-¡ Ä% šB\"Ö T­|U5+7|T;†œ;è` Y R”–h…: -¨fݹãÀ›1ÖV¢eÍšG¦ÀÝÈdj–¢ÀfùYäÛ%«ÚðÅc¶A€B 3Èt99sƒÔ«Š^Õq’bª¢Tcê¤Àñ©P¤OJT|ZF…Š*l¨HÖöÌ-n×45\”Ø4ô;¤(—(Cb@9…ÍQ¤L‹Ê9²ähI¤HÏ4ñä&“=¡f]›æ¸rm4!9”É°6‹ô¸– Ò2#™Ú<ùÖÆ•þoFÚ=7á š3ãôd’Ö°Bh€„@c@:{åFŽžH©~@j“ÊÛ7Ü…<ÈñëA$0ŠŒÈÛ£‚¡HY¬Í ºh„¥@cÅ8h†Œ¤ ñ ,,5‹)‡ãÀ!nÄbYFmèAJ$‡¸È!ãÍ<‰"`ürÎÖÄÐÆ\F,‹ …+\衈%mâ@B~LsH! “[ŒõÅØ †ÄR 8p Ú" ¡‡´,Æ~¢Ç5àĉ"dâH pÄ)‡Üa…"‡†!!±]$±\ƒ™zÌ€ 83ø’CÞø²Ì! $¡ÁPÔþÛPƒ.ü @g¤BŠm’ÂB7)|òI*8Há•!Ÿ¼²Æ2ìÀ¥ÂÔôÂN ÔäÂÉÓMÕäÒ9¡,ÃzàÐL,Í4£G±ÌÃ1uÅÉ"£”3Ʋ™6DI$u4)òàòË‘ áõá !0Ž ‘ch ‘ÊþB€¯81NItƒÏ7 !x Ó†%_rÈŸ´*°b]ËDbJ9¨pð‹h´ð‹- ˆÀ7À‘ð±ÜRŽ&Ý"áCu€-rp†g8aÁ!©ð ‘ ¾¤H¸,ƒ†Ó  ‘*Õ¿@Rþ.€øÜL ÞÈ@nDò„ ÁÔƒ«Üц"M8â†53¬ƒ‚c £rË,3ÌÉ>p€)>´}ÃzÐCå Ñ:M,Ì"‡Ì )wÌC™ÀðòŽl;Ð# ´€ƒÊ™òk&ÈQŽ!z°Š%ÕÀšQ$€„0Ïh@øÒÂ# h0@ .MÕ¡.°à” Ë0óRº@  ?8‘= PÀ õÌ@Ë,²ìD2²œpB2'ðÂþõ5Ô €QÝlƒ‹ØÔ°M5l yÈàÔÀ° E0à dð„Ð#½h3 @Pã8Á¨1þøÀu0,p`?`ƒ+5€E΀ ~ù‚¿€… ô!X¤@Ý` P 0XbCÀÂ*V±… `„–!‹t²(ÄL‘‰Pl#©€@¤ðRàB2(À(Ð …Œ#ÊðÊ "ц®l ¨ñCÓÆà1)°àRh(DX`D f°"VF{…q%„` ‘¸Üð„Jp ŠÈÌ€€€þ@"À> [´à 9øA ZµŒŸéâ ^©ƒÎðŠQ‚8̨Ã'p`¤àÔ°À^€|b4 Át ,ƒ½‚,2Àð€µÁ/>ðÊjÀgXÆ2Ø‚Z<Ð))Há¯G‚{? €6˜¡€e úAÆ0r¢–XÅ3~Ù Z8àQÈ¢€ƒ…¬BWÀÆ€ Zhb óÒÞfŠßB‹x88€ƒl* …) ±R b$àÇ~À‰BÔ³9øÄ@€ƒµ@7Z«¼£¤Ø3´§ £µ°X¨ÌñIýþ€Ãx‡ùÞ€|0™!•2+ÞwÀ/ÐãÇXaÐ#ý Ø3ÎVD€²l1  å Ö ?€À ^„4¤.`rzçw°¹øA>‚Pn #È4Sr¡ ô ;•0p 7{h@;üàLaÅ(/` ”#ÔàG˜ñ»$à¾X.|QˆQÀý´À;ò±ƒoÐ#¬?¾!A@ÉÛÆÌ‹0#,03~AÖÁÉp†3|Ë–„@ :PB F¡‚¢jà2@” @øâµpB2"`> NþÑ'P*TЃ àgH8 R T^œ#=Æ84¦Ã¿´H3À1 -Å"À( €Ñ§“ 8j‚0²¹±Y ár†n¡ a !3à€Þ`0 MøÁ¹*ü9TBŒˆ1”ã~þ“¥GÁqM)€j(è@NA¶‘A^” 2Áì¯r#ȳóán\¯°ì£*/zpYx`;©,F€)‚­*„ x~Pƒ}Å€–™ñWãØù3ŠÑ|460€,Šq~D^(Fßntcí«/ò!é\0ƒÎð‹:|ÃþÀ… j1<}Ûg¢­ÖsÆu#²àÅ p)PcØ xE$TPjÀÞ0À;@X=ÓïÅ`E«óуÞÆž.ª§‹ìÕá»èA2Žpv'ÃÉ Ap‰›]Í0"µ€„ ð< ìpÔ° ‡p½Ð{w;@°Å 0yhôÐj°²Ð¬PÚ$ š Ò4 ÷áÀ@ >€ HÀO¢ 0Àp 3Í Yà5ÈKÀ‚Íð H0 à` 0€×p r×Às¨€À «ð e£2 °"b ¶pþÛÀ ?àÈ@)¸ð ¤@ )0)¬€ ¤€)7ð ÅuÀ € ¬€vßà ²çVÜÅÀpØw&x@À   È =ð mp6`¯p0p»ðy°× *ã ÈP PN{õ@pU F ’wV $`z„{eÇ Ü ˆ¹ gg -p P € ^p@;!Þ0¾0 ` ïP;ÀÓ€ä R¤ sO@ ¾à F<½h{Ç@0#@@zÚCW¡?ð~F_÷-ð=ðÞà :þ:ðJp%@ àÞÀYV Ò×  Op90âày »0‰= ˜h#Ðj柧ÞEΆ °7:8 Õ ° K0 @g Ï€ Ï Í` ràÐ8ÐKù ™âV ƒ¨ ƒ÷a :—80Õa~ ,‹ _3`&³ 8U gpðŠ"Ð æ`g…pX?V *ÈpQ kÐD…ÀÖ ÜÀ ʈŒk×Ðn÷°†t‰¬° ;p=€Š—8XŸ²0˜W§ØͶ­V Èxvùèh÷y˜·hRþÔ'EHÅÀ °wŒ!… ) A`‡éà P ¶€ ÁÆ JÞÀ¿pXK  Œl¥ Ó€ ë  È¬ #«ŒD P¶€’º‰yÀ ~û ~;>º@46õ©~65) ÊÀ· ØÀÕ  Ø@5@ p(Õ… Þ@ O@œ5Þ€  -pPÔj¨X ¬ ²Ðx¢ûÙj$à}ºÙ'¡`šP ~Y/ŠÀHà6È/_2“±šp_|&k06‹`¦Æ´p ó‚+—Ž0,‰£³ ½V þR`p2Ð;ÚÛvKñpÔÃR1Ä àË€,ÅP,Eº <°°œ—Ùk‡Œà˜‚ôgkÀyì³ åà wR@p6 $0LÅ ÈŒØ,àvÝPùðÝPz‘—ø‘‡y7i~¯j‚,~ùPA@›‡>Ì°€Ð¹0) °¤Ðà5Jðø]2 _ zP~Ä¢;Eð+ ‡ ¨ - X£kðà ½†< ìЩx¶ï°íê®îš¢‡9Vv“â†Û0¹à$H †ÐVÖnH` ¸pcðOð¯`¸þ]ppL*E Å ‘JeP>'`k'Ú®Ö›ºÙ®¼  ¤€§zpL-Ã4K8 0° c E Í`^B Õà¯Í¤waà°M0¨ mpJ2KY ¨p ˆsašÀµ ðËPkÚ;eP>” Ÿp“"d   ©PÔ ðU?pvïW=ÛÐ×Pf’‡¸ ‡ÈU msxã3õg€Ú##w¬p#@ ºp€ÊQ;@«¬¶Qµ›¬À à»ðඦ¹üàlðV„¥ ´W¯Ç†m‡ Ü"w&€Á,° þ«#bwà³`©° ²Z[àÓPÈÀ®ãà … _ðÁ0]¾à7Pð; Ъ“‡lá»˜É ç²UÈ ‚ ,ÀÀ Š å䦠0PÖ –/Hp òÞ * cð €Pk`O€º¸¬°hïpÐà>'ðUÐR;¾¼Ðš‚´¹Èæ|EÀMQ°…°7 V i™k Š "a Ñ$/Hs2ë `´`pÕÀ' 0:!sY€§X“šÕÐ$ ƒÀ‡â “Õ  µ  SÒg¶Ÿ  Úcmh[þŸ°€hmoë(¹° 0‚Ú¹°Ș °À 5  yI{¬ð ÁP^W<)ÊÃÓ(µP Ù™°Æà º†S€R;À !@_Á8©¬Gavg‡^“òcÊM‘Ná‘®d‡à@%òà ¼0ÀŠ1;ˆÖ! ¬Pt‚ v¼»À jÒð µ@µ ‘ ÝðÈ  ePØ£×ŒÍ PP8“4“bQQ° m 7 #V@§_ q¤0 ´ µÀŠ²(ú6¯ © 0<ÀÏIFÆ` ýÆ ˜×<Êd‡þ=Ž² E€ºÒ"äÕ0:è°ÂrbMa³àÖP  RÈÕ€GààÍO5˜Mà •UØ„H°FèàÀ”€ÓR¨ ÓU Þ°ÌiTÅ\w=uZÔÓ ¤ å>Ý–SW¿Ðˆ[|×Ì5P @l<; Pä€Óä@ pvÛ à;f“ ¸€ A ò@   0.òÊ O¼Þª› ÐÀ(Õ>–G=lÝU×¼‚*¨‰½·ú0®? åØ, ûÂÔ QС`O0h‘ÊV2à K [ Õ z0 Õ™ü k°!Àv þÀ¼€¸°A` = èkÍÙ|Íu ?ô áCëKnöÔR [PüQEàÃñHuÀ¿×ÓJ T{9€PÆZ ÊJ¾°Ó2 ×ê}×r½ÆP € ]vÍEÀH  ¡±°¨  Xa@ Às  +´³ð ~tV càN’ÂUˆÓ:Xb¨0´ >—z  |’ÓBkI°¾p@ ÚxlzQÌ }¬@vgð 7àuÌÀP?ð WІ¸0*)°¾”Bš€^:h’M9 äP0àš@Ð0Ó³0Çþ°ÀÖL0æ3ÀH€×P~À3   Àʼ£ °¾°X58-´5p VÚ'5p ÊÀ ”(0.> ð w Ø0p+Í&Þ …A N$X '  ô±5@1»àk I@ øb¾@<Ð+~ Ò ¡PÏ  àP¾ìE` ,€YÛàBèõ§N° ÚË0 hСð¸€ß!¿#ë°èð ð ÀÀâ0 kîL` d>ÓcåX¿ŽÓö LÉÆ)¼„€¤Ós%] ‡N¡ þ³ÕïÕ€5˜`zC z  LœÄaa ŠpÀ !•C 5PAaµ0.ãzið Ò„4‡¥.s¨PÓ÷ðäïH 90ñ°°JÀ¶@hÀ¾A‘` Ö Jp‰¦È±X¼± „¾ ²›‘  ,ЮßPŠð F ‘_ЋLT‘`s? T0¥ÓþÀá%FûàP¬°m`DóU)@{ Òp=h0+0ü÷û-€Ûå ¶-‘<0]óIÈ0HCà 5r ®0b>Ç0¨ û%6 äéá=G Ó $!Ó´ 7±€rÖ€ 0°M? 0ÃÀ@ÃH3h%@… Æ!H´fÌðcÖ¬…³Pq°6#T9?K á(7ãF3pà ‚ã° ‰€ÈÐ0à@€€l³\¹¸å‹õ)5XŒSP)Õ·J™~è£@3¨‚gƺ£çΡ,kô«öŒaµ:‡ !щ”)C¡ÆZ¢ ••&_ôDA… ”!þ«ð8Šâˆ Gwe[çˆÒ!JÒ²9ª’e ’!–8ò$*›µNQäP:e‰”Q|±Ò¬ÉBmbi²¶HN&QŽÝjß»(•¡QTîXmNXÉâeáV¤%å80 ÀKƒ”-õ—É ¾D² ]6`7L%(¡Èùé5Õs¨¬ÛÈùÙÀ&XÊhè(Qè‡ > ¡…d #ƒQ>P‚ x€”1g”&¤8£ 4ñ¤ WD€ W†àbˆl²éD.²‰Ì•]éd¼Žqe$ ƒaši¸@el:Z‡ÇYÖA%$Ðyæ™uÊ)‰š¯fþhHp`k`üÀ‡&€¬™Æ$*@ÂpbÉ$‹YÊ+o¼A‰|)À%˜€ ˆn àF'dàfR`¡…› ðCŠ5nÁŠHÎXÃjØ'—–X% Á¬ÑÃ’XY (¬â˜ÖÐ7àBU7ÐÒ6ä°¤"AŠuôhà (ª@£ < @£œl,q$³LA#a¡FjÛ`£ !<9V5„!– 4np 7A#0,É’L°8K:¢“k¦yìO<ÙâH®@uœyˆøåMôˆ‹¸g‰yÀi• B™ÁVT£qLËB7þRy¥‡dyç‡Æ™…2|€¤%¯á¢ÈlÐ ÅšräІˆ†ýå z’`À0‰DhkÖÉ$†r,‘ÃT2C#“+bQ¤LÓ#ní$JªX$iA# tNqŠr¬2Å“Eô ¬ŠSDÈÅL,¡Ö’(²P#’¯«ˆÙQ«Ã.¬É†ÉĪ,"qdå1†ÖÃfø]ÅküX,“HÒâÀ‚(x‚Râ!‰Z|ñϘš ‚‚?¹‘½+™!Qd´yBWä©CŽeäX—n`éfS¹á`b)äŠ;2ÙbTf¨?î°ÄCÚ0GÚðCŽsÁAC þ%–±Â‡T‰H"Y›<YdˆC\ñ¡ J‰¢œøqmðA':Qd‘PDýDáàA \ˆ«â†-hã¨X$ÒÕ‰X¨Á ¢V,JK  ‡á! Ñ„¹"ÀО(î@ ?¬CXpDóÚ€04DÁVØ‚"Á…(€ŠCĦˆe¸@ßHAX‹ªd!Pš08=tpa0KXÄü‰¬!&ø˜ð"@m jD C‘CI*—(:¡<ºáh%"Ñ KX"wˆ„öÜp.ˆ@"ˆUJ‘…*”nèš"S´þ`C)J1½ÅK XG²àKx"¸8@‹,(¨(ÇØÆ T<ãèÐÃäNá†SÄ`‹°Ä*šŒY@  `3XP: œ.u«{IL‘äc9‘9ꀃ\*Q5ÀQlŒÓ ¯‚¶Ñ:¬á KPÄ8†3„b«hÓŠðŒYDb ~ðUÊ0Ô`eE¨F$Z@l!*@´†LäZnÈÂÐð‹hX‘à ~uE| ar8LÁÂ;¬¡ ŠE5ЊX@‡ø¨!š4Ê ` Ü ²‰"¯•0¶`‰3€ &þ°¬_‚ šƒ0¢pˆc£ ÚØ0Ž†/Œâ>8® ‡ÜA Ù0…€‘qª ¨€Ä!.ÑKa ’á2„ ƒW”# 1hF¨qƒCÀD8@0¾Ð†&ø@‘IV¡ˆ;Äà™…&Ú`‰CwÀB' ©©Hà sÅâÐI$Ä _SƒÊ1„Xd ¦†):J”c‘—hƒ#N…*¸a>8ä)Ú€a¬ƒ 1¨À@qpZ© Tø@;æqM€”2²0 )¼B &¨ˆ`‚/4ÁWu„ š b+¬‚äòÆnWðˆë‚NèAþRñ =….V|RâÄúD†–‰e8V Æ+ÚÃg(cmX© ÜP4§‚H” lP\@sÃ/p'@"–‚ q†Pƒk°=Àp(„B‹è)7>¡ tp£sÂF QE"[Ã*|€ƒ-DbEˆÄTpˆ5¬¢ë 8 Üð ÷[B h$Báƒ:(£ÀÀAÀ0 h0H«BˆKpƒG˜š+@kІ®:†/°† øE ݪlhƒ1(4a¨7k‚XE­Lpk+8¸»ƒ6p»È  ‚6†g˜þMàHˆkPÊp+kø*€„$xo`…‚ ¸€]‚—Û¦£¹]Øá`¨ ‡m€rh@†= ‡ € 0†npX€n`˜±'І ¨ƒq €' 3X؇ ØX`€ ðCyØ“:x€?T€} €:¨¨€'²`‚c8‘?ÀùÀq‡_@"8†ˆÀh"ðƒ €VÀº_HjЀøs‡8ƒú¸†:(X¸Xü'(€ƒ…\?¸…\¨f\PRàV€„HY Y`f :RBI…P3¨„Jx…FþQ@8fYh~€SȆPÐ9 ?H§ãXˆ‚PXKÐsÙRP„+0„B˜CЃCÀ\8„TH#+ø Ý„J€„Bx‚qЄUÈ„Ár€g¸…XÄÂ*„g¨ç¨„G¸o3x„O°‚GXƒBx+ø…/ø&˜‡ÈY…G(¢_ &û‚ER.BË3ëp4˜yðžÌ„Gp¦& ·Ëð‚”‚OÃ+y‚'80 ¾J˜Ž 8*ƒ' †dà…'Ü…(V˜Â˜Ë“pB,dVø؆"0Z‡ ØØe‡þP"x?ˆ `@‚u˜†¢‰›$x†!˜…l@á²ppp(šcØ—Y‡c@ aj‰…i!(¬9%(!ÀÍXèjiøMa(…á$˜…j¨©k@pkh†g𘉂©Ê†i¨L`¨¨ƒ €Zè¶?¡…¨r €VèÈ€0Y )Ë b ¹Hú” †OP5x…WPàH@xz(„OYè'q„ †1yX6X€& Rh)Іð…Q¸y˜ Є˜ý‹ 7Ðþ„%€Th‚ FM(#ŠP†È\ ø€Zào8© &pÄU8gb‚'¨€G°„-8ƒQ¸ˆ†Lx‚1h†Q8ƒ_ø† DOK¸ƒ/y8&ÈQÈ3ðoð‚1s`o…sh‚sp»Qð™8ù€eð€ H  è€÷,U0˜ã¦xƒ7hFh>þ`k¾ælþƒ0æ=ç=ØBæ?8ßr¶ƒ7ØFhæA`ùƒmÞinPøMÙÜç6v`žW\ÍMÜœÍÛ,…*¨‚®ñPx×Ü,hahÍÆ‘X(‡umÖbý·KØ¡9˜Q˜ƒ[ÖcýMSšaH¤Eè„S »¬™ƒ¸)‡€£l(áD ¼Pä)æ‚ÄÍJ¤ÄzecÈ=WfWSZÖSØh.ŒÎhçÝÖ]n…õçA8`ÿ5äa•MSÚghS „ªÖã[e`Ù¨oP‚Poð€‰Læ…]ˆÂÀ.SP¸ç?蚃>hPèèþV5 ƒþ2 d~> I >fÞÄÖIƒ0à>؃0 BHƒ2ȃ<èÎ΃òEfóm-0ƒùýçýÄÎåjFìq¶lÄ®f˾lÈNfN°ƒ0àI°ì=hìe¶æaæV؃80nr&çV°âö^ç~Þù_ù½ågŽ;àÞ8`„g&„8„x~Þf®l>pf|†n;(gb¦õækzVïk…èÆhçõ„K85˜7<È5 Žîè*`D E`5¸„aå?j—>j[Ö‘VêÓößx`ç_øÖ‚xf„önlžæApßôe„óÎå§æÞgßößon„@Ðþp[Næj&ƦÞê„@Èã0‰³^oè&@5€˜Â…*€î[¦îõÍ^øàÎM-X_:è8@ìÊžmIèí7LØIàNÀ„>ðì6@4G„spÎD0mP¸nl`÷Ußy¾åWæÄNlá¶\&ƒ.Ðí0§íß~ïænÞr2ˆí%¿er~mkþånŽíß¾ìtÛþíqÆ„0q÷Mƒ]>ß78_e†néž„ÏåçžßVpï8 „nUïVÀ<€ïA¨D°6Àƒ*vS…A˜ƒæÅkçõ7QHv¼ßivò\Öõó…_èþÕæ8xg„@s-àFwNØÇfÖë[>îó çuOõàîæÆN„D„-·l'YžjX‚'À¨ X€Kns‚ðL}nÖîæFà„Føåÿƒ@ àFpço?ßÉN;èmȾlFßNxƒ0èG„2`ƒ2`s;Hl1OìÞoŽ§„…N×£nc„¤>êžÿ×IÐ-ˆ5(ƒ2À:Àƒ\Wz:Ø> ôu†øÚ¾ìwwôÙ~ú?¨mq¶ôj^ôv®æ.Èôq¶æ׎ù7çíqo:`:s6¨lóçãÎebžûj7îð_aŽƒV g&„þM°n;ˆf;pÏVƒFÀƒ<À'ß\ÆîÀ§nïÝægaÆlæÆì=¸÷ÙftNps2°æ.}IЂ0HL„mFæ_žVpÿƒØ~Q߃. ì/ý.wl²u¬7îIXRX†'`x€x‰(PØ0•X˜è®íDy§Wævf1§qN - æî§: „{/gÒ&9·–¦s¡úìŸìqƒqžv<°ÕܤWiGpQHV¢¥ux€è”Mˆ!sLáÁÑKˆØPRƒ¨ ›MqþlbÔè Ÿ=÷`’ôæ &Lù äó§£G>#E¾ùÑ$22þɼÙÇÓ2.÷lbigOÎ=v6åQƒ§JœK”(b„s$ËŸu¾‘ôgëJnš1ÎPŒMâºçâÖ“€îùÓhn£•)A•TdLY%Á$#˜ ÑŽ?ùhÉÃ&O I<}m» °¤.’\v„—¦0a²º,j‡ÑÖA& 2ãh µ<4øb°`¡#G Š—æJíbydL(÷prœ’§.›´ÈåDfD:mꤎQ•d¤k!Óè»ô·aŽ«ŒÓ*á%Q¥:a{0À›Š3Ë>½Â¥„Ç‚<ØÕ²25ÜrK 5$ ‰…ÈaÅ >Ä %ePbÑþQlqõF#"Ôi\ÕµÕ&­Äq‘z›üÑJ+[©XâŒ0bÇ&ÆÁŠ56² %xx²óŒÒX†”4Âœp]0—“J2Ù”6hCi›„ÕÑ[‘Õˆ†¹D—Dq„• ‚$RR"’°Ù&‰bÙ`6¥$X\6e…HˆpBS ¶N(ÁÙe9yVS+vLbÆ$“ÔUE+ƒ”2G)BLóÀ°@-Þ<°ÀÀ - ÜB :B¨Ú‰´ùF}…‡H¹ÒÔ\ /"Þ$­”Q†+nBHhÄÅI°ÎþÈ[ßM7¦N|„±iµÂT+š–þÌ~ÞÈЃ ˨‚,'ìÄÈòÃÌ°@ Éô°Ì!™¨`@2³”Š‘tÌQp Ô¥^´Â判VʦBPL±Ä !qAK,™A‰¥ˆp±(BHSJ+YTQE ÓøŠ l C,â†tðLG?ÿLˆv¤AGi’ôQbq9ôŸŇ„è4ô&vœgT]XÙ5U¶^vmœž•„‰„¤&uöThÃ(;hZ9"b"umG„ðœÆe41ê™GvôQ†Z0‚˜J‰ TŠ4± Ó Ê< ¯•Zê©©¢s 7”SJ ­’$þFep±“SÁh¨Mr=ņt´ÑÆ“SF päjH£4ui0â¢F—ÂÅ¥ãŠ5·Ñ uü0Ž,È" 3Þ¼€.Þ°£ˆŠà€ .ÊpÁ…)‘ÜA‰0Òt"s`!Ê%Z Åq*j(&¡3”BÙÈÆ1†0$XÃD0\k@a1ÈÆ5Q,aÙ°Æ:†Š(DuØÀ-`Q A¸È2n±CD mˆØ †6(‚ ½Sƒ"z— ª  ‘Š6ш8”áj{ DG΃-©%b$‚È•è$’D´dj}PšÐ6Q4>ä!(a°IþÞ†1†a‹…úƒâ ­m=ñ—ÄzÊÀ¸ò¼!Yt`CS”‘x„9šŸâ0Dà¡蘃(б$L#äh@”¡ŒSjH°€sœCU(F1`q‰V¼aMU! ­ê$ˆµek$[ÑЇP²•%.$mðS\‚’5ícT›²ò ?•!vX–¡ž$I‚“¨ÂÉPÆ…N<ÃKøD%òQYt@?ðF°_, Š€„ä1 XæP„"nÀMÐ"0àÀ3f€„of¬§Xè)DáP=^ŽˆÏÀÈà OhA0jq, T¶H‚xþð‰3Há R¨Ï2Π‚sáb¬`~Á‚müÀ º`*qC" …°ÄôŠ1da ÍP±Š§~¡ Xˆ¨'H„‡…½EhØAdN(Ã5[ â/3I“µ¶Ä¥†•H*Ê CÒ€† ´…Á"qÀÃ&±ž=‡ YÀ‚.qÕŸåiHóJ^¬”’>ŒQhi¨c˲°.„ÖÆ (àØÇp€<€µPB€4€ù(F¨á8>´É$¡™“c8BÇ—ÀÑÈJ¸¤’Fhi¡YÎ ·}£3¡É¥Ô0 q˜¶¢IÄAe—Â)Ê1þ„u$ uXÃ'z0ŒŒÀ3À|A€B¬¡Rˆ8æa t\ ™¸ hÐŽÁ:  ®£„\ð¬Á€ˆò V¸? q†'„Tß(€ ’poâ«hF-0“*‚̨ ÔùƒP  ~A f4 KƒŒ \¸Eî` Qá£F(é ‹°d!ØjVZ”D0A†¸esÈÄbÙjâ¸,†áþ ”Ê¢õ5B5€°ªÅ0À ~c¶¾¢JYTÒÏà€®°[ç™Q+Ô€4Ða] ­Äà™\a" lØN0aýadÐAJ+–؈@ÀˆwE,æ‹Ì¢¿¨ƒ,Pڃ사ˆÀ” EâÍ@AÁ =Br@ P pÀf6ã€<äé}x2àWÆ/’ðOÈ!?*xÄ Œ×°…/à/Pa`¸Â á9œã€3 ÀŒmŒÃÌÐ….´ÑrâÕƒ0X£äPÄ"ÔÀ"xƒ9 B†€…–)Î Äb(xŠLþaás0C aõIhS:wòIGn·0Ž,ÃäN‚B)²i\¢ëQÞÀ‰¸ ¯D%&18-`).“ÈJ3³E>l1[Ró„:Á`œP³à@º!cÀ˜Î\¼áe<žm@ :Ѓ$ ­€­/ãæ`-mñLXâ E””$u{ïØð‡0´:WhCÚm‚¶š‘hyÀƒ´p K™A (šÖ[ñD8cA€Á |á‚_¼T êbÅ "ÀŽÈ `èk'¤1„iÌb™XÄ °mï÷¿ŸïàýùñŽwð‚73Âgùq5$ HA&¬7þˆ’ ÔÂØ‚h€ €(A ÀW%<)ŒB|Ã8ÐKÔƒ0à@ PÃ7ü àÂ-TC‚Ð\Ä€Í< À‚, Áè€*è€ ˜À|“(€‚'ôF)¨#HHƒ¡L6$¡BÍAÕ1ómKZ¤ÅŒ KÅ"lq•AÙ-ÖÙ=Í…œÈÕ¨M¶HÛ€Âð ÍG˜ØAÃØAeØ’¨MgÀÁP¬`Á1¬C "4ÁA788AHÞPžåYA- ÀiA@ƒ ô€2ˆ!,‰e`ËhpÂø †Güx¼…K° pD#L˜A"ÀÂÁþñð[!w”™!‚¤(\ÂðL+TáVTa+ØY)èÌÁ.ä>´@¼” ÈÂ@¹ŒBd‚%xBÆ8A!,BÌ‚€‰#8ØÌè_ìÀ»°R:A;Á.€<€€/ €/¼Â!TBm,€7,@h”€/À7 @ýeg°@1ðÂ; ? Ä+°VäÃ;ðdŽ 5¼ÈA0Tlôƒ-$Ø. @øB<@ À7À‚üÂB%h C%Œ.(D¢C.Œ$ÄÀ3p@q@$ôŽS‘,ƒŒÁ`Áx‚"ôb)ŒÅÌÁÓ•¡Æ°È•óT¦E'ŒÌPZŠ¦ ÁEàÁQ!D  P 4!tÑ0(pAÎÆZ±±à°ÁyÄb,ºbIÜÊÕl‚ÄB(dþB(0Ü[`–¼¼€tVm€(%h^\À.œ@2@À:ÌA+p­ÛBP‚(`ã(ÕEOÓ•Â djïL͉AС Ôa”AÎâd‚RB'‚ò™u@ oÕEÃìÁ°8S³Âú‰@ü€´Ô<0ÀAM§DT¨A$D‚ÌB5D'-Ð[Ì (,ŒC8Á6¼@7„à‚è÷äø‚/xÃÈ€/<ÀDÂ+ð@0€hÉ@$§-ŒÃlo-´@è'lxŒ 8 @Âè| ¤À/@ À'YA&@¬þ$€€\"@úõW”#8B¯‰'ôDŽ)j8ß5™ÈÖEÓ¼˜0¤ÁØýÁÇÎÔ]²€¢(þAD%Ä ‚heÙ[Ü%ÛA*ÚLðŒá„Á¥+ÂA1™Ñ&$m,€ÁÄ€5`RÌ@.tC(2 €1dššÖ5<€ |ZÚÒ€1À@6¼묉qØ-H˜'ÏxÄg´Xyf­4.ìï9m©Í­‘jŠ‚” CtXT—z0‚GOØ™M‚«ˆS|‹{ˆ€ƒÍC4s¸ìš‚\‚¬€Ã ÐÂ5àÀTC3Xþ- ½-Á ÌIfç@Ý‚ Â €ƒ\ƒ5X@ŒÊ´À*Ì.`Zå À(¸À7Xž œƒŒõ&|ƒtØŒ AtƒÊ©€Ô+ü7l7äB$4„Œ$@BJÒ%Ĭƒ$­ƒ0tB€(ÌA “L°1Qó8Ñ\‚‡ô£„E e-æ¬ —Hð]ÔxD  ÐA­ÑAÜVéñc)Bué[î¥ATHS‹t,âP\t'÷ê:Ã5hBœA(@ 8ž>ü@: Ê,@å1€Û§9 ,-Hƒ(¨H$רÇHþ lÁD¤Aaì êıIH*"0ï‰A¼¢iJBÔ"ÏXÂ5Š@ £Èì ArOŒÄ‡”H#T¡¸ž¥´ÂÇÁÞ)dC,ì— Á€“&p€#4 ¸4Ã,$-L–& l90<A*HœA4"..d|€dà‚/(A €}zÃ8¤À78SY28A0˜ƒܯP,p0Z$ŒÁ,,$H!lœB6¨2:<ÃT‰´Ì\ù‘z<ÊŸbBsäA4×­µàþµq¶LôHl‚E YÄb_”5'0ÅÓÍ·TÕÀAëxÕ숸A¸)dƒ+ L ,À‚¾"3œV`«ngÔ`¡ãc±‰Q9gŒÅ Æ6ÀÚP FH` ë´.›9Ô(£©6€j£.0I“™b*J0$D ACŒD$ Ã<ÔÐ §µ´¢d‘1š1ÅMC8Ië’SÚ`#®=ÂÀ„Ã=þÈD 0 ±¡†p ,6[¥™1TØƉmâ3Fƒ†X"o4 €LpEJ©KIöé*ÎPA–W)M”8&1à žö¨é=æ¬I>ìÈ2Ê°#42LƒÅ>š¢ƒ!„À O† 66‰#ŽI)Qƒ<èØd=É*«Iÿ ƒÔ·þº¤ ¹þˆãK´ˆ K ‰$…X†HôH kª‘£ +à ‹6ñãŽCšY# t4‰š … `Êi£'>@ _ÚXE†q>Qäod8 E®a% 8`€o¾ùâŠU i#P$’e BÆ'(P€…[`É…7ñÄpž!‡œnpC&šicmH¹¡eèA#2° @H¡ P@\€‰e‰5"ñ, `ÐA'7€B„)Dé"&OŽ Åè‚B 3LĦMðð°¦;ϪÂjR±¤M¼B>©¢žÉØc“0ø¸‰:ÜH6ŠiŠþlbY 9¬¥cj°dtÙg€X€_¼©E@À(º,E‹Rb„·6¡d)dùä•QˆÀâ’»¼4ãJÜ4£;Ñ 2ØÈ$“LK¡ƒÓh£ŒMi²Éf‰LDˆ£?Ôj©•§"UƒJ«h¥ÒMþµ›`j‹¬FVm¥ EH,E~IAyj@c‘[Èá @Ö˜¡ˆÆ8yäpÃHºQFfy´aÀÝÇÚpc¤ãI0pÑ o\!rHÁ8dð…C 9@°€o´ =RHG%‘ ]¢NÀ2˜¡ ü ÛP@Ê 9þÜáL¸Å7°+¸Ax„R‘0ã-X†"¨ÀР •p3X'Á5ð&Ü€1 Ž:„À†6àNuvàÃf"!I".&ºp¡D\Ža ÕS~b;˜—à0Æà 60" a¨ô¨…V”C(ƒP [ìД* ±θ ÒÕ < «ƒ& €m@À /è†Eð€Z(AIHÜâŽáŠkLc8Û¥Š-Ø@èA%N€‹  b¨@¢àSd¡2„áWfFM7€á‘°„'‘‰ð|!Hç3ò“€mÀ—˜DHò¬TþÊ'l CQ)èÅ.a•ö(Å*P²YøÅ#=¸Áè‡*‰Ô ØР4CŠÀ QH¼‚ɤ`€ƒ¸H…Öà„°à¸@C œð‹Bdb7DFð¦à pB2° 0¼âN(Ä!¨Á} €tñd¨l!ÝÀ0 0`À 2  °øÆ6êáX\¸ø…!"±†:pãÜÈ‚° sDâ)`!. Ñ:áhŠìЈµØé !I„…0!Iˆ7ºP†È6=5Ðá³ø¤„(Na¤(\Bþ­(þp¶7¬eµNÃ%ª`ºä±ÁCx¨ŽqŠ!¤¤GU ¤° op ê#Ç-,P€Z `.šA ˆ sÀ<\àÌÿôÄ#lЂà¸`sü Xà€WXC!>Á m cÁDЉ3"D<ç ¡^f@€¬HÈXÀŒ€³ET;'å::°¡ nºDª@ÓÅ០0 ¥ÄKÐδá–˜í!° rhbVkÀÅTYð HŒákH…!‚á„pN,Ê:)€ºøX  \8møÄ2>!R@À¨ß npƒL¡þEzˆ¨à èRÁ'ÐÅ‚&»•ÈR €¨„¼ñsäà(Ä )³€gÈs*À‡¼Â €H¯½*à%c+Œ@ o\b¶ @X ²=x2"O]8ód'WÛ$--¡Ã¬Ù SPÂ\E²Š9€´t!É&Ê )5`ꌇ86îàØY‚´¢Eh*ñÑ3Ø §2@EhA‹äš£(€-xà4Ѐà8 Œj´û£HÀ4¢ÐLS¬á ²€Æ2 ÑB„(dª `.R Vè‚e p!3p P€¸¨Cü Câºþ €.XÑà£BÙjÈ"ðJD8y”øg)æÐ%,üµsù°Ps,œâÙÀ‚#¾àˆ(x" 5·D–0 BÇ3vÂÁq€ƒ+ÈÐÅ xÁYèbqïèQ 8V"¯HA‚)À @‚†À´Á‚J¼ý ¨DXðzœ€8CØ_‘Š30ƒc•X) @y¶ÂÂã…Á kpC&*±äôEðKÄ+np…T¤¢3`X9±\¤@-Dzp‚ „ÀX°DÏxÆýèŒ<5h=t©§ÍV-U(ù%Z¡Û*X¢ jÈ‚ï˜I .”âjPþ121kD¤‹8D6#ÁUK€™iÃ53±Ô%똸6°Â(fŽz›òˆe+ @\xà œ2”Qƒ"(£šÖá¸@:Jh€–TF"Át•œ€-€ê …üF(`˜AÁl$°ìpá”ÐÍ^H!ñòLM*኶` Þ®òᨀs|1Ï*Aþa Aî¨à æÑ}®À^a©Á B Ü®  !°)ô A<‘Œ=‰ó<“Ó;+a nà –AðÐa‹`îŒÀÀÆ Z‰•R‚š°h !€ >¯…b¬è+!ܤN!¦Æí̘g¬·ðÒâ& dÀ`¦ÖÁw:ÁÀAÆA !xÁ:à\ ò¡6­–”¸2ê!@½4ŽÀðLT†ŠòÒ `Á”6®/@ø ÀxAì.è¡@ঠTt-€zŒ¶ÚþðôÁ,ù€x!ÎÁX ÁÍ~¿!Q§ `‡@¢„ @àú¬Çêé5U±:ª¡È#S ΰ„|$6oÉPˆ=Ë“«Ú‘=× /¢ó=óLÏôL}|>!*á ÅÀ >»,n`v“YmÀáLlàÇ^á úîêq\Ñä$z hà d ¬ø³âÖÍ•À¾à à’á¡T?àh¡ ªNíàY†a3Re¶áà(P¶á5€œ„œ¤ìN‰ÞЪPé þ¨*dÁ  fáfª¡‚` daŒ`Îv€àtvàøaŠáÚR@Þ!:ØòìN„lTR¹TªBðâœÀÞ €N@@€z Ì–öxAÌA%Niª”ãáô #  ¡ ¹V¼îöê¡…Â1!`ÓZr°XÀ€`*â Àpw¼ÁºÁ ) Î5›d¥jr¡>"f ^–áÚ^A2¡5e[`>  Kv¡…T©AÑ ÁáxaŠ,àT¦¬VR9.O7mÁ:vÍ(¶2-à…øæªØÖ+W†ãv˜s Ûhܬ㠀ú²X¡òáœà:€ÞaxaÓz`h‹aBØfeÜ”g‡¡EuáHЭº¤ô\À ÔR e¡g ÌÊ–P©Š\òÜJÔP!‚zVk×r @àƒYºö˦ %uÁánK.!ŒÁ@rqs @ jÁ!jþI’ÌE)ö…:rÆ` p@ ›˜Un`¿z—Ф& ŠÁRá‚«f7wQWŠAy…÷\…—õXo“kwI[‹¡„©I›÷€ €€y;@œ·`R`¬·z“·I; •eÁB€”aÑ¡СäArc@€@^¡ÎK`€` ôr!`   P†ܪª¤êâ`R¶ª~`dHã&Œm¯*8ù— ¯€ò!v Zäc'0™¡Iš–‡6yºIóAžåY^`ùánù! A£7Z£î+FþÝJR%•(àN¥ÓrÞT"à$Р7N!­JœÀpÂp"¢pd@jaeÜy¬*FlÁÁ„õHaÀG ®í€Is sÓ˜7”·š“{¹«¿ú«‹W¬ÇZ¬ÁÚ0O YxÓX¡N©Œ£7šžè‰âAa@9€ Â÷  ¡‚ÚB@›7 ›7`RwyY –C‡YÒâ":& ž1[†dÝê »Þ!  ò¡Ÿý úŠÀµ_»¼nüïš—99·¿z„9&õ¡¥ÁÐ0Ï4®7:!î…>zþ¤IÚ¤Sú¤OàzV²ßa½Fú„àjÚ~ÿÚpFA FárÀàà]Œa¨;.ÁBP‡Û»6@–€ 0ÐIŠ÷v!›1Õ’ Ø”@ÀÇZ·q¬Áz­×úÀ¿ú¬O@t€hx€’ÁÂœ2\Ã÷:ÜÃU®¢T Á¡4àp  JÀr ¼Áôï®7v@¢– ¸!ø8™†ÀŠÜ9¢&³·;[`öt9ò{“wÀŸ)€RûŸq›˜TËÝÚ` Ýx¡«;@¡qÛÌy¢—\ô,ÃPoµ¸¡áìþôª¦—»¤û¹]€øèVÎx#ݹQ½l4 pá ¾@ 4à ¨Ájáp ÐX½Ý̽Ûbq¸:œ„,• 3ôÌãu05Séú‰^à8ò­kÝÖÉÒ½üÁ3\ôZ§,üÁuÀ ŠÝؽ@’]Ù—½ÃGœÄq)\i6|Ápx *A}=¼z/`(`t¼ò¡z¯—¨Š²û†0ûáÆo”\ÍY¦¨¦‘Á«Ya¯R{µy˜×aþp¬a@ŠŠ„ÅœPâÇ0Í—¸¡!hßÆ0ΡEþ™£ä0œ—»ÝõœºY@ ÔT îªÌ¸ªê¨ˆ,`¼“ÀÝÑ“À4\€GÁ ¤°ß9b‡¾ez(ráOp­µZæ}þO€•¡ª^ä!#Î~•’ë¹~è¿^Â^ì3•ì—p ×!™ g؉ýØ‹}Ùß¾Ã`Ë—j`”@<ÀŽu£€^A €Æ»ýÛsAÇÉAI­w®/·A2¬"š¤cáâý5nãF’®— ¡žƒŸU; ý] ôOF\ÐÁ®¡¯:® Àòl÷+_͵™øÁF`Àpã¿Á ‚aþ½žTD~äõœÂõ -ùÁ¨%õâ «8Ò4Àl¨a û 2çd r^ä噸͘էìô4úg`Ø!3£$p@<\ÿ5`Kƒ Ü ˆÌ˜¾ƒú^(Tø ¡C‡ Š€› T¾|é AC‡Ç9Šä¨*^DŠëÖ¡ƒ®†2JœÕ: !@€o¿¤,«‚.ì kIƒ ï€v’+]*ÎÔaÆÌ‚‚«X¯BØ ‚YÊU`ŽsN¶ms²´/ ~ªUkЀB¾;:ð‚¤¯ß¾äuó£MÞTf?ômÍ÷C—ãÇŽÇJÖþÀ/^ï Œ0­³çκÆhSà„®¨»RxǺõ;VgR ÷î] ¶:q²5·Mº~üØÇ Çƒµ¼ñаEѶ<—ú«Ùë×là– A® §‡E€¶Ã@ˆ FÒØELcðiÐõ „øõéúìY•ÿÿ.°2Ê€“@0p€ÊìlÔ‘:@(!€> ÑD)©ôÌ3  DªÔ²@-0 „/_|âKÔeTüÑA1Åpƒ Ì’J ?°Ðd¨yõ•d’Q@?X  +NŒÀ +(0ÆÝÕ¥€>¼è•Wl£‹9,|rÅ ¸° þËVál©‹1oƉ’aQ 3²¨ÁxüuVÉ!u( M0Úhó¥j®µ,Ëð3B'ð‚ÌiÝØÔ?@À2½à„/ÞÀ< ðÍ«œÀ8 €2¬0ƒË¡ÜÒ ä4ÀÍÛ £Ë Àò²6*e¬^é³%y»`À.;\&í´Ôª×ÑG4 Ä;s Eܨ¥Ë Äð`î¹æ> Šºì>p† Ô¢ÄÞ$‘ï(ÔPóÊ<pÀ6 %c#Ž¬pSO€TB Û@ o\I§X)¼r5N(À #Èr‚Ô(R,f-ÛåüÐÊÊ0,þ“I$™¤ÀL#¼£ /'tcsn|•>ÓC =°^PC I*° ?LŠÝuïlëu×#ÜÃB‘ò"K8AtSƒÔPC.Û\µÍ;  Aâˆc.(á >øxÃN¼ ƒ =P£ÂÖfA M AðòÌš9 íRÅ«-»ðã¹°œïD^Ç*u‚?€’¬C¨í;§y›àÛ!Ä|¸ã¾Àî¼ó~!Eà  Þ0€(ÁÃÁÐT5Ë,@IxÎÏ0Ø!“?€ÀO>Ȭ•Ê'Uu2¥m#™¹91ÎŽºhÓÍõTÅ23tà ,Y :Î7þ€E=Œ(±â$èÁ'dqYtÀI+FŒ À óåC²ÀF |¤ €@OdÑ L œ Š±Â`¯—ú˜1–|`PŠ1‚¼àH‚xaÅ!R-V  ,0@¬°bBa/B° Y°B;Áv1(£·¨F 4á`hbðf ðÌà xÃ@ÀìaÔ ³˜†5h1‹•ÄbÌÁ‡šÛ\J @-¨1†ð‹2¨…¾xœŒä@œ£X@tþP^œ·H¿` (à$]ÔÔ`Ó fØ8˜Šz`>¤@°è2~ &¡ÁkB_Un$”£ Øê5,2TÐ \Y åp m z Ÿ Oz‡@ ’A W 00Š` ` ‹ÀfÏp ´à‘pžP–¡ÀQp \`¤\° ‡à—Yàf‹ð™° V@MzzÏÀ¤€ ¤`Ê §hŠÐr€cà ?éJ ® _wà H–€m°P@ n–WÐ11`ƒ1åб° n § ¼É–®à \ ž Ž Xà 10F ¦àCpÇ€Šz ~H X Q ð ‘ €þ ˆ·‚ ð ¤ £@`°‰Ëà3PK` †€ rz Íp™PM¡ ÿ)IÀ ±;ßTŠªÍ°p%‚ `¿Q$WÁ ë„ Û‰ )à~æ˜,° h_ ö €€Ì€ º©p S1† *P©ÀÁá Ž0\ ž€¥¦ ¢ Ò€Š° &…@W0ªÖñpðVP‘@ åC ž` n ™ CàX0ò€ 8zF8à°r 0€K *\H0 ݨ¤>m C¢Ðnþà"à wàE€ >¢¤ ~ Š€Ûp70€ J`ZV õà¸0à‰Oð® ‹°Âxà؀٠[ µ™P> –p ~¤ªx€~ ®Ç~p ØÀ‡° C°‘y C¾åà m P€_€žäëÇ` m ‚–ðå ªó™x@ žp`0©Ð2 Ëð Ôp¾0 2pm° rÐ%pmà R f n€HpÇ—7p w  ´` ³ðŸ‡ð±åG{«~p{Ê NõX6¡£\±)½¡N\¶ ¤pþ)À>c*0?€ Aw)€)@ )° ©@ ¤°gà1uË°…17°ÅøÞÐXðw•{Çp ‡0¢pVð ™° OP €ÐŒÀ.p«¸L–`›Àà‘° «P[p C `  õ•ð ãàv)0Cöö Ô@ÝPY` Ómàå@cÏ°å m𣧰M ½Ž@ w(àY  mð ß W°^ôÀ¼°_ R e*À¥H" zCà ”wp qj0—®€™p "à‹Àm >`þ – ½H \ C€ P €é»x0w¿>ÐÇp ¦pL \Ð’Cp™ — U› ~ЙàX` TØ € õ@ n =9Ð7¿0 ô€ð@ m  O>@§h€ gZ¨  ‹‹p¡ÀÁ´  ·€Ö0 d§ ÔJ=ã0ß×Zp€·Š «²ÐÃý6P ÅQ±°€8ðæ+ ƒ d’&,@ ÌàÖ°€g°‹T¬ÌP+º¡R *0N4Äo°£Ðgðr°7é̯ÐO@m° ÍP W@’ ñˆŒRþð«ððcû g0`ð ¯PVp–ð °kð¯©`P?ppR  åjšÍ0¤P‹3PÀp‘`Çà –`Ÿ‘À_ _À7°3  uÃl@p6`ÅÐ7p-ð¾ð ¯ M×j€ËPV rp_ ØÐŽ M0ž0W°ÎÂX‡ ¼aš ØÐ (€ÞÚÁêÂà ‘p1 ‡ Ö¾>Àw¨Yp¹ì‘ðØ°YàHàš rà Ó \ ð€­òˆ× ©mpìø7¯pþÊÐ + x+ mpå€öY «ÐY gÔ` ³€ H½ÔI}ÛÅxÑ ¶Àß'm~ƒÕ6bºa1ês^·#j¢4&C ÉPs¤&#CS_±&, VæÐ È`1gÚð‘©A p4Ð9à J0 V}R0 9@ßv~2çP @ ßP£À/+0R :@]Ëà_@ $0° uð Pq8£aŠ tPM0ÍÍP ¾$ì¨Ð³Ž` >À¡0~å`Ü3Öd²à ÷Ð ¯Ð ý ÷·m-° Rpþ_P gàÎ0Π pa Q€û½_p–[[0ƒ½i_ ÖÁV  ®p TÐ ®Pèp ŽàÀ€‘à~0…W Pà Ç …€3àrÀcW7 úªmrðáÛQz c •0~®Æ±  ð ’ý¸ óÊ€np¤` mÐ H€¸¼ŒsúØè°|0pƒí ¢åI­/IPŠóqˆÙEº¶wfh®)GSl/íÅn<²`NÐÕ›’ç_“Â5åf] ¸P²a~OpêóÀ:p@É@Pé4þ°D4@»ñ €¾ CÁé¦.G É`é9ìpGÐÀêÄ€ ½2pi’ïó k@ @;K(AP Û€ ~°¹@À(©ÈÊð óh¹eµ õ !páTt=° *0Š£!ÐO@ï÷€ªà 4  O`V0ãpOЀðmc  £ÀVÀuÐ !§€3‘ aÈM!{ |ãÆв8,RIÏ82,øbˆÁ‚Bc¬‚é©fö|Y³Àט/ Ø À`”<\ŠšùÒ— \ø:“㌔ZJ¤œ!°ÀþТšÐh*·ä™#Mèfø9¥ TÀX,Ö,eܾ@€Ü¾jix€÷€d3« ‚m~`Á ´±Àmê™É;̉n¾e¥7 €è`—B÷„d.e˜|¾]®†n°A&ŸòÉ'þm~0@h€Æ èA6f^p2d(Цø(øá°`œ YÞá¥zŠùæxáʼn†á…x!e^ €uÁe³`œ<›,ähuB‰î9"‡’9‘gŽ8âç "@Ž•)N`fø™‚]zA–tI†…"Eg]"DàŒ^˜Ñú)¦˜c„^FøaáŒ"pAëd"`æ#NHa„ øæ   Æ\@€Á¼YÀ<ý à\|i†n8„–už1ÅXÇRÌBP™!f)bTRñâ¡–\@@þ_(@½‘AÖÁnFÌ ˜IA6ÊcAŠOpÀ!XRÀE6ÎXA¦›ç ˆ¸Žý"Žì0@³€3‘™ j ÊÛ,z &ØasCèÀ.Ððc€ÅhŽ{ €/nä#°@¸nPk9…ÑÅg^  Ô#ÑaÆ6öSš×F|€LŠ!‹ð£+†ø±ã#à vÁ ã»8AxÑxH-¸ÑM\ƒܸFrŽjÀ ÄHF2t@ZDš‡BÀ? À²À€pfhì 7»ø™F„ÈBCð{`ìÂ!`…ƒx!þ‹  ¬ ¡Þ€°‹ ÜcZ+F:ÐC¼Ðt”E øa€ð‡›ì ”€$´ -EjñøP¾±€ ¾ …p‡6 ÀÃh1 +è¨Æ1¯ŽjXèÀ†ïàR‹àÕ‚ž“B›p*å(0Ï+Oy˜“ä( Z°ø ‘ŠîQ£¸hÆ|6°(ÀÁ@Æ R0 ø8Á² À^p°Ó¨†ã0Nd1äü@¼ðÀhتõ€.Œ!+Þá+nP ù˜ ñ… nÔƒ¬¨ÍG™!øÔ,`…¿ ãV|‹¿(¡i¶áþ`àº)F&PŒ]Ðp# =P VL`‘ì:—n€ à àÆ Z4`äPb. À‹÷(ÁºhÀvp‘¼ˆiT‚¤‘ÅHã¹TÈŠ „‹…=ðÀ z3´É¢=èÁBÐ^œ “(ªšÚV Ò@àEà:YÈÊ"/vqQ9^µG=´aŽzøÂòA-ž zÈ£øø€/à €¡ E8Ä|€Mâ7…z7ƒYÔwšˆÅŠ€ŠYê-ûHÇ>\4)¬b¸€ oPÃy73úŒ£ \ä/YÈB3P±þ¬â5P†2jÀ Üb#8ƒ"dQ re Ì€¹€@]°"Žy—³>s¿üÀ7$A ƒ „2îÂèÀ;œÀO¿#î s‘Aðc³Ž5@hAv?†ƒ‡¡‹wyæíÁ!RáÅ.Ò@ :¸ÇOwp›b覯 âwЃô•®#è†hX¡‚ä£|¹È¾‚åŸîbتìÆÊ ÖãÊÍá|3p7»‘EÐhà „ ÏëÒÁÄÁ6q<€Jà;–ñ v|À€t¤%=i„¹+ƒ<~G7¶3£~¨†”Ñ\T,âw†fáƒ&”þ¡ž)„Ö@Š:P@°C*šñoäW¨‡ò´ 7ŒÂEäñqydã ƒ<D~Áƒ$dÎ-@@ @@àf–AŸúÜ{HdbIŒ…Q$,“è˜Å/XW²¬èA ŒpȽÝcŸȇVLšz8”bÕÅ0X°ƒ uïñÃ/úŽbÃÙï‚°>“X >,‚&Ͳ“ ãÅÆÅ‚R §IÖ ‚0 êá^Å(t°s¤mqá +b „ýdŠÃ€FPF ôà_F$q†| ª @7øéÉÆÔÃE ¹ÝF`²€þ@è¤Ê=|öN6ð¢Ï`…eXáJ8Âö`¨EÆA )|ÀГFü¤ “Ç,l,ȇg P aw¦»-¬à†fBà˜…&Èñ> ô Ìpà ¶Ç }äã9)7x°C'²WÂ+Ú@ #€§©,ðÝ“ è¢WŠXÆ’ 0@(ƒ)@ô¯×Îü ã>Ì",ÁPibmà€€j̨ÈÅ/`‘0…#úØÆ8Ø÷¾ø!l ,`$ c p'Ø0€w`†ap1b…Ї‡0†Õ cx–gQ ~‘…)^àþ‡wðÀ|\I˜Œg €pƒ-ð†ð‚¤SuP$¯Ah8Á0²j8z›Ïb…™…§S„HH\H˜p¨°\0'w ~€©0hÐ…h›¿†`œ \)ä‡ÀÂÈ€Pø€#c’TXƒ ЀHhÚó†h†6x…ð†xUxB4ÄBDDB|ÆxÍ0 @†…êm¨[Ztƒ†L@`MÐ" À$„H< } €Cà ÀKЀ‚‚_ð}P_Ø]ô… þ@h7!%ˆ¾è иjÀ>@`.ˆ…C˜H€Y¸†±€Ð{]ªa(Zx$@…rè†|PžØ& _膉™Œ"¤€"̺m€ýØŒ P†"¸…oD?˜:˜…[ØYømÀ§ý€…t/ë†Ø/rè¯J¼¨1È„hÛ nS>ø†op¨‡zxòX¶n0 Ê–ÜeðãHÀlØe€tè†}ð†tø…0 8J_ÀcÐì™Á¨cx€}xo8€'H)8€s€x„J(_à¶p þUq‹¾(€ˆ„Tø†ÈhÐ˽ä˾„†؇À4p‚o¨…}¨‡ìyàkp?àp0„6¸?p„;˜Zø e˜‘,‚ ˆ„‡,‚"¨x†Y‡¸½Xé»BA[°7x;”‡Ñä°M„,è¯"p*†o؋ػCg,€hŒžm FìÓƒH€LZ€Ì6Єj .ÍDa …lX‡l˜a†Pa@‡kX‡ñŒ…"ÀCoxjPh á e€c€lp–س« ‚x`.ÓԆȄÌg f¢†TX?€ÐŒo ‚^ÙþЇJ™J¡…ËóS¸@… €…:È/y°€¢P¨‡(A†\X˜\€°Qð Ø€\Ø€c‡KMZ¸k‡²(kxQP{˜‹ø;yxR0(Í/°€Ö’ ð5eX€4‘`‡'¨‡'R_°ÃUZzKxh+ø†øh@¹?T;$·L%£ô ¸…ÇY€P=èPtˆ…<‹Y†ó;MøP Z .k€ÕŒ W©…±…CpH€hÕ³ k¦Oµ„+x€H‚`ð;¾ø¦˜¾êþ»>ì“0àp`p„«H=0`(Sp5¸„KˆJ(‡K@KȆN…*˜l`‚$XKÈ„5x„HX…ÈQ‚ø…:XQÓeXRÀY…ÜyUX‡!@‚cˆè.pGˆ‚,À.X‚5º%X†,H€h#½Ø pT$ˆ…NˆW@‡!°†uXWp€E „i@…'B†kðƒ˜gH€i˜(À`ȼp€Ì»†j¨` ¯ªr†k(Yk05$@°†! ÙX(°†itð¨&€‚ ˆ°­l@`‚ià´=†þ«õZp€eH€¸†Y˜?€Ök˜7XGK䀾£½8ÍÇ$x4€ŠQx€ðËÄ…Uˆ&h‡v(W"`€3 ‚3``& lpÔ$+P„¸†ÛqÚY¨†iˆQƒXh‚C@(ZW0Y(e€Å¼8UÞrËCø‚ä¡WÝ“•ÝnåW‚up=x 8€Z8 †fØ“Yñ6ó`Œ·q+„L ‹È\H‡ˆÕƒ&Ѓ;°†6†S@ƒK†,pƒXÀJX„Lðtd8‡'°„B"8„3h‚WØ‚GÐS=€TˆTƒCÈ‚&XS Zx†ˆþG¨à!O87ð.ÐE@×C(„”øÞE¨¢xÕà†Y@‚(a@.ˆ‚u†!ˆ„ÅHÈ( … (‡p€·0„rˆª˜†:HGCؘCp„@‡ŒÅ9h‚(ˆ,8„6Ȇ(ha( Ž…c¨ZeÅ‚Ø]‡#Žáå‚à‚c˜c0cW€‚<†­…®@…r+‡[8+ˆt °¿Ó€½#CÃ…Ch‘à’ÄK¼Æ5Ð\"Ø9x…¸d͵†Yà€g¸X…н€Õjx·l€‚,X·T>(p…N‚Npià‚Øþ›½Úã7ùpƒ'hW8iÀãdÆãr†ØÎlØHȯhjH‚yDp‚ôr¨Êh/æÌîã€&ƒÏ‹U†XT@qmƒrè„EXÈ60…LpQè×P„B ‚_P+¸ƒƒ>ƒ3 ‚#ÜŠCˆt8=ˆ‚HßgPÚlPKPænÅ5 5 i7`à;ˆ9X‚®àNr@X(®L¸58„kÍè„*8<°„K(‡r€…rÀ6p]ZhÎ(ˆ‚-ÀƒHЃUŽ„h£n½EK8›.pƒH5ÀƒLþ(¸é!p„Sà‚-pKø FàQp„/¨`Q8…ª…];6ãNÐc(x¸ÎM4&ˆK(‡Y@Ûm24;€pÞ‚)µ‡ÌÅìÌÖlÌe"x×QKØ‚QÀdMVEƒPX‚Hç(ƒÆüÐi@Q „H€²ög€iȆRÀGØ5Îq‹°%iÊHƒå.à©eî!ÈlȆ îmSЃo†$XÏ»€n'ÈRÃÈ\8HP$°‚B0t0„Lˆ?X”¥F!ØJX…/EˆOø5Pœ= &¸‚·Ž„'p7ø@þHˆ†·‡6(b¸$°`@ÇãLPºq¶î©«J <‚r …C…k@&H5ŽÅØPhÎS(4h(ˆ4†H˜çNPƒ*p…rÐ*^`Fahƒ;p„cpƒ(€6 ÛH¨ƒ N+°G¥X°„;;pƒN SE0QºCp&·„,È„,ð ©EƒH@KÀ@ƒ4Æ4Àƒ·ÎEðEhO@ƒ,˜†g†1ˆˆ•¸ƒ;ˆ‚¸M°†e8jÈ­=¡½¨„6¸‚ex+àa8†Eˆ,èiP „SX¦48,f4pëLþø?ðÌm‚6ЃæœßL¸+Ðpp(?˜†&4È, i55hq ôË|oPY’Ô¹EhƒkS†,iip_G`sa§.X=Hž¿û…ø‚‰ oØøþŒç ˆ„,R€/+`=ÈÙYƒL°c9ƒ(. ‚„ç”(˜`‚hè"8ƒííß5ƒKvƒ/¨€”v7pkeZp€gÀÚ …H¸ƒEp$X(ði"•†XsJ€7ÖöÐWZð%†\X>K0…Xˆ„6w<ˆÄŽGˆ,X°Ê…9XTCþ.¨Ç‚ÅBhXhƒXiÛ¡MƒúõJˆH°0Èén~ÎJ¸Hˆô€õí„EP„S@(@GpƒL¨úUPGX…­Ž5È„&¸K`ÔPà‚+°„((µMèaj‚T(„YÃUá_x…LX*0Gȳ¦„, s<@q ö„6x*(„/ 7 áo‚ \&0w v=xR˜…fÐRX¸Mˆ†up÷E0õHà, R.Ƚ·†à’#ð†á¡v%+@ƒj&7cE¸X^Ör˜ƒHˆ‚Ý6ைZ~µâ‹Çœ0tAÁþmÌX±H!åŒ!RYPÁÀAÊpôèA @Š’¸[EÅ„‹Iä¼zuæË2 20`2ÆÍš.¾¬±ò哇 ’ãè ˜HÀ â®Ž6wÛkÕ!9Ö …Š‘)Ò*ašÖ@ª³æPr°üpËÕÆPƒE‡ÜD9tªœV$–(¹ºãF5`m 5 $µ–² ùi†¡Lk yµM¬ ª‘»¶0tY²8sÃQ$W¡-щR“G‘šù˜Ú5{…iÓ l ˜+°€Ùòå $&aÑ5ƒjVºÏ€3t§’B8f¼zT¨’j¸žÈX`™þŠ:Y:t©Ô!KÂy‘ }Š€õ£ÆŠœáN $Á„9wq@K&Õ´±Æ Õø øAË:Àd¢ÈrDE,_´N_‹,bÅ+O à‹-IBÓ/¯¸ñMèáˆ"XD‘É ™,Ò rpQ‘€¡2(áÍOÔ¢AB 5ôPD? ƒÌ,0SG ÄRÍ-Å’ášÄÎ-åhòE%äÀÃ9@Rà´Œß`‹/Ü .°À2Ÿ¼BÊ7²ŒÍÔAŠ7œ±äD7¤¬q)‡ — ·XIYèJ~| èKÛl£,‘þ‚Ë ‘Vh˜J ©z¸hŠ22l°>´>ŒZ[hS‡€< …ȱ͗ l€ 2k¸èF!cÈaÈ,‘è!´ )X‰9\e[DrÅ+‘œ‹!ºðÊX`5…Ü€ hS.>Œ‰¦g-0Š†<áÜD  @*‡|P€Jd¢†0XDrŠ,RŽ"‡p@Í+ >Òs*2ÔòÀÞÈ#Õ,Ždrï¡pàÀ-0 ã€àø H!¨dR8­Ì"Y8â€_4“D-ß| $øÙ†µdbÈÏ,†%\‰K º‹þr5-xsŽhðÀ 5äDÛèâ%CDàÌr ³\ƒÄ5ÖÐ’À3&9ÀÀ>û àDƒM @=ÞÔ²O7xó€¨RÀ@-㤓N ¸ŒcÌ6¿°° +À 3tc˜(03XáÇ K^ú-5 ‚JNèò ÄÚÃÌ/Ô|à ŒC334aÈ>h2ƒ2°Cø ¡`d@zà Wø4Ch 2¡¯ ‚Wà€¬p$\( †0Ä bQ‡Ya -ô*0Äݨ‡~±$(Vƒá„´ h¿À+*ñvAâþ…0†7j$o,€m8„Àà†_ D!ñŠ/œÞp>ˆHPÁ ŠC0Ñ9@(&„9® =ìåèD$Õ²´À€`?" (ŠÈ‚&hÁ!p€tŸ¹Á77´ ‡Ðg®P‰3 ðÅ ¡ˆO¬Á CXÆðF0èá…($6ˆ5´¬Ÿ°+5¥„ àÀå¸=êyzp@5Lb $ £Õ°&*hA !ÜF °pæÛ¨.$2C@âúpõÂñƒ`@ÀøA èÁ ~t€ÃxG>¨€ì þ¬ÐÆÀëm£°2ªÇ X@€úd@¿€`".H/~¡ á#ô>rŽm°°P@VP‚``ÐÁ> Šô²0‚>#À Ð èA\hì“`0)¾á‡pÀb.Ý@Æ8TPT/ ˆ@O]`T#d9ÁFÀ ôÀM,¨RHÁ'A¤ÀŽ d TP‚:Zpj<¡€xÅ2^ˆUHAQ`ÀMVñ+hÊ6C%^¡)¼"ŸðÀdƒ¨Ä }ªU*!øN`Å|°„hÀx%VŒÕq *Ûþ°)ºá9à*0X.ZPƒL¤â¸H 7` \  hÍx@*®P‡è!`°$–á„{½ÂŠ Å2¾pˆLXÁxï1“™9 PÞ“16ƒ$Àšš˜0  ŽjЂ0 GnAŽx¨ àFnq n@‚å¬D* €U°B²@†,,]ðBÅØ“,dVô ÞÁ‚8¡Ã` ºq=;áÀ &@€²8Á=zÀb^$Y¼ø31 m´²ÈÇ òñ‹-ø@/r +<ÂÉ N`!Å0ðfYì‚'þÁvÀ‹]HÁ ˜Xàd|ã=`F=L„aÀYÏ)0@XÀ ÈBH²0À 쀲0/vÐ#œ€"%`E2p´À÷˜À=t ƒ^Ðà}ýÅž€‹ŒãÔpÁP€_àâôÅTÐdÅx¶,zðìb\ RȇR`]0#ÈÇBà¥Ì€€­¡ ÕUç+‚\ èS€¸pÂ8Æ‘\¤ ÁÀpÔB Ô.x $A¿`Ædq†|ü@ÇÝE=˜1Ž:À¸ €ppó½òˆX‘:ÔáyÊþêñ„L´a¸Ø”p„Tc£ 9 œ‹k<ØhƒS!‘‚nPÀsãІ6`QdP@ü@ vpŽïÀü`,:°ƒ8á› †I_À fИpÁÞуw€Õ¨Gö)=Z‚ô`A˜¾¡bÈâ?pA¶×ðUL` Wð‚^ÁƒoÁN‰q‚d$#'Ø+NPêOâ?ØÜ7Xጞï0r>ô ÌÈÀ ®®‹@ã.˜ÀžÝbÈ"¡ŸNç \@! Á€?v8Ÿì@s2Ø1¹¤#¾ønÁ7Œ±oh®@EþŠ„],{Ùa?ÿ@€Œl#¹èF.òaˆR@Ü?(‚2<à  ‚2A Aù`ƒ6¨3ðƒ.@”À0¸@ðƒ¼ÃŒÃ 0M|ƒ@‘7|ƒìxøÂlŽ.tCPÀ @€. <+ÔC xC0È@0xƒ/PQœÉuƒ9Ð2ˆIõh.Â'¤>-ÃÔ0Ã2E* Õ €°Àä4@$@”O5T7°“¯dAþA‚Õ€2øÀ3$@ œ@ÄéAà 4°ƒ/ÊxÃ(àÂŒC´€x.ÔC-,Ü>¤ €çHÚƒBvÎ0@À(.0À ÊÃXã$Á ðÂ;xÝ@/ˆ$IBCÓÑ#0vŽÔƒ1° 8,€Â%¼âÀð>ðåÔB-ÀþdDW1À@9A#š˜üV ¤Â ,C”IA|/ð+œPCü±ÂØÉÂt WæƒWrÕ}[œÁ',&p@RR%A Ì´)ÜÂ6œ2¼`:@;ÈÀ-EB!üÕxCøNÀâ,€1@7c6&9(C,ÜB4€Ã4"˜èÁ#ä@-ªÝ4xƒ2à€ÜM4ƒ àdÀ´â+*Ü#BÕX8(C€ ´£ìB%ØÀ\:+„š, ÀnvâðC.ø0XB$ÀÀ3€E')ƒèi#7:Äc;˜wš@;Ã8И,|CÙ!ƒ>þèCBÒ£zÎ#íH/5À@ðù)& ßé‚.8Á0@\ÿA€>lŽ @ž<5ð@,1ÉÀãnê/T¨…šäzâB§@.8$À-ÓhÀ+* P=<€/,ƒzC È€|VÎ@¹ÖPrØD@+½Ä­Uœ¤ÀHðBÈØ ü+ü@8Q€W~ 2K§x¥õ”*2hèÀƒ 9D§¨¤}uN}mÏæøŽý@8tþƒ>£,´€—”Ë t`À |A44ƒü•°ƒ7(„£8N- ÐÀ (Ö-Ó€ ä@A&à ,Âtë.îB[É=,h…°@8A>Ã;Ô-@僅þ@3Bl<@<|Ãìè=øÁ-(€ŠÔC>ãÃ.L/Ô@À‚,˜c2¦ðB„Ú;*Dkr'8€€C7(3dÂ!¤€ Æ ´V+µÊdàÂ<ÂYtF€h@7Elì ´Á¹ºÖ«nƒ1ä€@-‘È€¼:¨Fnd¨mc¾êk…Bƒ>`­÷bm7þ™5ÂôÖ»Á!Ö5¢@ì,@A0lPƨk „ 3|\ ˜ "ì/4Á(ŒƒØC(ƒˆ¦ƒJÑíä :„1´Ö „ ŽQÏþfp‚¨÷¤ˆ~p阀 HÁ8ƒ3@í|ÀT­ £™|)§ê‚ˆj@;ä€:ŒÂˆ0Á1,AøŽP…]@ƒNèS CÈÂ;<Û;ä™·Ÿ.ŒA„ƒ5TN¸@èžy@T B,À€5°¡lƒW²€@0 ØÏ5ä„9;˜>ì@¼1@@÷QãéB!CAùÔ€”þ##Ö¾,íΣ+þB0¬5È@Â,Ø‚Cl€õ@@=œäB78r$@Å( |ÃôÒkžáé;ªã:öò:2)0;òB¥5@5\2”Î -´Û,:P’5$@"ÀD‚ÖolQ:„.K0PC*¾)À3DCpÀ:|0€Ã:`:TÀoLÃ8LN:(&¤Ãè³Ê:kƒtC8œ§1„‰á,@$¤Ì*Aó.|ƒÏ®Œ‚wªƒ*è€õyCFËšFË°1ð§.0²1ð!2À/|€È 6TÀèÝ.¼ßðþ€<|Á"à@/ ó‚Wz¥…ê0œÈoXxÃ(U2`Àx.˜BÕ”ÃXÃ5 6(€*WÏúÂ#H9ÀÂ5ÀY—5 Ø$C@5¢î:@Á:¼5¼u‚h˜®ƒ#?r${ÎÉ~| xC.}B¨¬ØÂâ*@ Ôø€À}¯ (ÔÂ㸒7Ô2Ãñ€è‰ž.¸£/÷²Ù‰4iwƒ.,à€‘â  B6hÌÂ4ÐDÌÀ3LÃ3p@-`«à‚<BX,Õu³†A ¨ÀýàB hq¨®ƒ# þ  Á1`(¸¤Ì4 .þŒB 0– @<f p(`â–v¸Pc8=„>ܸ€ œt¹€{ –h@ò Læ32¨¥2€ƒ6 €Á Á:XC<àÂ@Ú0‚€hƒzeÁ*{¥—P+0©1B¸Â1Ì80ä=ü€Œ€¤B&ÜAtu;À48@"C.LÏ ÈÌ€°À@;›uYsÀ<>&t¾µ“¿u%ƒ¤B PU¨eì´&—w¹—÷uH_º5ÜIÄR2sÀ3ÃY9ô<æ3Ôð@8‘h¶íöàA,>0 3Íh“6"ƒþ P] °À*?Ã,dDz6Lz@B6<Ã4Yƒ°—ÚI"ž_hb”s¨iá‹U ¹a™3p9 ‰O )e|h˜ ôp˜P€§‚,ÆÐÃ5”€šBViƒšoXe @>iao¤¸b•¤Xf *Ƙgm`€e:í3fpa†™:êØ Š(LÉ‹PDA"Z²@ Ø‘§[øâ €áœp¸ã(pX](.ˆ"Æø‚ (®X‡‰,ppEŽ+€±æ‹1”Hç\^ƒ>PÄ \~±"’(JÁƒ<Ø”6ªD„¦M, ’J|ñþ j"±‚‰2`"†uÊ©s‘K³˜Æ”CîÈ$T 9$tB±³ÎlÐ(E5ªpã9Ø\CŠ:Ø…•¼y`EüÒ‘9@Á£ŠR¤± Ü€›"¡0Q“/Ö8C]’aå q£ 8Dü@c™ŠuaF…° hâŽCVÁ ²pã!52aÂ}~`E 9Üc‹BÚ°„ l,Ùb ÚÚÈDÃ, ¹Ãø!9ä4FÅ **±ä "®bt|äŠäW^€±O*)e¦©=ŠH°HOtê”c‘6äàƒJdpƒ4ð‰6¸á ™¸ÖW0dbWP„þ"ša p0à°Æ<Ò¥.s4 p×6¢ CX! ÍÀÁŽ®…BÖÀÁ¬p†'ŒbUáQІ9Ì8Ý(!„ˆ ôf2 $ =B[øžð\£8R¨Z c8ƒÖP7dBxÈD,ÔpˆSÄ‚‡àÂ)²A 0#€èÆÖ€´¡ Ñ`p¡‰- €Ä"b!CEÌ  ˆ„ž‹r˜ ‚ؠ°ˆ;` ¢ ‚"Vô =Ð…7FqüY¢œ'(1, a LjĆ KÈÁM0Ö%Ïðbè‚,`þ,qaª3P†é¶1 '  ‘Ù"A a´á ~°D&¶à‰UP¡.àE"€3Tb >˜d3fà†E(bëÀB$DÁ$¬‚Q–€ÂÀ`Š&@ÂkPÄ®Ð+˜€ pÇlE…-@B gx¬pÁoøµ8Ã!K,"–@‡)21„cH/ÛŠÅ+ u#€Á£¸‚¼Á€O¤¢€¾ÚB&°0ŠG@"¨@^4¡‰z¨ë3NøÁ(  \ÔÀ˜Å šŠPà` `†!fqHŒa ¸°Â–a)|AN Ć=lˆ¨‡X‚TÜ€Í8$dþP‹T(‚V0Dšn`°@ËX$˜'l£7pÃ!ꀄL\ûÔà ‘O ½BÂr˜qˆJàà n¨Å#Ú … <À…¹Ö‰CBÍ°B!^±†J4a‘€„Šg°vÍ€Â:Ž¡=4A Øuîd±ÊDµ(Ô1äf‚c`៣h‚Ü~Qˆ-`¡ hЃœÆQ/Hô' v0YC&"± &0¡½HƤ‰h/ƒÙ€h$dKŒTDÂËx 1†þQ<áåñVúšE5TG œa ‚ÐËÝì»ì+t T@}äÎ  aØáZ âVA ̇ °` ëN b®™T  èe0@An€tà¤ÀT€h@ ,L€"ï FA Z€t!xv¡`!+X®ŠadŽî!l@R` ®áM2a ôàQÀà¸Á. ®Ô äàÔÁ á þåð "痸Ĭg ^̇Àîï Ú`’`ZΠF ”à”@@VᎠªGNÁvÔà. .ÁPŽÁfÔmA¶žàž&¤` A̤Ç”G–Ê >îÐ’«&kœ Tà Ö¢pá ¾B |¡bP ^A `I ¬à ’à> a Fabíó”à \ @€N€•X‰Œ€ ÞᦠÔd˜Aêò˜áRÀÆA€`d!R <àå&€Fda0 \ RàZ@ ` F!2Àz!x@þZàz@ŠnNàdáT hàz .úB ’”À¨æhà”À˜Êö!2€v @ÀŽÁt€XdဠNàNrD´A|Àl ®êà`AøÆáR`"AÂv¡dî, ª`!€¸¡È!Òj`t .€>A~¨àt€Ó¶à ÚAR¢Ÿd‰f¡l°`îàÈÉW¡t”Àr€¼¾@ÇŒëA ž ’ÀxÀž î–Áb` ,ÁðÀ äàÂÄe€¬ÀäÁþ¬`|Àš  ´A p F˜`7}à BæŠs|à^à9¡óºá˜XX œ€”à ¼a2’à€–A¾À ¼[àÒÀ5œ`†!táš  @?ùRHR–#‚bzÇ+;` @ŠX îáÁ´qùv!C5”’!†òx!’oHTù€ JN€2ú "@"ˆ!h4 ˜‘ttGuôžèáFJ r Š¯˜!^ *£R~`(YŠN0€è:?; NòAôþA óÐd`º¡bAj ÒaêÁ¼!ˆ!Nã”F`”áNñTÌÁd€e€ÌAÜA¾àÍ@Nç”^À9µQ!õQÀt€>@Øa0ÀThàØáT¡€rï ¨ràªL¼a”Á¨ \áf 4@Hª1pf@f¡8`fò4Oƒ@A¶A( ` ºá@÷á=±[ `à `U„•PÁ¬¡Ú‚ÊA8 nà­lÑ 2À2ð F€l?ELú¤¬ Har¬ 4¡þ`€-·áx€ N”RÂT”FàPpc7öœaŽÀcw!vaD‘Àfd’b§àº!u À²ª8J 9ÀÔxtGeðA `Œ`¡&³X@9iñFs"KVIJ)’"an¨v¼ÂAºÁf` p Ún”å x NÍÖlÛÁÔvm×– z t‹ À b /2á Ni”FhäaýÖo«6pw€ø•TtF&rf„ø†¤  à4@¼Á®ÆáP \a6ˆ×Ô>ñÓ:9€fÐ̲uÍ’´þ9(¦8*æa@²5[ @~á V!€HÀ`8€\g6n ¬(P F+¤`  ^&H”ÞG'’¼÷{ùaHáÆ€a\—Ø÷`Ä@t €£rÄ à~@ö·uàB : `oÞa X_ùáÒ¤€¦€”ò³ía†tƒ5X>áNÐŽ`x€>a–ãê«j¶f_ XÀea aT@ABKææ¦vn´ˆÁ  ¬àg`jA[”àl™øÀ‰¡ø&ÀŽŠ8À¬þ!¼ä¼a€F÷oÿ–o͸FvÌx¬SSG€q§`€ñ=qÏ®l¡æÆb †À©`îUùöÆ Mk Lwxyx•á@mÖÔ,¸„Í3ã’` `À  H¡6€`x‹·xg¡€ÁPA.f@Z >`rà¼Ó^±×´×FyÖº±—ßÆ`Cíh"}[בk ŒÁ`™÷ ! j¡Êb¢3:[`O®ªa~j—ˆ í®À~Àª˜9¶áhK¨Ø$Ù8(Uà9žu 7Z@ØA”@ h¥R€~ ta’‹ƒþôÁ¦3u– !†!A@@‡uøaà€@Çš 4ƒr Ú|‰Í¶FI:N 2ÀÐ nÀÀár¥ΉÞóFÉø¦UTCušFÔ˜F2Ô6Ç<À×Îáð à ¨¡ ` €1a\\Á©”¡` o :Gt fᙑ‹à@Z³Žƒ™X€ ®åºÌªb¡Κ‘ ’š ffž |¡¼!rÏ–“Ï{»‘F}¹—‰a nÀLw LÁ ˆ—\õ‚X‹@|¡”áÆ¡Ð@ ‚’2Y ´þµ[{LÍ3t¶LÍ@‹£`!¡h»´ÁЮêóœCÚÙ ä9¹OÐrR t@ áL œÖzZaº`6 *‚j[¢%:XØa21BZaZvžZ¤àΘFH Š¡6Òta„aî “¡4àræ×ootÁ¼¤k”€#ઠFà"€&\~ ”ÀÓþâ H!H©@ ÂŒÏ\8 õÖV4Á˜ fáxK9Ç‹€Âáa¡ÇÙzIY æºÈÍ’¨®¶”9ªÁàffþ@FÁ)OœÚŽ±|<^ î ƒfà a Сc hµVçá¢a˜ >®ü€ üàb€\×u  ®á`À»Ó’h!hÁ|ÕÒÊA”«~àh¯ ·áfW?18¹uÀ>àÔA˜›ÂAÌ‚Áat…W˜€! nÆònáÖÈ vÀ¼ÖÕ ìa jáT Ü•¾) ²»qX¡èdÁXÀê ÁLg¯j"'’Á|bÌÝܹðó"`Äht"4@| `¼‚> lÀ¾aþ¬Áª±á8€r/çIáÄŒÌú;Ç‹—äÁ^àÇ_À~ â±vI}È‹<®Ù’V—4aÈõx9 ”€À᪡ÊgÊ@|!Î ¬¯¼WúHtÈýF  ¾`CÊ:\áºØ j5Ža 3ü òŠ ¬a8뵞Ð ¸€yébÔ’}6¸½6€p9º¹™œIÓkgs–€&§b –¡ Y`:“iB}ú%P¡"A®¡xiÁòAp½T:9 À!lža8: –!r oé›f#þõ©»·óf D!…ÁžÜ~Üs÷=9³÷{¿N§‚’€ØAØlCZ’àqË6 ÆaÜ`Êö|˜ °!ò´ààÀmšj#€ØPâ#~|ÁÞÓHªŒAÚ¿B™®í?¸AäiB! âÙ3k¨PqàƬÕÀ=£…ÊB­$däòmÀðãgÀÀˆ @@;‰Úƒ&nîœ:ÊQX°49ÅÉ1$PŽ‰@2dˆ›CAòtlÈ1kL›ZæÈ—uŽ¡z¶FZ\i5 …®Á,MϨXF ]?˜þ¹eÁê2Úµ›`F¨žn0vÐ8d, 0û8ñc}¹˜ÒêÚ´r‡n›– : ù:ç£@¡‡[³h=»c _”X‰D@Àٴ(#‡;7î 6Ì€U§ƒ!®¬EÚ2ƒ½$IN8þ ºô辪[¯^K6€<|øôÁ>c}ñ ؃Rм €`®Z.ÐÜeÆ8k¶ˆ@Ì.!0F&‹TciwÝÅ€7Ih AÞ(á/Æhð@„ò€³N~0 “:†D2KŠÏt!:*ÕQ‘ à"ƒ³mÔ‘.м#’ïD`@¼þ94ìà  ~ÌÀ…"[xÆ!ÂÜ‘ T 1„0Y€±È)xx’M6”,²H±8rHYDâ‰0CP‚‡%‡ÌÅ)[D¢‰5 -ŠƒŠ†ŒaÈ*ÌUŸ(R $¤8A° Š!³,¡èLƒD90dƒŽ5ÏXQÈm±`2?° .cPóÃ60trÍ"‘”³Ä,¢GÓ8RŽ#©ÀÒ9 À‚[8dóÌ:–Ü‹¸xóE%`Ô <(AãðD¢@ÑÉpŽ`L,H¸:\`1Fm€Ž9I¸°@²œ` ´€D(ó9 øB2.0P‚/IþÔÂ@9ÈÏ/‡DòËÔøÏ82 Ä7˜ÅƧ†E£ x() ‘ŠB(â-Ðj¡„O@b €ÈÄ”Ñ pA ”ˆD6Êq 5à! ‹°°À…(£9ðÆt¨à ¯x.ì!ƒ'H!ã|ÀÈ gRhÂ8° Ü)b_І2€ àÂÞ †7žPˆCB µð†78‰EPa ë…žÀ€$ ‘ " 94ã*7pÄ,aÌ` 8pÄ | )Tâ ðÆäpƒUþPcV¨Äîà(CuxPĘ@aÊ*¼é1`à š°98ÀH8n„"ø¢"dl5W¸„d$EÒÀ÷‘8! ˜:†c =ÐlÇX@) *¸a Â@B¯kÐÐK÷A%®°§_üâ«X…<Á+´A·XÂÐ=(bÔÈÀà†è"Ì`A΀)(¬pK=ºQ(ÜÀk …"‰P(" QˆD5RqˆT"*ø†¨1\´¡¿D$žÁ…*HCU@ƒ+ÖÑtdà Uˆ…á€r乸¨!P‡CÄ¢ ¦àB$"á‹´þá¿AxpŽ'€¡Z…ÄîN iˆ n(E'¸@ J€ÂX˜E­x£5Ì…z ­C€ÁL@ƒäp`XCYÂ)˜ÐðÉ¡ -©ñ9PA ¤B —Ñ‚B@â 8€r LÕ™pD1Šœá6èÁ À h(âšÆ"Àð×Cà€…(„> Q‡B¬AŠÀ("±K” _0Á(Jé (P  ¸„%@áˆÁºÓ˜ô0S"¨¸*`t Z8€•t#5žÀœ`–#à4NÀŠDüX‹,,ÏÇ2a pТþÀx Ð$@€õxE$®Ð 7@‚ °€92ñÌ` [°D$Fa|€%T`B ¬@ £A€$2‘ ÔAc ! PX|©€Ä2~A@`š@G(ä0YÄb±€„bá€P$@nPAÚ  P£?€À!X ˆC8À–X‚4¦å. a¦ ,e.ÈQn”cyŠÆ5¾” E,âKOøÆ7 ±Š$Ã]»ß+~‘ a  wP SÛ](¨ÁYÈD9°Á¦Px1 ‘0`a7˜ã ™ÈŽÁ¹a¡hˆÆPÆ€ 9"Í°Â#2‘ pD”þ–hÂ#{…Uð`…x„ƒ&´€oPà QXL¡Õ1Œ"_H.xÁ ^Ð#ø[ê"š1@#7˜[˜°É(â Fˆ  7<‚[hå1„EâPÓÞ9O<ÂxÛ" á "E´˜ ªq ö~˸hÄä[’úÞ7¿º`Å;è1‚,à «À€ƒ^ƒåЄfyé-C¤©¸ÂH‘ ¦"" ©Å^9B ¿`$´e…1°À Ô`F£,ðƒÀÔ!€ € Ô¸ øY€©¨D RÜ`ºðÅ/,ІJXàcŠ@ƒfK Œã`þÈ ц3@àN°ž?¥Ð÷ua Mà‚œb ,ÀÐ ™˜‚a C¯hC(4±«gäNTýÆa…sÈ€8C&Îð ÷0áØ(„*†U4ãMWÇ#š€]½{íÐÀ7¦@âÉ B,°` K”ÃH`ì"á€E¸&`ˆÄ:†àOD" åàB& q‡-d¢€¨„$·Õ`á#ÓÀ#Áü›þ¬)Tô° 'À ÄpY ³ À d ÌÄwc° ÍkÐ\‘ ¿° ™ð[PÍð`0C` r`(° ÇàˆW°þM0Wà[¤  Õ3#ÖÀèÀ¾ÀFI”GÁ4L¯ÆÄøÅÀ*—¡Ð+Y °°P /vƒ·¬@, * Р-0= 6R=À À ¬ 7v( Ÿf¯€‡®Õ. k ð •° RÀ,`‰ž»¯Uó„¡ ±À)k@Ö@ 7ðÞ11 HT1à°dÓ ­îê€ Øฎ‹ èð 0 ®€ÅfÀXœÆŒ›Æq<Çf@Óƒðýv€2DxàþÔ@ÝÐàÓÞÕN]@{°:-L°1WÝ_¥Ì±õá€ü Wà ßðð npð çP Ðç›­ û¾ï 0¿`V€<ã  9nðÌpWz•|ZÁ  m™`vºP/`ñoñ2Ñ¡ÞÐ5 à Z~¯À ¼»õzôÊ ªjÊðš©é³Ì€=Ð Û°Ï­­ó®ÀÌÍPÐ!p4pÉðšRðîxÄàðOßð‹> ô@ 70Ëp õ[•Ì ,Ð*€gÐ Íàrc@ Fj U §XVUàfHP&\Æ^þìÅŒ[Æa¼Å¥` Õ€ P±0l`ÅxÿÅw÷r<ZЛ° q þ0ƒ°ÀþàŸÏa0ùU0ÞÝ€þ…8¯¥ ,ðm@òZW €À.P ¾pAA°â@ÌÊ~ 1p ~ð X \P à½ÍÏüÏïüÀБ²õÄðcW¤ðáPÑoñë1à-¶ÐYsmð 4иK¯àG¬°Ž¿HÝ0x)ð ðæ æ̱€0îÇ„ `Ø°¡3ˆ¡XñÈ ·˜p„†³ 4h|@0F‘•T®þdÙ’ØK˜/ 0SQ©PºZîlù./V²R¨‚ÃCQ ݸã(Ê"KU:”I§*¦²TñD‰R•*­â€5–ìÙ8¦¢`­‚‡N›F­ä‚ ‡Ï¼qZmbdfП=8ý‰ógФ?5šÄÉq—.Ž%Iâ³É2¥!Lè†nÊ~ü@Ÿ`vB§# SHʲ3R­Ñà+Go<H€¸uP‚Çr E”H¢ŽÑêÝÜùsrNPsƒ€7 jhrkFXEP!_¾È>sx$©E I3ðøf¥ .‘"wíºpadd‘%va‚nÆAÆþXèF›mXÐÆVÐàB /thCÐ.!fa`Dšàž &ø@+ÉâCZ`Fg¤g€' É—)¦xàG „‘˜a p¢'œB?ü¨†Y²±ŠlæèdŽ9¢À#5<%+¶ÄŠÃ,²Ìšd’2)q¤¬1ãØäMôúªŠ8öàã7øØc¯V±Ì²7ÞÔË2Æi„ D%yCÈ}ƒŒMªažÍj¨&BMÓ"@M59# j¼ù` Hð\”Ð`e|[gÖà 8ŠSD¸Ä,°aî9`›³@†eñæonüP™rVÑÄkPyj«­öþÜ4ð&‡1*9À›Zdp”6x@•.:BgÐÁT”Hb´W`Amœ`E’x`;4ØC5¦ŽZÜ¥ƒt€X+2Ñ$ƃÔ8€}*Éä‰Z’ÐÈ‹<²›n–¼œi\qeˆl¸ÈF˜lD°Y Efai à‚‹S°œC”KŠ&«h£AÉB”²@«F6™ OÜ´SÏÀó³‘.öè‚ F&a$±Ãâ84ÑE»P”D#ˆJ¯anÕøyçV(hP‹ °ÃÅ*¬(—3>ø q hÁ`,‘#†,.AΫ,œZ„”gh¡EM` þ…œk6p`ƒY‡+^Á%ˆðey’ð…\´AN‚†‹r~ï$$²‰eežà—’€ä ¨@ƒZrˆÄ›d°†"8ÐÄ‚¾¹e”šáÀœp’DædX©C˜!È‚n~`€€/V¡"%ÎñF )x#<ðŒZŒˆPP |£Úà@"Qü"J ¤P\, ÕÇ”A„`@@–<ŒÀ€x(# ãàAÁ@ñU0ŽQ;MÐ@<¨q€†2¨¡À @ðž Q(t¢w „²Ñ‰ßÅ"—þ(G'®‹N@¡6C£0¤!‚N”Q±F'¸à ¦UáNcD\Úô²`% oØ!3³Ùa›à'øÐ…Al †éã™'IAQdØÃÚ˜N°ÔÜ@P·»S€†.F‚d‚9ð®@Š,à ÞðÅÎÀpÌ ¡hÉcˆâ8Ã%ÀІBÄbc8„"A nÀ‚0à†0D7†Ll!˜ÇH¡È@O˜ÇÀ kDáåp„#¤ÁJ\)ŽÀ‚2Ë'\á8G0 ÈáÓ(Ç5ftÃ\Ʋ ˆE<¹HþÒ6þU‡ePƒAR qÈ` € ÅVÑ:_6ƒ2ð…|4 müBMhXð\ЫˆÄ.cÓ‹Ðv¿H@îPycB PÆ/p¡DehÀD ê@{¨“æ Â<´Á7Xbóø…6‚ÑK•­c•Ç8ƒ!ÔaÔG|0€®àB,ªÐ†(À±Ò8…42Q…š‰@o„#¡àW”‹ÄsE Ë…%`As DŸìЦ1R.{ÀÓ´`¨ÒÊå|àÃd‡A´â¶ŽATdà O>ªx‚(IY S¢ò¼0@X¡Êœ@ã@Àþ ð9XA ùS5^qTƒtMˆ„!!=Dá ÇÃ*f@EÀbkpÃ`A EÔ Orô°…-‚ ƒ²PˆUhÃz°ÂÑ(°Á EL‘ E˜Â ŽˆÄ"Š@|âWxB¼1Žì‘XÁW4A8èpC(‘ 5衾gÀ….~@sü@ ôý„6Rp†bÝ€¸Á'n ˆHBÍXÅ*xŒ 4ãgÐÄ"Ö° eø`C*Ð ‰E¢ UYÅ.BU=@¡pÃüŒ&daÖÈÂ<€¡‰&h‚ à`ž­ &T`Ž¸B&þ¡BÏ`ÿ}Bfm§Í´6äñ‹fHTטÁš0„SlIÒpÄ%æàˆl@¡ žãΠ€Žld㚈…&¢€„kXc³ø+-fð t\£¥ˆCií`‡Ùîµ­Ð$!A‰1щ/Œh$Ó -üA f„¡ð„ÉÉt œ°%æ`ÜRÒÍv{Gß"p^D7W@Àj€Ü`¾ Æ2À%qA Ú$1R4¬AçP„PЄGä"zHº±0lC¹@. Y„à@àxD}³‰Q@s _˜¨0"q ad"\F,a‰,Ðx XC%>þð€üâ çh¼ñ rQa‘ØBa ?pØÖÐC ` À‚õ°€p¡€á¤øÁ ¡C¸B ‚€Üò …¸Â0 CDâ†ÈD&îàMèAÏXBHá‰LŒa|ðÅØ1€»ÂÀš¦ðD$ñÞ6db ‘X¶7¸áѸCZ1 Ä?Â`PÄf Â+ÜáÇ8†˜0hpZ¢M©@dp&k«H³"~Ž‡f j°„(bÐÈfƒŠèz€Qˆ,h£³ð‘ @àÀEXCZ=‡A "Œ7^ì—;‘/j¸D)J!þŠÔz$L;ÀƒM ƒF( ¬±<Nj„?Pi€7ä’7zƒ†¹‰€»‘)Øj8ºÀ…UØ‚x‚1¢¨…}€€`…qH…H8ˆ8ƒÀÑs)hƒePB …}‹(9°ÐA€‚Ek¸9XO0aX,P0ÈW¸ƒEÀ$@ƒ;ˆ…—9°ŠE0mXé‹„+X‘$hìùj¸‚_ȹ+À‚6ÈlHð.Gøè°m`Cø)HH€XƒO€€Ø)¸‚Tð…8ƒHx„JPHø‚€`À†P8„EH<ôªÅ aþ€4ðƒP …gPø… ø ÐÁ‹™©à«³`¸ƒ+˜º‹:Qˆ7à‚÷*F4ø(X98†E(¦PЃE€?@?*pƒU0E¸89“hO@,p€9À4bƒ9tÈ^q€HÈ@S0kƒ-…(;¦ˆSH5C‡EXth¦R -ÃØ„É4®É¤1Áƒ9(‡XøD:7T:°6HBà„F ­G™Œ=;`;…â¥x;¥y»h˜h.^è)ø@oø\X†Wø€Ð%C\ ¥\®J Yˆ€—8þ0(„ †J …5H…J€E8‡)èY0RX…/0KØQЃô†/øHˆkØ7HÈ„Jø…B8&ˆ†`€HXø‚1ð¤¹û,ÛH¾k‡WP„10C¨„WÈ„Wð€¸ƒUE }`†€€ +Hj¸HT  c…+„Yü†/ð…e¨„UPÈy¨_4„¬»ƒ¼9ˆpбg0…E@ZЖ¨Aeh‚LÈ‚r‚UÈ„ˆ0pa ¬EÈ,ˆ‚^1…-X„È„óÒl­X=È„u(Ï/pý<þ†WWX=H…pƒ%p€ =Kp,6£E$¸>KOcN=˜Âiˆ…7hƒl¨€lˆÇB€9pQ°€LBŠ¤?BŠ“Ep„,@4Pƒ*Ø„N"D¢1á‹Ih„Nº“s³BÚƒ¸ð L®š\®) 8Vè$ðo¸€Æ €Zx€s€YØP  ^8 À€d8ƒOPª`4=X† 88B°‚(à‚PÀ,A*È‚&ÐEP*è)>j€²X#°ÊjZ0°²‚Jø%ø÷H‚¢Œ„ÖþøÆ'…CU}@x…-¨Ìeð€n €XC8f X@¨ _h3¸\H‡x…/(€È ˜È¨C>=0…;…fp+x¸H …µ+€Qø„[ƒôʆ/°„C(‡/ˆ„Rs™L°?ˆ<»=à‚/ˆ…UÈ°p…·…E(=°„o<kp€!@ˆ‚h*KX„X¨¸±†Xp€]²¨5.°N7ˆ‚hÈ*8HØV`aڂΪ&.p4ðƒrˆEÈ„%h,(…8AÉÉðH=I ,0…µQ5ĸ‹þ8ȃ2è#r3CÑ“0´ýÛ„þ£Àn'à x]˜‚n`Nðe {€ð… e‘è†aè€8¿0hdè…a‡‚˜Å…Ü x®‚q8¡g`‚°p†¸‚Hp†Xœ^Xh €F¤† °G¸‚Nm/@€v…$¸¼ÊOUXUP…Qx‚Wø@^ x‚ €†€Ð~Ð…€†…3°L]À–G‚ƒò²‚-0Á…`€1ƒQðƒ'Ѓ3°\ /%“þ$¸C¸‚Y¨X„H`€ ‡B°„È‚fÈ„&0;ب€h7¨BKƒ5x„CX“˜M+(„GX)†‰p(‡÷­kø‚L…&8„;¨€6X€Pð†U¨€rpE@¬SPõ’Ex„/øÏ«‹†"8Ô%(‡, µ6pJÀ‚ùäˆô„9ЂV „!ŒÙ“F µÀXHSPˆ‹¿ˆƒ6Pƒ°iNxÇ”0h$Hq >(Œ9€‚ÈÒj0”q }€€s‚`¨‚€œk‘gM¨aMà€P€w(þ†Ð (åR†‰' ($x•XŽeXNvøZ¾å˜ˆ‰dH†ç:‚ùeà8==%ŠP‡Ñø€øàÓ˜¸y"` ªaÑ ‚] ØðÛ8gtÞw@]†¨‡nxfÀ…x]xg]HÀ‡ bÐvð†dà¥$P| €Ø†Ò ‚@†1°‚÷飰‚3x‚ ŠppØ–P 3X©3°jÐP8ƒVUU¨„1І[Іtº3k‚1À²x…T‚PWX)E(„J8c¨þü’Â18UGøOõú‚, ‚üÉ+HYl8žu!8…KЋ¶˜3Ð> ƒ>¸!Å;¸„(†¨0xx2îÛŠ±ˆDÀƒÂXFéL0ƒu#ƒR°ƒM¨ãü3ŒN`b d$9d¨U @`î†%pY¨†P¸3p€[¸Zà€[P€(‚Ö¦`m؆í@8‡€]àßþm^gáncÆ7àÞqÞàÞÿ8Uðèž%ð% …"Z@渘$à?€ÈÞ~‚wPnànï ‚[è†èþ†x€Ø€[¨‡€ï °w0¸ýowà€$¨`ePj¹@…k …%˜ß(@‡ñ°RÈp ÷€ŽPP…#p†^0Ü{Ð#€˜ˆÑ p†QP‚#°RÀÆg@…r¨€ (œi˜pp€ è€ ¸n¡x[„€%88›™ƒ†ôƒRà‚R8…R…Qø*À‚¡¹±f±‰-( ýÓ"›?°ƒV8…|°OP¡P…%ˆ‚9!Ð:ðkýìÈ  2 „³® 2¸ZÖÚƒI&8‚`“1d×Þj`H'3„J ½J‚UþjПgõxÕní׎mØv‚øЀX€sØín[¿uáfoß\çq&çÅ5ñ#éçÎgÐd (‚[¸†jHphöY¨†Xøßp€ˆZ(¨ptøvpG(°€‚!†!€#8š,ʲ<›Y#r÷N@›‘Íê›É†uˆ#›éý‚qGü øâ8†!À†!Xx™up™!@k(Ž—‰™ž1#,ÕÃrø¢hðwh‡v I«€u˜\ËW°#𿆜ò.¿Q PÀ¤9‹±Ö‚2É N ƒ7èyIà„ ç±ùƒþV.´ƒs9O%Xi˜ùF`ƒ6ˆDIÈIôM˜;ÈÖÊã o„@PtU˜€zlHW'Ð …T gfpj §†ëÁÄ v %ÀSm×VuØö…—/¥E^oüoÆuPÙöÖÓÔ\_ç]`‡ÐL¢‚6Ë€à†[¨tàT°íN€g˜…—ÿ™S˜}Ú¯ýS¡ÜïâK¨P -8ŠdŒ %þ39“8ë=Š¿F03˜„A…Kh¤©~QàòÜoЙß~¤!š—þ¢‰yQ˜}Q°¨ržñ?*¿~±Þ£¢!þ¤QŒ?8J¢³Ñ Ý"c4…Ih£G~€ˆ‡ >]ºH2#© §Iþü”íUŠ*dÁ"e‰%7tè´Écâ›7’NJâÔg“IÒ¤áÃg$“vì”c¢Š6Nºus‚?X,;Cv*ÖQ¢¤ †O[>è5!‰K™- vl-o.d ( À€¶nˆ!w®ÜvïÚ1±Ðtý!xoßwïøÐABÕ—e« ªÄî+Øh‡™*HÆX!%:Ë¥Ò¦K L-°UP“&Š ;6j@ „Øh÷Ã?¬ÿ4š4hx£Aqˆ®eþxœ?qÒ²œQð@Œ®_ç݈:ð‡â0ä:xñÍ·¢ÃfP+ãÌH‡È»ðáµr¾=xðAú}ÿAÆ|øÚ$xÖÄ ' ½Þk¢”" )À²)kX¢F‡j´ÁÆ&q˜AJ‚ ˜È ýA#l´"Ódؤ†L‚>%QÌ8ÁÊ ©L ½¨°Å=Î| δp :L Ã^EÔXc ÀÞüÒB0 ¼õ–8 ™¦x±y4é"_x± ªL0J%•,C…`H¡ /ÔÀÕ\“Ù5· ²„!‹ÈA sPŠ¢`š©¦˜þRÚé§Ì! %làQÊr¯ H ÉM"Pl± 4 #àBpŒ8äŸC×9Èȼu¼KÆnŒ8¸'Á‰œPž¬¯ÍšGUGЃ’ha¬½òLjL:ÈÉnîш±å"Ô,'hÑ[+›h IÏ.[\t¥Í‘ K,qC$m(R”l‚Çœl"Ó‰‚œ´!màqÜ&×ÊÄGAœ±‰L¨3B<¬œ¼M7?¼ ‹(1Ê(‘(q!èpÄ4ì‚%XZnÉT¶hàå9P¦[ø0Ý4Ó@5ÔIðÀƒ<õÓ,ð€º°ðƒ µ Þþ&˜ðÊ*¸¼à9ÏÊA(K$€J5À`…KàíÊ4Ó aà1^8á" .6Ø$Þ‰#–€"ÌP Qy'TžyåÇœr©'b«¶-'1tú§ŸdÒIsüA{ÀÞl·ÍB„+´qlò‘q¼K#·å¾^Ò› h"²k Aî:K|³² Kt\k1xè J#—˜’Ù,!Jh(B‰xlÒˆ{¼1“‚$Rý]$’F·bÀ«$vxÃèP &à ™ŠÂ cÈøÁ8ÂD %A Wð… îÁ¤…à ðS€4% @¶PA–þa¥µEj2œá¼á _$ÁØÇ ¶¯ñÀIøÁ ¬àV`FÑŽoüàÀ,8@‹&Ü À°*`à‡g„ÂP\ëšxªU-U³8À„[˜`2(Æ CŒc&À Úá´cðV u0ÁÇ‚Ì 3 "¥˜¤L5IÄ1Ò B`¤ƒR’“tA&ÑX‰j7=2$Bb Ÿ8ËyNÛxâ‰ÃŒ–WŽm‸À-ò¹Ï,]4Á  Å @ M¬bÏx Œ,\*s H\Üà 2€'|COxÅ+2ÜŒU´ @0  Q|ã ‚ ƒ_4a2@=À)Øc¡`À<8€ {Ìcßx‚,0 þPÀd:Ã!‚\`p ¹€EÊ Î€Co¸E9h1T`&(¬A1da€È‚%HÊXQg^|"»\?qƒdT kØÅde‘ƪ€È@BpYºĈÅ1K8¢\àæ°S0sØÃ&±‡— ÀéÖ€b+ rÑV[¹†È(§÷‡†…A€ë¥Ã«qEIp ” %ëö†gÇDºHCèP±áĦ4æEpŒ”åÕ„&ô X…&:SŽÌÜ‚Ê ,,‹tCd‡…‹`Â/T %¸áª¸Â jÐH3ΡàâÀð )È#ë8F,†Ð†,Ä@ÔK‚'¢ÐSPbªüÃ}xãœü [¶¼Öõó} ÞÐ^]²¶!ìÀã·»þØØijP²Áï ¾ÅÄLÈÀlaOa.Í«îOPu ÇÄ Œ1Ü@UØDüÚ½îgÓoÙ]¯|k6´¡ [À°èðfÜØAœ‚5„€ÈX0CØE7@ \:8 ) €Ã"dÁè4Ah<TÔ'€Áp5P dBh@!àXÁ+<ÁÀ€-ðÀ@Â!ÜÁ1€C!ÜÁ(ÈÁd$Œ4C!ÈÁ1¬‚\¨A$¬Â€ƒ&ÜB54€2<Ãd ¬BèÁ¬ ÔÁdÈÁ"Ì‚-‚Ü0h‚!à@þ38Â"äazŸ(  ÜÁDAT‚ä€*@ ¼$¬A!Â(°ØÜB3,B*èAhÜ‚p@„Â!èaŠB9(‚'ƒ8BXCë!Áú”‚\B)ƒ0´%ˆÖ2µ( ˆóœ‹óàÚ¿=DÀ‹ïépÏ«ýÚ­,_ l &$'ð,O7yÒ&øÇn”Îp$ÇxLÂ%dA€H5¡Á9žã!PBˆ!`BM,ÏI@L",ÄÌWñ¥ØF‚(Âú<‡IhŒ$×&¨Áƒ:„@ $ S°B•ÐÝB&@ÈA&p@À*h`,tC30þØ°B¤B&tÃ/à 0C$ªÀ'È À ¼‚/ .øȘ¬A$XƒÜÁÄ€%P0‚'@,‚5`"d6ˆø(Âä€ëY‚@$&À3@‚"ø'DB3”,BdÁ Ì€XÜ4AÜ0$,)Ü ƒxÂ(‚#èDÂDÁ!t`¬d€ Á<Á¼B/HA!lÁÈ")\Á „B$D*XC¢€ƒ!DB Á¨'`C&P˜DèAdCj† ˆ‚0ÌAþ•B,”ÂSvN´¬Ê±é†íu‡îåÚ¿þIÇ s>#¸ËóX#A°ÄñðA#WôF³|Ë·»´B ¬Si8Âx‚#8‚)€ÂSN‚H£$ ý &@ ÂoñÁ&¤°Á!H$Ø$˜Oè“Q0CPô5äÀÂÀ+l†.Ã8à5„äRàB#R.à€àB%)¼‚H|Á*XÁ¬Í8<@-¸€(ÂŒ×`'ÄÀ1ÜÁ:ø0¬B ||¸B ¸‚$–Þ" AX^0P-Ü ôä`C,‚L ‚Ä ÐM$ƒ04ƒ<0¸Áþ")¸Rbd‚#là"ˆÂ€%Ä¡%˜Á/0A! 4ƒ"PÁ¬œŸ¡(ƒÁ5T€ÌÀ"\Ã`Á8Â:”f9Ü ÁX‚DÁ‚% `ü`'(N'dC6AgmR)À‡tœ wÄj%›Æ|’$„0: 4W'-²‹­Ðò˜ª1Bï”Á&ÐVì,ÏôÁÛA‡¨ÓzzBÔb)\BŒøVÔß³…oÕ'|vÁñÐ"B!¼e*Â#€„ÁItSoýV+àV@CfÉ6„¨,ƒ œA 8CHA/LÃŽÂá Œ <hþC7HÁ  ,C¤€hLhžÄ Pƒ Ä”ØB T  (‚)`ëmÁ1D´Þ,‚ A XÃ*ÂÌ€`6A d‚Ì€l9|Ü€@¤øpÀ^¢Â3ÌÀHõl&àÀdB¬™(BÔ5A&¬Â ‚&”Ã<„¸ÁƒjØnÁ(l$¬‚ ,©Ä‚:|@Àä/”€ x7´À#œÁ/,éø¬ ´aVn%ø€@ PXBÂ4ÄÂ4˜ Ð¥4ô*hu–4t%5’0ÂëtRüxÒ10¡„/BÌÊàx´JìþÑƼàAx6ßé`‚8Á½‰Aô¢Èï2LKPBkTA¨R#¼ý¤H"°k@ M,WÇdPÁžì‰ðë„'y“4’A+ \Á1( ÃP, mC„¦@ ì‚( €,\ÀÀÐÀ°Ã°ƒ,´Í8Á/@ <ì ´ ¤À'tC Â2È€<€´@=”… @0tÃhÃ7Ä‚0À8hÙ*PB ¨á4`D‚‚"4Á ¬$|ÁÀ7Ä,h€P@0¤–tCtI è ¼1¸€ü€*àB°;0€ à‚ÌŒ.ÈÀ<Á(<“ÍCp2pƒ,´ä ÂØXPC‹¹Ì“Á 0œç‚PD=ÀÐ+Œ@À;ð‚.È‚ Â0°‚,8  ¤À/ Ã0ËCÃ0C;A;ê¸Â1dƒ@4œ¦´k·Žë¤67ñAÿáA1ƒ%˜k„WŒAÝÆà;¬ ÄŒ#TnIB",‹©QÁ¸Æv eòkID#Ðo+¨Ò$MB,hÂàÁû¥AuW÷s(» r»Is4Oßu³›ô¥PÂW‚¢QB&¨Á˜=2Oå(ÌD€ ø^ø;´‰],ƒ!¤Â+H|Â2lƒ0h …Eû‚ðÀ(˜… Pþ`¨‰šìÅ.ðÂÇïdÀÀ=xÀ=ÜC¸€ ¤@ÕxƒgCE%äC>¼C’c@L€Å{$ øÑ¢'¸‚5pà*ƒ\ƒ5h$Áø‚7\ÍØx ¥˜V1ÅQ+À6ÜB.$@ Ø À ·-˜Öqœi6ÄB6tÂ5LC9Ä@®C  :¬Ã`ˆá#N'dV9”î–BM”Äã'<ª6ŒÄ%¬ú4|Â+B*|þ+ü5É}‚ $Ã(8BéÔ.'\‚#\Á*lw?Çéy¾' B°à/w–0ø¦0þˆ@.ÒÁñM;xLk$¯*­Sˆ7½=›$@ÛLl"Ø)[ƒ> íú@„}Ϋì‹~2T€ŒÃ½¸a ú¿ |B‹¼çSCH°ÂRY´ÀLY%P\+D‡ @zôp¶ aB„ 첃WÄ-dyÀÂ+ Xð$•/Ÿ^]ÁåÍX rùŠµ,v‚ ™ÞˆÌ8fm—;–D YçÊÔU\ÄèäLJ0®D @m©+§P  »†n]Öu0¦•Ë îÙ,(NA‘VJˆ´lÒÎr)5Ç“šVBæ”zKW„½zK% Ëœ9fÌhÑkFHþÞ¼œº¼á³‡ÏI’Þ8Ž\yÓž?›ãP*´åUªT• U2*ô+@¯lØèÑĨIœ]òteË–Øð°ù²ŠÊ3ƒ@ý&lÎ%!¥b•ÒB©U<âÚ¬…Ñ$êU截ªŠB˜ì„áÄçϤI­Ú°¡4g•›Bk ZUÈÍ¡-­þá“È1NÈÈl:ʸ ¨PÁ àç%œpœOHaÁ‰` &)¶aHHia€M,Q ¾1â‹C a‚].ØE…W>‘B!….`ˆ˜"€F—m`%’ae$Ѐ‡$jI€$ÆXã _Ò ‚œ ˆ¼”Iþ‰'–#Š,Ö¹dJ²p$‹;ܬ‹l–ðd¾NA«”¼ìJ,¯½ø*…°ÎÖC„*i¥Pâ˜$ÑIäõZÁ#M´ØŒ“=i„º=âØ£•MZ•ÔMDÝ„;į2Ç*“¤±Veå£ Iö•K1 @*yØWH[-’T ¦™KªØ$Ž*¶Xe‹G¥•Lô¸ïK$UV72Fˆ*Ø@äAFu4ŽC5!.™¼KL‰£•ÑkJÔhC¿/,±d>@ð+䨰ē8âàÖÆÈx˜4èP t°©`ÁŒŸŽ=>qâ¾a™3œÐþÆ CRøáÄøE¨©dt8á‚ dQ¡…s$Æ#Ðå‡lbNÐe  Ž–ô¥ê3å §›@âY” áˆÆxd•6=ÉBO(qLî Äð(¡¤ zMå/FèU¸Fþ UáMTä;&Ù¤29ôpfGeöpRí #ŒMÂØãó=(Ûƒt>ÓÌô?NßãÌ"kŒõÉju¬‹Ù+3½öɨk¶B)­_ƒ'­wHJ³áŒ3š”,À(d•W|ECšX @丄87Úkã-И´íÌàƒÓV ßl´Ì*.iE2qàQ+Àð€$xƒ.P$¼QÅ4x+dÑô2 ÅšáˆïTŽm°ÄªÀ·:~']¤âÏ&¡°®ÙLé6á>Ø!|`„áú‡ÃŽ^щÃæú ;ÀÊf`Ýc.s»ÉŽo`!ÓªL½j2o Ýd(#«É$bþ2šÏŒWãe"Æ$Àpˆü”æÔ˜Æ)¾0Ÿ-Ø@`§8D$–QË3À ˆ CÔ€:TÇ| ãÄ&8±©AÄP±Æý(‡r¶‚#gn¾@@Øày…Èž Tp†L`Jø‚#.шA4ÐþÏa‡6ˆ L0 ,ˆÁqƒÌ¸)(`PÀ ÔpC(  f8!-,‘/ qà¢X@Tá _<@¾ø€8œAS›`øpBœ0cÔ‚JHÇd 'ÈàIøÈ• \ð@ ŠH’ È‘€[tc Î8‚Ltà |Œc €ÁZæà–qš þÒ˜úâAŸxÔä™@Ëõ1:ÔI¢ÒeD`î”;TvúX®F¨ypŒêøhÒAæ dà”Bµ‰Ný! šiÄk‡Íp2°ë{ÃäÊƤÒp Å"¤UyâÇE…Xf/Q‰O\!¥Â*„j 1 4Bz€8„ VÁ†6—Œ¸æ&·ÿbn’˜eùÃËrâ ZÈáZñƽáá?kðð#Ÿw¾"‡ƒôÎ[ˆ+´!ÒƒÄV‰ã²Ò¡(g2h=—¦D¸[',´énQˆþÂ*¾+\!ŠC&Zs)¤@Ø…—Ø-UŒ „¥I;1:¢ xHŒ;ÚÁ„† xMÁ@°à*CF7œÀ\â ,tPé¶*€ðxã ™8Ã4 $ â1˜F(€XëÈÆ3*  {ØCãðÁÍça`à¢çD8À74P[xCW8Ã(¤ˆGŒãÍ8F,ŽñÜã GÀ€T£×ÈF6àÌ(4ÍàbÑ aHƒíÆ:°Ž¢@!å{9²¯  €è>„!Üa‚'³Þá‹X˜¥t.Åþ~}Ð''1Ò 3[Oq Ä”B­šÏK9àÌ E  Á–A8êõƒhDa!ÏŸ^k Òü¾5È‚gËѬ¡úiC$*ç¢ hÐCšê– 5X‚tˆŸ5ÙÀ†ëß–.·àôà­€8$ä°†W(Á2`ÆüYг»2¡*L0( @A ˆã›(áPEßD€ßJc2¨AäAø^>ÄÌp`¤À¢¤€ @À`¶àä©à<" ÁÜÁ`(!NDÁ²àÚ°€ (! СÀ¬ À¡ ¾ fþ`¾ ¬€–á d@ ¾@Ra ¾àÀ ¨< |€ š`Ÿà¼þ”á`` î¬øi¸€ÏðLÌà¢P!ÖaÀÁ  Âb šÀ hᚬáŠ@f€ü` 4á Á¹à:áÄ ®b(Ñ+ÐA áP€LàDñ˜`ÊP€í¯¼BæÚ.!¦!òÒBö¢OÐâô¤Ab9DAá ÎÊ¡/ò‚ < . Øm½l` òã A5ú瀭ùœ ¢/×ÜÀ "Á ä@îàÄ+Zþ%z¨€ V¡x©WþáwzçWá ÈP€º¡Èዾ&v ÝöOäÐ!'ϸ£ ¥$¦ ÀV`þ-ƒn äAœÀ pà~ ‚Á Îàe´!>º! ´p ¨áxÀpÌ®à ž$¨î@ðAØ$â'²`˜€ *€¬Á¾  4 ®eaÖ €Z@ Æ@nÀ4à á>Àñ8Æ` V > \`#ÀÆ \ÐÁºÅtâa fBÁB¡€AHÁ n` áĪ n n€dÀ ^š ¬@AÆÀþfáPAÛ–¦¡aà–aˆªrà ¼ÀràÔá ¬àF!ÆÎ8\AÛB¦ïªA 6.aÍæ@¸@~<á]D!1:Aâ& –@ŽÁAN¡¬ ¯ ¨á\ :`Z¢d®± l l?xIXz…—èc™–o™Ð  ÀgÀ@Öà®@Jc E5*!¦Ð4Hã€æî!t€2À´€ÐA: "ö$¨Ì €îbÀÜ‚ZÁ Ò øËB (2B@ ÎèAl~ ÆÀ ºÀT`,ÀpàBRþÁ~A ®à €¤š‚IÀ °¡ð@ÊA(¡ -ab¢ °Áü< ,Á° ¶à° ¥4 `©@ÆÀ ¤ÀÀÀ|àAéò3V  bäà– î ¢  a!Ða n€ СMBD„ ÜÀp¼ph”a ÀàŠ  ÁæÁ,¡ Š f  ha7£ š ð°i 2ašÀ V!y¾à ¨á `á¤à €Á88õ`À ê@ à‚¡ V.A€Q°DÁ ÒDþ€! äÀLA{2 ¶·ðSV¡ºa¶òÁFßA½.àÚ¨ÐùÖ6!†OÚó â÷΀ž,V”À÷ʨ.€žBƒžÊ(ËŽ@5ÙÁœ`6B%”B#T$ ËìÁĘ ª:yÔ#UÒ& EpEäX¡¨A¦„>¤žê€ À ºA HÄäW€¸–¾` –2Aü  î`@Ü| 2 bàäà&€Áð\ÁD!€Ú`†@,!’@ÇVÊVA€ Ö@r`ä€Ƶ š@þ¤Æpv mc Ö! "èÎ Êáf Æ ên¨ Þ–îìn¬ž‚íÀàn8´Ààp@ÒVáÐ!Ð ²Â„!î`ÎàšÀ”Awça–Á žÀž`:!!²@ 2ÁÆÀ ´@t ZÕð@ ’cNá²ÀÒõDán@žHá ®@ÊéáYÖ` ž`…t¡º!xaJ ʨF*>žç fXÖàR!T zÝ€ KzÈhë. &ຊÖKî B h tÀ2à”@ jþà€ªJTõ bV©¼¡¤€S$116#6!1êEUtÀø!NÀ÷Î` wX ¼8(Ì Ì¡¤ #—Ô ¨âžÀà¼{Ï`låàî>à ÖÀˆà ¶ ˆ [D¸)c EšÀÁ† –Πx‹^!Á r`r,îì}=!ºU r@ü€ªu,¡”¨ ¾ ! ¨`¢ ä  ˆ€ Æ€ÚdÀ˜à\`"`èã`I Háèá ÜÀ÷!€!½Â! à&’R²á ä \þ(á Ö|Mï á€19 àLA¢Qˆ Ôá5¥ nã6Wä ô Ö¤9›`ä `€Pw¬ànÉÖà>à‹u`xáø¡dŠ¡œ!ÝîAiÌ3*!y>x£‹A Àiddä: cYÀ2 ¤L @ €Ø¡|h½î!1`‡àB€ÎÁÀFÈ Ü-f÷!”Á¨¡,Y  ÊA/! ÚE‚ኅö Á¦€èÞA, ¼%ÆÁœG·!Œžà’€¨ØÁ>@€ k[ FÁx`þ<` ¡JŒÀ~a²` pÀ°` îàV¡ ®Àfà>¤@À¼Á–!0[À^xÀ ²@†ÀpÙF V  žÊÁ"áæ¡ì  ÆáÆ Ì¡Fá ^a>à¨à ¡Ÿ ¼@x ÎÁAFà aÐûlÀzàŒô€ Á]Á®€´a„af aX-À5¡BA!@¦Aõp3 ¦nÜÉèÁ0 < θWá–a an ^ar™p ~@„+’ᨂ„×þ+¦{&‡T6ºžX!/ død!’A/€lN`Bda ¦àÒÚ ÀiÁª”!&ì~ø¡¢Üò‰t@ XHF †aªUfAb°u(9r@P!¸@/„aA@B! Ñ7¨XJ€—5 ´!¶¡ÒÁà X GXá @d"ÀŽæˆáÚáàâAVÕ¥æÚáÄ~Z ˜á’!¨A ~àÖ“áÚ<ˆ¦i|ÄØ}d ‘ @¤€×“ŒÚÆ!䀙AH®@ÆáZ 4Ý þ^€ ×` Ô “í જ€àH@>!&àÜàt(É^!œn–a> ŽÄ!\€–N?ašè½â’’¤táÖH?á ¾€Û­àNLª¡ª z`΀làÎà ‚'HAb^Ü*·ž ¿áZàd£O €à< Kxè‰vAÄä<v¡h@À ðaz†„""Në#:Æ ‚Àë½Þ Â(Œ(€ÂÂFh&DB|a«A‚jÁ`–¨Ár`º °Àt—` ¦AZ”ð `…b’ ŒÀˆàþŒk ^À€Z€bÄÉ ÀX!xÁ€€B ”`”ê Àôaý#@ !0šX€v Œœ£!bv€„¢êw?ØÔœAcyæœÁlœè2}’Üu`†¡£DøgèA£ Tøá­í/€ Ú{À=àþFÀ_ÄØžNh @œÞANÀ*—ú&v`ȆӋ†XÀ`Jù÷¤ ^Á…­kà81 È„!zÜ;‘‚Z²z´ ö„Z*@¤®X±òê VΨHÁbÄ„*l°àeÀ^¼ =Xp€  8@ @þÔÜÈœ'¢òÚd?X³j…@‚“nÞ5K¶l_I4áð0Æ+-äVI%õ‘[h@°Ê 2ÃÃКO@=@Œ‚†é¶à!„ ªlZZƒ=$wÄ»,‡Áê`Û@À2?03ÁZPOd¼°C1 t‚,;ðóεؾS“Sña@Â.Aâ4 !l+[TQeIN!0…bþ·[¹T]pA:8£ F Ïg4QŽÂø¡Ë‚»È Ĭ°‚.NЈ£„›µ, €7J¤VÀjás+3(‹‘(F¥ä <P@HMYÔQI-•%N;ÔLUSW`‰ef™$±ã –µ| „/D¿9”7Þ ¶€€Q€ê„ß|qE&˜ WÛXðD%¨àp!…œ,S  1 …Pƒ@Å.ˆ:êk¦SÓ Nø»@xltC£ËJF®¤N(Ã4ÜJÃÎ8GÊ<°È@‚AL7õX„AÅJµçðò?La-þzÖ‚  '€€@áÍÈëM2(4#Ð3¸ü24‚cü Gï'ö \ˆ¹/GðÀ2¬±ÆH$°²€ÀýÛDÐø ?D0I° µ/PÌ €”€#p4ìGDÀmôÈ=þR£ JCy™•jB·úA{Úë`ý @¹–+áðJP¿ºð…õãx ¤†M¾X` Ž1ÀªvµdíO5è†7¾°…/0ÁcË3\@B¬B)â‚)Øï `Á#òV Ú5+>‡"%q‹€.ìâ‰ðy…Ëcþᦀ€ @¤3t †ÊGêŒñŠTÁèF);8èÀ;d!­LÁ¼{‡þ"À‚–€Àˆë`Mä¨G7ŽÀ“ŠCQát±ÂÂ9n ?0Àը׼ 8ƒ4Àv„ƒXÖðÃ-Î?]HÐØ£âè”$À Æñ$( †/¢‰¸êqs @©´˜e°JIGñZøAÅ1®~/0¡>Q¨B܆.ä˜P¶ôG#€pMQ  J|ZÍãf† «  P:tC ¯h‚  %m=>|œÄ;BþƒÂREâÀ‡NuZ4œI@éZÖD4öh HMêTÆ2„`E4P…’°€•)£š(ä°† (C ¸Å-  r¡'D†¾Á3'P@úxÁ 0€$ê$€Jà‚ˆãF €Ô¢„¥â”q[h_ñ*ŽœCø@jc@Œ $'s½zÀ7”a0×(Â7x°P#ªƒÝÉÜR§ÔB¾PÂ|á‹ZM-$Ía`ƒ'HAß €/xà‹ (‚9J”¨äNœâƒhAÙ“' ðÜ5ùäºØMÇö1'ì–hà ¯x‹VSÀUu´B´\þP5!wc€ÌD \X! 9øL€X Æ@À(\`×t$Á°@€tàÃH –á‚o0€Áµ(@ƒâKi-û(Á8` |tcÆPËÒ'T0°0N‚P C¸àÚ,@OÀ`‚ØX„” á5¨Á-”Á¼à/èFd¡‹a 2º@Æ ŒñzàçÇ€^» 4p.(P\P³¨…7ö!X_tCTôØ ‹€}<À²À¼U” sŒ!À€A5ž±1$aµèFœ (!¨Úõ†  €o, (cŽ¯-lþc, À… ñ‰ÓVøßÄ‘Õ.øNwvºk ,”¶«Cìb7)MBîx‡ Þ ¯¥ã¸Ñkë>j`¸XpF (hð#Eüˆ/X€&áø€Xm8ÁDE<â¡ŒsXNôêAy`¸‚ Æ‘[`µøÅ70|£ ‚Jü"IІì‘Q jÚø÷Ìq”v Q#f4”Ȩ“9€ìØchЄ– ˆ%Tc@-PQÁˆ] Œ¡€.@/PÀ/rá_ohÀ õø…PÆ!{ðÀô°ÀQΡÃþÄÃ=pÁ @&w,¼£(£å¸À/|qv$#=(Á(¨¡ eXá Hð*j  ÈãÊð†å|€ sœƒ§±Ðâü èøÙÞ°-ÆÆá'1 òxBd ŒªBh>ZÔ†›Í¢1à›9pÁJ`*iÃòð†d`ŽxØåDðÒ4Ê`¦€pAŽ´7Y€½×†ÈãA6Yópí ®oäé+[À¨3o ª#/b£?Ýé"†Prp…×_õ€ÀÎ0 Øãÿö0Ú`þóÀÚ€ np-` lÂCµ0 +dþ6D ` 0hp´D`ó:8‚0ç÷   Ú0X¶P ÀdÀ°sE f§ @`Pà ‹ÓÕ` Ó` àÛ@5;ØÐ uÐ A€ uP°   æ ó k'#ø€ `ò€}È(h£0£à£ óð ö`àõ@Áðz>  ,èê@9p¿@`ÀãP–00 0ó `  öЩÐö _Åqß IcÛ·8m.àÁ`QW¯w2`‰`p08FßÀþuð Dã Ô€pà 0ƒ­sˆ'pö @}F>¥v vô`Á…Mwöp€ÊpŒP‰ÚP9ðxÂy9° J¶1Õw59T90Š€¢ º<ç0'° ¯0c VàúÀA€° @IØ3à¿P9¡Ð L€™ð 9`>ÈN¾€ Ô°4 •Ö€ MÂ0à L  >3 ÀP3ÐÀÀÚ €ó` Ú~ð“2Oà õPèÐ³àˆ ð š…‹pQ` X K0®€ë°•ëÀà5°Øà³þ –~0†0 5ð ·` LÀ’L0 àÀã Ú  (` <™—0w9c`EV0Â0LÀàp £0LàÖà’3>P£ ùÒª mð 0rÖÀy‰ 3ð ó  óp™° ÖàƒópÞ `C¿@#­QAM%〠¥Y(PL£ Ç “¨qÞ pǧáD@xñ >0(”¿PœÀ© ‘IœLÐD@aÃ&@Dî`g`3ð-‰˜ÚÀÖ030Å©Q3bv' 8vA7¤cv¥gpyÁ ÷ˆïÀSPþüÀ g° O° cpr@ðÂòÔ X0HÐ_ HPŸÖ0 80T€3° †ÐEñ«õ _À€ð9 šM@šÀ(À_ V_p¡àMÐ ¡`ó© Çð“šðLð £° _0À™ ‹ ¤0uP}2paº¤`à1€« å ¡‹@ ä dEàsc€ÀÀ K`«0Q`š~`““ó@—;© HpØp—ÚÀV w° Y@¤¦€…éÑ ˜p ‡jŸÀÐDPÉÐ 4ð :p¤@ VÍð è ×ÀSÚþ¿0Ð[ c€? ¿›O€ ð¿0ã - g€Uê’H0Ò àÀM™~@‘ððßðh€Ac®õ  c €ÈÄ«Ñ€P¥a™£&‚ä ôàíðOð2  T@Ö€Àp Ž€Ä)­3¢Ø7 R _@ Œá FPõG£CláÞ@0p>qô@JqÓ0¥3ö: €ÝðAg p c€ÈôQ_à¢À±Šc° g@Zÿ&R° _ Œ¯wM°¦X€Ø€V°X T€ \p°®àQ€1àCþY ` màS›>¤p`H` Y¨ìàR` QÐXà –àè` m0\°Qà™Ð DŽ°†0Yp´0 V …°[«…pzÀ« «€®€°™ð«c¢  k zðrPW°–° Q T°¦Ö°‡` SÉ% ð`P ês7pcঠఖp‘ð3·Š` [Ž` 1 R° ¤° QBcHà ¦` Q•‘`µC¦r@ ù£ ¤é‹Eƒ ©°•@½T°«àÇäþ[0Y° Ž0&ð«ð«™p¾`äIR@g`Í°Kà«` 3`zPºŽ rÀ€´RðÍ° ¿5Tƒ@Q}p¦KRpÁð$êW²¬¬¬ V.``ð/  Ü€ ¸ mðÖ0·®0ƒÚz@¢ú‹W0Ô 4I ¶ r rð…À-` w`\à Àà z¦ T « [Сp ë®à \ w¾z P –  º{ w¸Ó€Ó€ ¶@<@¶±0X°žQ Âà‡° ž ¦p––z`þ ³ ¨c°s³  p\0zÀÀ”pXp§¼ rp¢à M™„«È7‹QpÏk `ê=» M dÀ€ Q@ €ÎÐ÷ [PP °Y`npÖà7PP@¦@ÊzàÇÐM€ 10Ÿ‰Þ° • ò¶°Oð rPw°¦_ð\ r1pK Cðœ…@¯p¸à }R°ÀÍW€¡np3 Ž0º¦ ‹ÀÑé#@%À6Dp«`2p ž` À 7»À0`ÚHà`` J{¬2ä;âS¶IUuþz€½xÕV²¼)pÜÞ£0 `6ÁÒ /P ŠM ! 7=ÆÇ@ÆŽ ñG[¾'-À» ‘p2 ¦\@ºrà \§ ‹àŠ 3€ ` Cà~p `0å Ê¥œ¿€ €Y€wÛÙ ÖP@ñPÍèp¸Uà 1ÊÂÐÇ?ÁJ ÓPÏ ¨M€Ö€ c`r° w0ÌoìÀ Àm wà~ ¦ž01}Y¹J:¢¦°ž`Êz¦¦ Æ`°üu-°Tp¿Pv…0q›Ñ7««àQ` þù<ÉÇPß Tp*ýŸ‚.€ « Ö° –@ r` ®°—Ûn@ ‹p«`_°¤€cä€ÀPg“ À[Çp!zR™tÜÑ0FÀpFОû•nŒAÖ뜛»W (à –- <»ƒ•° ©@Ôȧ@aF7UE¤uç€æjnú@/3R`?°5?€-²kä¦ ã{-ð `0 €rðDÏg@ ‹0E``p¸7.ð0{`’™ð&Àþ½€ÀÏ ¢îàDÐ Š èõÀÊ 3ߪyþ5@`° (¥wwpQ«ÀI°m°‡à¦€> h0 ¦ÛÓ àŠ'x·®ÔpŠ€¯`>@r°¨_ú ¬<>‘PmPœ«ÀMú š@¬¹7P¨Ž¸jt W°¥±»¤€Öð $pÅåâ`¯ 5°pgà‘`(–0>ðÚ;D›· ‹¸€7³[¸€4,5é€ÀÙz€â¦¼Yð¹H\»Ô0Ô*’¶pÁÐ|〠•  ŠpL n ã°€0gPÐ üÞvPOðI þ`.ÐWpUê«ñÚ„r@ãœÚÐÍ@ % NÆ~qGÉâg ä‡g ßT:ƒÃ@9q!²NÀÐ0Q ùpÄg€¬P )ð 6Ð À)È’ u)  0#s“’ „Ï=°R@ ¯PRPf€ WpŸ û4ð$ða n@ çð …p©©pЕðø«€ ‘À4Ôà©@ ,‡ð…ð© •@µ@¿@ €p© Ë [ œmþpý!1RpgPlc*ˆËàÁp±‚'þT¢²’’zupÔ©¡à©e8tÃa(œ.VNx’©R!’Ôˆµ¨´FŠŠW6nÜXóƲgZÈZ0ÀJ!)ˬ%¥Åƒ¾ñ0$ç—Ex`uÇ“§9†,Ê¢ŒÇšedPãA-On¬Âu¥RªÔtвe¯¶Ü°IƒxR¬¼’BmµJrl~¹ÁÁ®WÍÆ|aðäË++ͤŒ `åŒ}¤^} °lM!R¸ @H§Á›¯.l;öiÚ´-t `,œØÑá݈ :ìx¼Øñ»Š©HdD1ø!ƒ²7yØŪÇ2ŸÎþôØe€— Y*T``ñÉÆ™»è.Kу—Y#Bœ¸çjH0B–3TèA–ö>Y&T°¡<ð€CA  0B…eJè¡UháŒeZèE‰ &è†ORQáŒz©ëv¤@æ—R À Rº ‡3péfH±!ŽÐƒ>Èá )r fÆ¡À/_Yæ“+Rér "`!„Œ8¡&)—a¥=@R9ARPšW>QA¾TR0`ÄyBŽ/¨ùD+*Ë! 0Ë(°‰Â‘Žq¤Ò; ñäŠ;¬¨çœW¾ð铨E š¹/κ3ÎH)X9þNdiA‰oà ‚`œX}•)p)”å H‚šeV•õŠ>!åRœ€ …eƨ‚n| 6 €Ö]·6wuÑʼnq°@Š)æXÙˆaŠ)Fb‚ ŠÙŠÉ‡—|ò¡ d¶î„x‚‹da‡&ðs‡ï< wÁ`‡daÅ€&‚ ð(VXȸ™1Àà&pF‰<ày‚#Ž˜à^0è%á]H¡( !f^J(!B8%¤¸'™2 Á_ `%€_ `dÇ‚ÓXƉhÈ tHæ&þ ›†^hâ‡q¾ùj€pÀáfXêAð2À`ÀŽNn—þHp9=ZH¡izØáb à“ðñ&)phaè9G‰/4©À&†Ç,`â *pøâ ø—žÎxbœH|ñ&bxa…Ö’6€•5æ„_xÀ¾ 4ЀrÀE†l!àœàzl@[¼1ŽO"Ì`.Z/ tÃõê†|Q‹`µð†7 °Á º‹6 ¸vvC ^¨l ô(†,Px~ð#9(€€° ðƒe {2$†€¤®„}Èx±þ]ÜcÒÙE<À‹ ´éF(dÑ )œ€¬PA,Æ‚–…`'`EÙVĵ#„@4 Áœ1F˜L:)bœXЧ!z ì(£rÀ „ :Àc2ú¨‹ôèƒõ€3NS‡•àì[¤"±•ªà–Û( ÔÝP@7~10Ã-“Îdá3…€#¸G”fšÑò•»`Á^Ù²€ÀlFP[&°¸çøÅ9¼¡Œ(ÃõІ`s ã€<‚á £¸X€~a‹sÙbF8'=îqç‹=TY w°h`åz€7P‹$þã9ùFP‹€ 8€ÆŒ(ÍÓE¦à„u!à øÆ9œÀÀ7v%€oÀ¤&õàiÌá„M²í ²ë+ÞŸOÈB p4À;xñt0ìÀøÁ ~È«G=ê~  hD Aˆ]XLx4.ÆDà; =¦àzŒ€?(4Îq†ü SAS% ¨ÂêPu  UA!p |á/fôâÌAˆç©Sð€*JЋ{áGSÞHà (á´1G=nãf8Á ÈX)1TÑG%`à4ð;2p„°þÃJp‚1”JQ}° 7/ЇhÃz@®€ "Ђâ°"ª'øA2"àDÈ€ TiÐCª> /0°$uL@ÉÐÁÇŽP‚ÜC]HŸ ’€ Å8l nP~½ÒÀœê'h\•ÔÀNˆ€° V胋Bð@ùLBü0ÞHÔBЧíàиvñƒò¹ °…-4ð$á¤(M)mjâ<2M *Q§´Ñƒ? Ádx€€Ã¤¼ XÔ¡Ìø1¦J Z`ªRUð F høKêY°s§Œ þ…$"P§võ¬ÐŻƣ9ƒ÷ÀÀÔqWu¨ƒ ª  1‰ÒƒÿŠ@@P!YÞCéõ›]½!Kq€[´¡€.X`ŒËß îd¥°%°ãTP‘/þJ€} ÆpA0¾¤zÈK^ßpèAx Ì †wàT@.ÈóŽM^€@ ôˆ+1ð|,> ¬ƒ|F¨Ç­ÄÐ…,,úÐ Ä‡à † } p[,€Ò€S§@ :Ÿ€Ë¬û pÁð Dñ…ûP X“5 pÁ¼AAù%a¾¸X/z±‹]\àþ$/ùÇ0€€~‘Â8ØÁ”n  €9,À‚!!à ß)Há'tÓÃÐ2Þa°]Œ€B 2’®€ ¤ÀlQBÅQ”N‹c èôº°C.O{úÌÆààƒëòöŠâ><Àø@-JpŽ)Ä-Ú€€!GÍ '°BNxAf ˆC¬áF8„>A€Òû°@Lä Ü   @v@¢ôÅ=~ñ)HÁ ¯ 7Α„Ào™xÂ2*!|, kþL†2àŒdÜãgÎ@Z`ÍTÂpUd8?H°ƒô°àH–¡#,>,v¹î›¬ ÅËà‡b‡às‡8‡€²…|€‰#¨`Ö9Šs€b ð•PvH†ñ0¹¼g¸€(ójÀÐ`—È1ßPØ]¨ƒe`³Cfx‰­›Ü Ÿh2}` ¨zp€¨RX¨ŠJ‡œ 'HŸZ؇tYøqQ¨‡n0‡P€q0C]hHx(€ˆ\€ظ$¨/,³ýy€‰ãx0XÖ!)R€„þ`€\£_X%ÀopÀ‡sà»$ ÄZK´¼ØNúÞ0-mØ ¸  ¯P+ƒW €(!p_Й{jx“(©Ѐû †pP»³E%`<ƒC€c0>|ð…¬…`P\X@øCoøŠò€¸Ÿ™ÐÀÒ À%Û…Ÿ‚èYª]X‘`‡þó)P„WˆŠsg “‡npoÈ8ŸèÛ!Øð†A|(èðл`†€$ø…¸ž„B„ò' (gÐ HIŸÑ8#È\(€’:€þ‘’2-wQdØ$0„JEd‡n¸j‡n`2܆ðƒ,›l…:- ¸@rp„,`z(`T ¨&m e`{CÈ…oؤp‚St @† À…HXh‡ ¬Ú“ 0øs( ¨{ð¨o°_`[¨_Іoh‡v¦0 €zð¢P†S—kz€qð†{³F,€_HcصàmÐ…_àˆ:θ0 ƒC¨„ÕXŒN‘¨ ¢‡/Èjø€_0¨ó9\ø… o {è'àKh»W0‡½\"¨¨þ…eƒhE …0‡è™3R£5Â(#ÀQ‚d8˜{ (GVhGñ!r¡D¨„WhND¸¢àÄÐP†Ð0“š/Áo8o(©8€”o`à¿œ¨À>D€Ë5 hI#¨¬ À#gè#¿ ?ò…(“©ØÀÉOµ›ÃeÈXP€:Xƒ1€Xm¨ dð…¸j*ZÒP€r˜…Y€XR0^”Å°²œl²€y8_¨mð´ì? ؆mÐlˆ)Іq0e…z `e{¸ÅAþ&À &{ÀÌ|‚_°€=S °eøm-gÒ¹o ýT`S@U e‡¸á ¨ÐI=;ÔqPH˜Å`€TÅEH-¤‚BРoð‚Qà¿ø0‚걇>µÕ URèRm˜  T{°‡±OH°‚yXШ+`'U(/v o(4%¸€{`0€’©š 0‚$*~¶ §Z¨Rà €ƒº°oÀ&à€y0m(ÍŒT†z¨s¸Ôð†$ðxHÀ R`èÃkꩧZ¨Ñ ZÐK#4¡!þ»pk²±_T¸r€­ nÙÉ9•‚+@†Y˜T…Bƒˆ… ÚXðƒ[Õ‡tyè†Xxp(˜†EЃ%a`&&@kàjpÐkЄr¨n€¸…jÈ…[h€j¨† Mx„µ­mˆkl Ûh‡ylhÒYà€[P†[x†ªÔ°‚L¨"аm¨€²­Å‡±µ†`€ðÆõ`ˆ…"p€"¨?H€ªÄ 'XT£ (CXhBmèe˜Õ-„(‚g¨XÐCˆM˜…oH‚Q(Eh&H‚$ ‡ `‚'àþ/ps\p¨€_¨€´†/ƒ,ðpðƒc`‚Ò8† ø‚C˜M¸ƒ&@\*ù9(nº |e’>h;aƒ†r+7f(à¨r}Ø8À…Bx…À“’Ã@\ ø\¶EÜqð¶]Û_ðý½'À8š€Z0ŠÕÈXR!‹qpûÇ Z¾|’`€¸a¸P/€eÑ€_ØýÍÑ5-—Óºn¹,…]MX`(‚8‹ÊhrP‰¦ ?ЄT(‡r€„5(‡h‚Ýέ7¶†y@&˜$%…ؾ%nˆ…¸…kˆÂfþ¸°†ôe@a˜°ck‡à€j¨ºåÆUx†"H…Hh†"… ЄÁ倱=†¶­€ÏµkhdTˆT(?@Û°ÇE…nÐf¨dH'-dІ$…€[(ÉÍ+˜\eð1@MP†ìU„Gw8@È‹3(wh`‚ °†ÀÕ&ØÓ¸`ßñ …²m_E¸qˆ‚CÐÅVe‡•Ì›Laù‡ZpnJ‚ €}H‡ ê H$˜·8à`žŠó†°…HeÀ†;Eh¨€uþ…ÒÛÙÐÃþiA[¨ý:€ZÈ@hD úʼn{‚'ø€&,x„Uðéqh"0_çvøjà?íŦ$æYÚ°A' S'¨ƒÄ@tp`Ѓ …1(Cˆ‚E°`H€³…úù†â5?€²^7È„!ØLqp…càOhæ¸G@‚jH˜Ø€ RØ€>æ†È…,XGÀkp„(`ã(ˆ†(XGði@‚gà$อT˜Y¸…,È‚%?ðXX?ðƒ!?`$‚r(c†%XC°ãZ(І°€_Hd¨‡nTþ$XXö‡1ˆS°†ºÕ½µ‚+È‚&é-h#8) "Ø‚H8""é8(†½>$0…BÐÎF‚cðà‚%ˆl€{ïŽW€pp¨†X¸aT … …k‡X¨†[ÈRmx¨c)Àm¸0¨B,€q°Õ.]°EÑì¿Pv(`à?†c@ˆ†ø_~E–`ø¢Hr U¦Qp9nŒÀÿ”R ‚3ƒU =ø.ø‚1QÈ`Àÿn{ @X€™L©^âÚs`'À@¨åæ€1¸M€þÐ`h=(kH€0•/À+ÈT†,¸(9O°J€‚áö„,È„¯EX…­µ‚EPlm1HZ …hXìX„U¸ƒUð0°Ë.„-7@TÈ‚1ˆC€«´Êµ$€=0,ˆ…(…u€‚(€‚uØG0S(G@T¸E=ЃhZp€3&j0CÀ+€€q †T!K¨X¸âX q†Y¸o×9X„Ex"ø€J°‚Qø‚JH9¨„+x„C "À?€ðón‚/ÈÊ;Ø‚ Sh.ˆ‚/X„LÀ‚þ&ˆ=p…%ƒcˆ(˜¨†lð„(@C@Th†l@‚k …i°†E IY‚/С6=l@À…$Øè7»¶8ƒ·)x7h‚!€‚%X…EˆaÀ,Àv̆/h‚ž€e˜Ár¥Q¨‹3ø‚O¸­ŠM‚Y˜OG G8Op„%àSˆ‚uX<ÈH¸‚+ˆÔ k98ÏIÚà–ºqÕ:ƒ[€ZÐuMà¯%ä(ˆ‚X8Õ'¡+h‚,ÐKàr†!(üÛ.xZ^zlX¼X0(„ó•ƒ1À¸èÒ1@÷jàêX@‚UˆkpèþõcpHÈW‚U˜+€MX‚Ep¸†ºõƒjȈ5pmOÀ†L¸*¸‚Ch‚&.À‚-¸`˜KH|0h‚X˜Øˆ[±nÁ˜qæ‘¢5€Ülc”cÖà€ mC5kVÚ4»IƒfrnhB'‡K•¬<²´ŠJ¡UgLœ!- WÇ,9¥gÑ;W†,’sLØ kYňqǶ`€kº.›'7–²Ü¹Sn‰GŠ€»3¤‰%O¦¨lY…K OwVÝQÔ,Ç\g ­zHÑ—/‡RURj–À‹V ã)ʪŸ–2YQTIÉ!@­YFjÙ\üþª¥BÆ—Wµ ZêTY²@Áâ‰K9,¢Durä¨Ó*†æ=ÈáíÀ¿ @@7'Ò!P¯®Í ')Ö<{VAÙ9Ï”¹9£J e~4|Ó`Ù+–?ÇÜk$7ӆܑ£íK&Qhãˆrd1†)‘ÜF8(²ÄKÀÒ@. TC 7c´a ÀPÙ"Âp±È"Çø1Ä5©¢É zÌ  * TÃ8r˜2‹wÂD$«ŒƒÍ*–Ü‘I4\Á“"+  ¡€Áâ-ÐâG9Ïèq.u(Rn,ó‹>Ì€Á1úÜ¢Ì- qÌ!Y(cÈ!58à&ŒòþD,#“ rÜaÓ/£`ãÊC á†'X,"T!‹ ÑŸ0CÈä!à‰à ¡hãÊ5è,qGHd¡‡0Y,âÆ!Žºj4á‰.Ífê#34ñÅ(á 5•, ™ŒñIœY‚MYŒq¡G6Š !Œ#]™‚0™èKrÄ 2<ñ óË7ì¨ðÁ+€(QÀàÍÍrÅ 1„bJCœ 78Ž¢ÀhÄì„2ÝÐsÐIçDuAðƒ. àbÈ È£Œ ¤TòJÈŸ!…<õxó;$<ñ ÔH*¾ ÀéÜ`Â`XòE4ÑÄþ*rlñ‹ FÀ¤GzDK9³,Î5³$ Ì7,‚Í1n,âÃYDxøà Öl†.=´  (SÃPÉÔrÅ#¼²ÆÜðˆV€aŠb]óÌw 2j(ã:\Ì€„'…¨uƒ'eÝ$RŒÉcX2Æ8ÍBE=0 Ì,M@¢‡ÍÜáƒzX *šd‘ÉDH°…%V|ðÍñÊ(Â]GÐA |q…5¼V¨Ä d @\áR 0äpˆ” –Xà ²`‰BdE‘È0šÏPDá zø‰#Êa…;8…0'^q†5¬B ŸPÄ*ð €Ë(Ä xðŠLHa¢‘.ôBNÀ‘T€"Û„_¸@X@rlÁ ÁÊDP"…„b †ÀØp ‡,\#r¨B,î°ˆ(DÁJˆ‚!Ha  Þ Á+¶°…O€¡J 5d`…UÔ!¤ÀÁRpRHAdíª„ R ²xA€0ÐþÄ,‹a`S°)V@€b!` Ž. 82X€-@ )ŒçX€XA‚t€$8N€°bÅ(Á\À”ÀIÁ#xu+È¡ DhÆ6 À"uhÆ„A‹# Kh†5°Š1„‹E–ÛЃ2”B€(CÀ…%üp @X¡Vðj‘ƒ'xO%*Ѧf¤b "…&@‹"T#å€A!ƃkdMøÅp@¡8¤ˆW|"…`'~q™x©†à@,j` 9P·@cðÐ`ˆg s¤0„þªjå(Çmai%E"“ð…BÀ©Ð‘8ÎW°+&ŸA ^ñ Î.C Dð€^ÑÈG,£ Wpp;¼A@ O çHÑŒPƒËŸø‚ l@Ç—¶À¬Ÿà²B¡Rèyºš¨†!6fˆ/œÁ¸‡/B ƒ/xC _hAø– $p ÖXœøš¡ÂQ4£RhÂ<,0Š3,ò4š8®Q\  Gb+æEècŽÕÀ¼á  <À˜ÏáàS`E P ~L¡è@:°ìbÐc@¼Á @£‚/Fñ}( È€,6X`£ Âþ·QqL| È  @/d±‹!¢3‡=* ‡6 A[nÀ&5~Ñ<àã]@x€‹°ÆÚÐÆdÀsØTõP†=f0XX£~`Àµ€_ÜC:È@ ΑxÉà JÁ/žà†J"3«—4@{øâöÀ,²Ž@MÃBÑ„QŒÎ«a€p?>@.h …€‚"ð‹$øâ OA3´œàƒ¸‡7êLê{ü¢6B ”0€hÀOÀ( ƒoä@ Ÿ ÆhðM·)Á÷ð€*¼á‹Z´ÁàŠþ@C >À…2Ší‹tÔ#£P ŒS8 P8…(Êq .ˆ À†¡:!9`A"ÆbQ(¨÷C€8À¡€\àΘb]dÿÛøºÑs< .à•°$ð`˜S/òñŽbt`Å(+8Á;ä_1¼Ã xƒ1€7䀨ŸhÀƒ|QcuQ7P@0(€(€v ƒC=(ÇÊ$uC¤Ã>C`Œj¸ÝA]&Æ1Xà Œ5(Â2HÞ9@Â,€xÃ/Á/ ÐÀ/XÜ7´‡7<*DM¼œúþ;(|@2Ѐ â„=À9à‚–ÀŒ‚ ¼ÂøC-ŒÃ2€¼X[á G ŒC|À¿ @0àŒÃ>ÀüÂ/œC/ýÚ|@ü@à’@Æ匔ÀÀè@«é@”€é „àCkÀ7D` € |C ØB¬"øeÀ¬Lœƒ6ÜB¸Ü5øä\¡Â5\C,\ÃB :ˆ(œÂ)”‚(ˆÀÌ(ÌA)˜ ‚hÁìÆ9‚Â%tã%\B)<:_'t‚ÄŒ@÷}_øMŒ9(À60,àþÂð€qPW€øB" €@€tX€äCþñBþuÃ0äEþ£1@@0X@c€0Ö°3¤_=œ?è4ô‚.@à ðŒ€.Ȥ°³µ@€4°+D¼4ð/œÀì+°€@ Œƒ6dÂ#”ƒˆ0œA!<À¼(Ý9 ý=àƒ*è€3”@( à(Á/AÌ8pÀ5ÔÁ C0˜à=„À=L€3ø‚Œ`ÞÝHHÁ/°å(Ü€"|‚3` èê_²Ã\˜*L è€/ÜÃ=|@ôÂ=|ŸЀ™i€‰^,~€ þxø‚¶Ù%¼ŸBÀ7,À,ÀY@hÉÂLÀ”@ðÜÃ.„=$øÂM¹¦ä5,5´À}%A¶%È”8À*L: Ã:¸tB6ˆñ=ß<žÂ%xÂ:Î\Â$˜A+Ô§4#hL Â$üA#èçú'9Â$h8–ƒvc)HxÀ\À8ƒˆ_u8Atl5B|ˆ¡P)PÁ"¶f±yC Ô@ ä7hd>¤À¨ ƒü@ äBx êAÁ ¼CŒ@rÀjíÂì‚/Œ@x+xÀ°‚þØÀ Ü@héè‘ÈLJ1ÀB¹ÂpÁ*ÄÄ 0âxÁ"ºð€ÈÝ/¨Ã=¬âЀçaÀlA…ÞŒ0,BÈðš¸Z2<¦âÃÈ„ŽD$ÜËÑA$TÂ(ÐÀÐ œe2A…z€dŠjd*ÁÔÜ”€©V |$tÓÌ!!€V*἟-|CøÒ7À€¼Œ† œÀ „+'ì‚\€,„ì@€ <@0ÛŒC#Žá¼Ýš„B(hÂ3LÃLzJƒ4¤§(„£4(¨”£ÂjA 0 Äþ}jÁ&ô+#ä+¿rB)p‚‚j'pB 4,'”ã$‚(€6‚(Ì0æU¨ `(°Â ƒ.àBB*Lž- !)‘¼ü*xÃ8Àh1ä ¼(uä2h$7h5Â' C7À(­(¼ƒ”:k %¤€,Á\ku\ÈB/¤@²tÀ.t+´ZØî‚“.@ÐâBÊQ,‚"´Ál0À7 KõÚÊ @-P¦3|ß7…ª¨ö€PèƒT*à@$,Ä– ø‚*ô‚¨ªBÕ.|5„˜4¬BXÏõB2š$ƒè@Íþé8ƒ¬:ƒ…é@…òmL@HæH=BÄ¢Û-:¤ |ƒ/ð€ @'À'dBÔB- ë,~\@-A„€³v+()ü@0ðŽé´ÀdÂ+ÔASŒAð–ˆd#¼'(´‚Ä#0Åê§ÃBlÃB9,Åš l¾JÂÃ’Aˆ#Ã2,Ãê« þÎÁ)0 hž  €úupƒ.P€üÀP3l”™P àB€Ô‚}ñühp7 Cä3ä9hd7$+¤À‡Q€í8 ƒ6 Ã;4é Toþô€ pžÀÔîÂôBtßt€ t€È„@D-°Bœ@2¤À*(Âpç<8ÈÀÎ=€-$ À@` [8CdŠ*FæÈBˆŠª7($À(*||ƒd«pšj,@-^A&/#¶Æ PÌ®!+”ê7é@/8ƒ„ÀeÒÀhÖ®p¶j2ôÂ+>Y'[Ú‚n. /!{°ÆàBÔB{À>D€XdiÀÜ?ðƒYî/ŒQ÷ŽC0Œ¡-| ´ÀÞYÞ2P2âB ‚<…ÅÜÒ[LÂ$Ä‚Ö'#8ìÃâs¿úþ'ÅR,¿6Âþ*¬$Dl 4'tÃ*l´Â*è‚( C4` €x°×CpÆà (èæ,¾¹Ô!2@68@ TC l¼Õ7äBTCÏv3B üB=0C=@æBþL@4óÙò‚ °Â=ô³f@añí’@1h&+ìÀ’"õU50&(€ƒ+”uTäÀî.€7\[kæþ´À5½5,ä8+è*#Aoü.ˆixC0@ LÐCÐÐð=¼+€@ì@°C$A0œƒxå2TÂÞI¡ ö€~ƒ ƒTÃ¥Z9”C,4„#ëëCßï˳<èC°?spÃæ3Ä0Ö£‚0¢ƒÜ„\4F«ŸøèÅp` ‚œƒsh€7œC-h@2·Ý02TÃ5pCÜB4@Ü…ÈH.0ƒxóÃâ@80Ã7D¤èCðÃÆ$?@è Œ€,0C @@CÐ1ðC€@ ¹Ð?€þ  LÈ‚8;ò<0¬C DÃŒÃ9øBWæîk:ç0"@îX²®*xÞ(d øÂZ~ù€C!tŽ $AР&C2°ƒ,ÀÔ"ßø‚µ=€®ž!ESv¨‚g÷ifªƒ—zÀ( ª:x ªƒäÀg€ð5¸Á+pÝЭÔBÙÕ&sx¥0=@ |Ã/ÈÀd[ƒ¼€ €.°œÃ uØD†Ý9СFÀBÐm/1 /š:(A ØL0|C”pÀ‚ –`‰ˆ€yëˆ@9<8ò7¿NB#Øï$ܯšÁ ì~sÂ$äwÃÞ3Nð 4þ‚)`Aå`6”CwpJ_ ­©)´@·}|Àø5xC/€<ø(C¼ˆåDE8@Ü‚6tì(¤)¬‚k ‹vr d u(Éþ+ÔÁ88A@€ŒÃ>ÔÂîÖC=üq:¤ƒ10^ œCÖN€.°Â2¬0À<µ5á @-(Áð²G0ÜÌ$ÌØÂ|¾€0€ŒÂ/ˆ„½Â3q@p€ À€:8ºpª‚Â/ Õ€-¯(ÁÜ¢7ÀÞÿÚsÀ+ê=nƒ-À/ø¬3ûmëÞ©±„ËÍüŠü1ï&?Àfu9þ|Š*|0xÃ/<Ô\lÀð¼ÔÀ/¨¾<¬ß½@´6š‚7¸À°Ô ~Â'xC-˜ƒ/ B €:Ä‚Ü‚&x'3X9¬ƒ5„ç4¬C¸Ãã· Á\%€Âü¶ùO‚Ð#LB+ ÂüÁ{‚¾º÷ÂNð4#49€¿ÿ{R‡.ŒðD @P[Fí2–=aðÀƒy3f«@ ªj¡fø±ö œ& >´ ö„Z¡UI¤äp! É>!£Ð­„ÝêÕ¬—‹T!Êø°0Tƒ`Úhó±/‚¬dEHåæ‡h>ʹŠ!Ì\ðþöàÛ€çŒØ" àW\ÊäÉgÎB=_¾Îà‚Ô„9V45 €³#î}ø²¥R \‘RjhÁÀ–xSFÀÇqÁ¼Éð%Wã|1ÀõK† æši0Ç@ƒ>¬´ìãrœñ6ÎVè$pé– I­I¾ýòö‹¬²[Ö| ›u -Öø …cc0.û…À׃LgÎ,0î—%(@Šfpñæ‹W¾Pâ³”ÁÁH™åM8@eT¬À=äÐC1‘CŽCR €ž ÔÁàæ\c™U y€(©AÀ›¬ø—(þf±BR²¸¢‰PÀ±âŠ1äeª´‚$bZ ¤Q>H¥U_þ9Ö'¾ b™É)×$k.•žx5k¸X' G €‚ Q€±&Š°ˆe{lAà )Zâ¹bRFá€j‘b =¬0M`•gÖb C`0DB#7¹F † V Au hgÊ©€‹wÇðä’*N9å,°‹S¤ÁnJ9&iFv$tª©A züÑG „$Ò‚m‚Vâ”ëe®€ä•e¨ˆò‘,ñä˜,29ö .¾è<‹H`€ K¶ âŒBÆø€Š+FÉ` *ƒƒØÀ;6h†”1ªÁa C ð!k °b$bh"‹1þ°ÃÎyÊ2P¤–3e E2¹c•Gª$¾C‘B¾H‚ Å=LÑd‰P¸ÁP,¡;S\!hQÈB!,QˆB$4`ÇîÑ‚Tdë RxÅ^±Š5à" €°Â+>±hè×®µˆ,¬ëw‡Ú Œ(€aŽ€D3f!¨PXO•Ã!¨‘„3( ÄS!r@bŠø„žð‰6Ha g¢à!Jà!\ÈBà–OtBåxƤPˆG\¡¶XF&¬@ %$A9 #5*!RÜ@0E(¡ÂÜa¡ Ö: aˆE8b [.rþ \`48 h° b„€ÇOf`.œÂn\0å)Ž1„!  ©0Àk b ˆE TÃp>R†¤€z°‚VhîR oxÃgØB ¶ H,b–XÄ ä p˜à‹È¢!‡'4ኰÂ/Òø„ Œ_ ÂæQrÁ€žóñŒr,¡XéŽQGÈÁå(E$šð…+x"#Ô.ŒŠ å,Ð+B Ox„7LKmØCæÐÆ,p†Wh€«¸Á ª¡‡E:âY˜ƒ#DQO"a˜0&á!AÖˆ¡ $! ¨ÃêpQ ’CQÅèFyŒS4áMP žpE`ÀpîÐKšhãÒ/qcPw(À¼’þBh%Wx.¤ð…\ÌHñ‹zâ `$¬`‚óåÃÜD„Ô 5.nPˆ â†x  ZLãฆ c°Æb ‘xÆ5j¡_H²ÞC&@*PX ©€Õ(fa RXÀ|1Ž$á&!ÅÀpQžJÁÔp†pŒÁŠ0Â1f`‚ agˆÄ~±ŒG` \#ÑȲ†+‡KÄâKІº1@$Ò nxŃ× @Bô9x„³ñ*5Áu.˜Å45áˆ;UK˜FNF‹ºbŸwX0 …UP1˜FxðWÎ !B˜îª|!È’ Šn ¨š!„âRáeð„\À/á ÜîvFœÆ€œÜo d` ÎÀÎAÆ!jC^á¾`x(gdÀj€üà:HA¶À†%Wä@…dàp2!ŠÖà>¡pᄨå\À@7® Óž !è0à¤@Ž@–á0€d!TVÁÀЧ”À^ÁZÀ&àt`¤ Väà ¾!B1¾àU.G8ÀÎAjˆ Yô²²àj ¡J%áî©Xþa l ¨` Èð*á Rl Ü ¶!Öå*ÁXÜ ôà Ö%’O ê` €¬à ð”Á ðA¤`ô ¾Î ÌǸ@¦áŽàÎÀÀ¤`ˆÚäí¨àvà Îà£\Î >a?`2ànà šáŠæA^ÔáäaF¡šÁF% (A¬šÀ† \…M˜ †` < 4ŽãBÀãäkH,À ˜Án€—)Z@Î`|aØçlaHá¤À¨A ” x b¦FáxÀÊÀdà jádÀ À n@ Ø"= ÈÌð¡þ o€¬(ê!¼^¡5p`N Úƒ9Æá fZ@>jxCÌ’Ì.ši¼!¼áÊB’áŽ`4{Áhà&`ïÁ”àTà&àz`t@Î ‚6îh Ö'¨¾Á ~˜Á p®n€F`è†Dš¬€åBáÈÆ €ü`ár¡°"4á*!dA€@R`=' œaT@¤À¡`A ¤ p!TÀ>Î~€ÎÀ1€*¥€æñ >a ç#’` ‚êÀ ¤ 0ÐÂÆF!\ð FTþÒ˜@JÃr@ ¾G    ^ᘀ ÀáF™ÀvT@e¬aØm1Bá'W! BAšÀ˜'N¡ ª@ˆ`&À¹àã"ä(YaX4`@–éž0 ”¨Ã”àÖC@Ã|A@"”,À4êŒA Ås(à€æÇà”`d€~Aš® Ì¢ZÀ4ÆáàÆ¡À|a:\À9À~¾¡-@  Ž*ÛnlxÀ½zhÀB 5oÓnón“’5á0ÉJþ ƒã8.‚è¡èá@  a 2 ÞÁ)0€fx!Xa±tá%ü€õ´˜,†¢´a`aêá À<`v!€ .€Ö³.@0`5ïav ŒÀ H<`=G@x! À\à+YTZ`™2€Ž ǾÆÁjÐáTvh!hÌÖ!ŽÁbÀ\!<–'•† ÖyŽá¾# ` °¡xr¤¡ÐA²a   ÀmBnÁµ@Nþƒáê´ à”ANÏÁ @ PÆÁP _P@ € ü@\¡’ \Àq_€À˜¡œÀX@^ 2àt¡ à"æn¡„À;Š"uê``d€èƒÜÁn¡`€wÈ¡;È¡PÁf¡b`ÀÚÁ Ú!1¼ ¨V`4€ „A„!„ŒD êf”X²¡n:A À³DÀl}¸ŠÁ aa&¡abD &á¨A †F„À©µ@ˆaÄ ž:ááâ &a¬!&A @ð F„àZþE’zEZA („ ,€\>Î^â%~ )%#A Y©®ìF÷o@ }á\4,b,tÁrAÜ€r¬ R`8ûö  ‚Á,Î=L :¶lÁ’àl³•%QãJN3!WS#; ê”dÀ`S]à2î6 ÌÃàj!uúš •¡W8`náhtEÀa„@¾› °ÚlKa¯… à„A¦ºà["£8À4¬À‘š n€£Ñ«:!° ŽAŠ;!b êfg;¡ÊApš‰ÑA«²a¼§ëÆ  €‰¡þ`D@ܲá.!Ì ¼ÍöÄO|.!ª^ä&AEŽº´ Ä:ÇÉ€ &!ª÷`€ÜÇÍÀ p|¡A ‫‘Ú«‹zÈ€á ö`Þà !¢šÞÀ˵Z þÀ©‰ºËa´€¬'ÉÚ D ªAÌ?j°µ¤@*á Ážà ΀l"æ ¾›EµÙãà\àHALKc†¤°q!ttá\kÀ ~€äöa”—9la€^!ˆ\@%˜U0 (¯”ã0I5ï\à,N *A ¬™JWQ³Ìþ¼¥†cLíÖ×`8àf! ÁÆ°ØÔæD¬¸ ,Š˜”j¤l„Š_¤‡wøn¤ÁáÎðÀÜÀN¡¨úlËAÇY\ÍOü§Ë»ÌÀl¥ºÅµàX\Æ/A ÀûboE”º‚¼DÀÍ™ü”­Ú¨ÍZ©Å:Àºâ ž¬þ«ßàøજÈàåaæÕª'á|ü©Í:È»€ $¡ç[ž€èy^º€ºà $A ´  ˆžé{^¬œ¨7AØ°mËåãøü‚p’^¡í¾AHaÏ ,#ØBØþþ"T ¶à Uà,&^¢KáÕ €éÓ)€à[žØ‘½ Á ” xñ¡4Ùa(_Y“!!1É0”@5LC àèI”T@,×ÇÔ¹8µ¹ôíhf; áÚ]Ÿ]²àDZDEâ€Ø€ Z¡ÅIœÆöY„ö'¡÷E° Ô @AuŸöA©'A <çÿ©AªÛ\©¬©êAŒ:Ž¬ÅÚ¨7á«»¼æè¡^Þ èžz~ËŸZ¬k>©÷`êÁè÷€çù€ö Â2 lĉQ#…|ýYÈ("'-]$Y¼ØåÅ.;rÜÈþÉcEI]B† ÄhÓ%(5XpP®›Ì™2Y°úË®`Ý4xû’äÀ)_¤pqÀƒ$,Ð µ’\”ãÜœ¼€ ›¾/,€ÎI¯.’Håá‚@-À¼ªe+؀Μ‘˜ JÕ„{G<Üsƒ[l é €É @ ÖƒÞ8w`3/@°€À‚’ð P ‚’<ƒ"K¶u\DqÁBiiX°Ì5HË%PÌ/-å|y«*lU¹TªJ«ç“u×bfÐBïÊÿaHüùFqšÔ¤F“ÉOgwFƒ2ú3ÉþÝ b†Fññ'’p ƒ‘±I›´ÒJ„›<Ôˆ„$øIò‚oŒHbˆ òâ%–â‰ðñ¢ .ò!£Fy$I‚ˆÄ‘I%1Ç®t3…ÁÄDÓL ³$.NhcL:IŒáKO¼rÁàM @¾œfK¸° ¸´@I¤£Ô P‹1ûXg:ð` ¬ÙÀ¶h† <àB-@OíeÄŸ§}sSK-g AMS˜ùÀjPÀm2†XJÀf`*=.|ãKU¾xSËÄ‚N¯® ±[¯è”#L9èˆ B”2Çþ¥<{ʳÊ2;‡ˆˆ­ˆÂ\#Éí…€GZL‚n·òUAI+ä– Ý ñ^ÒÊ€ómbG…îÇ­œ÷Bæ™ÇG¹õëïq¹Pyý…ˆ`Ša\D±E ’'dhìáŠ+VLñˆ8îÈc%•4‘1…@‚ ~$9Ó8N@° ÔcL7<,óAÔ¬ÒÂ$ÑBfÂF§7¶À\!CùIMæ¥IœvN\ŒòJ€èµ*"YP ø"Ï¡< 7ÞPm<ÔŒhõÍmüj›‹6š””j §-9´°€-, ¦PørkŒ¦þŒ8åpÅ×Ü2CèpÃ-´ÄÅ/ã !Í"t2»PH0Î8H0‡È !‚0ÉŠ ,ñ¥_<ñ"Ä2»´"<ÏìñÓ*K½²Ñ.[Š¥œ"ÄÆÒl³ZhQJxf„§_úú-÷(î¶%U°?Â)Ç¿LFy5Ôˆ7”§ÑB”&Ä" RЂD’“1È å(B0 ¼ f2Q€˜sü ø ƒTÀ.ø|!ƒCÍInIÐ@­ñ $aã8’àw0Á ˆ@o˜€<@€-D#¨`ì©_@Õ,Pe€þ£èðC5Pç”ãH€ê!€0`ghÃwÕÈà I@Ô7Fñhà Ô` 5mTC5‡2 X  PF nam4ÁKˆE*0[(£¨ ˜ð ˜€ˆ¿¥P`& ®8…Ž!à…,c8˜Á-– ‡fhÙøÂ9  „½ÀÓCn` $ ƒ cXE¢k8€´È„²°…-(âH˜$š°Š/4á ÍÅ¿‰G4ÃF(=Ü@TVÈ„&n` 9ŒÙð„²`R„¢5@*`0‹f,B8ÈBü0GPâÖ¦ØB‡å ,xÂÄ„5,ÐC¤bߨÃR‹ Œ·€XÃhà#¬@GÐøÔñqgÐ`^XÁ ˆ Ž$ü‚ ¨æWx‘iu@5*`Üœƒƒë€þÂ/](dcÆ‚bàtô\œ–F'h7ÎR §Z„1>3TÝÅfpÈ0 øà‚pÁ8t¬ãɨ}í¾XCèò CÕb ¿Á ¾@ @¼‚(À¥àWÈ!˜ÍÁ2áÞ-PÁ€X1ŠQb%€„ ,Ž›9áB%˜á@ÂR€  Eh`[€Ä**a½Õ#.€/~ñ„B|b n¸ ÐÚ/@" ÀÈÂ"RhB.8“m¬‚ _°Ä"¦á HÜ` c¸Ã*®¹gFA\ئ%Ôàƒ!–°D²#‘ #œ¡ Bþ!¶À„×2¡Þ8Ã!äš gP £€ k g ™pó Øà ëÇÏp†` ‡€YÀ«°Tpk0J¸Ð ‡ðÑЋ zpÌ¥ Š ‚ãg Ö ¦µDFÀªÄƒC4J£5Z£ÄC°D&ð 0`G§t0à H7,0ë FÖð<å@;Çð<ÆtÉdLËbÔOÓBáP …2ôb! BP,à×Ph—ck·vdóJà Ôð Ô0(…ð\¶Tg Ð&P Þ Ëð RpË …Fð €À_PH}D°&” °`þ  Ý03°ð …ÀæPqÆð y¶v!•phs_pMº œ· k‹…ðß`TÐV°Kà ¡`cp™0 [!pÎàL cÀwpÖ0' HpTÀ~p ë0Kp\°¡ z”ÐCàhÃWp@z¦€¯_`|rŠÐ Þ 0IP •ð © Æ@ r`D`Ê ò`Š`ÅxVðr0 F`{æŠô92ËÀu0¡ðJåàŠpÕ` r0wè¸ 3KÇðK±àÙ„ C9”€`¸C\ãþ ã€ãàÃÄÅ@ k ö@L&ŠP Š0~PAŽ MÀC0Çp H@L\ð,ÒC=Ì–Ñq>(¦VW>ç“"Zóá„.è2åÒfz.“À ã±1à Á 1§€à°´çvY5x ÞðW Op©ð ¾9õE¡1¥˜ °ÀÝxXæv ‚·þ MðVpg 0&@œÔ`šºB›— …° gÀmp7Œ Rpp«@ ¾À|>Ö •°ßðø Š gWpó†nÉW Ý À2!Ék ö°k€V`Dñ 8 `   õOs–ð2@n`WP © i`£•pÔðÞpª0ç@ ÀŒ…0 u°‘ à9É¿`pF Wp*° `P ô n° uÀ •P…@¢·° €pšPÈà _@’Rð Y…9P-pTpƒbT®€zàQp¶6p_ÜþÂÌá b!&RP #Q.¶bõá-üaP1 KëOîr´“ðƒ¥UW¥ç²b¡±³à.㧀 € x‡ g0f~'S–F g€ Ô€ <`9 Ry´ Ëð­E Dà©V ™e£¯ÐIÈðÈ@º)𠈱Ì(𪣠+G §èÍpvÁú? 8rÐ`J¦l&4š°¡°¸0ü00 `š Wp£ð·©@ Þ` ûP@Ÿ2f*°« - ¯€€±GÞ€±£ ÇþÄ€âàš@ Ú÷‚7°© m zÈÀ ° Ôš±7À ¼ вp† p7 0zP ‹ äàA@½`•ø ¯@Î 6:POÀPà žÀHðt ÖK¸;ÒOà3ÆaËQhš?iÚ/ùóÞQ?ð£ÄüPd¢°´UÄ"Ö,ÒpbMŠÅ:ܤBá1 ah Æ€cvI·«ñ•‚Ju/t¾ð° à -à'Rà . . D&0 gШå—_ÀàÛð ëÝ€ uÀ,@>%Jpþç€ pjiÌû ¿   ¬ R° 5Lð Äí€ ±¼ ¤#`ÉÀ*à¿0vË Ðµ0ðFÄ@ #4 ðÐ%à-0¾÷@ J  @Ä *ÐJÊK‹œ ¡  ÜP¡° cP `¤ †Ð ?pN0#°e¢W 7@ ôÀyÔ°Ë% °À¡àð M€5P½ 9pi°M:  €üU> Ž ½²ë@ èP e帽Â:P0 /í Ø7XP=Ò²•q€xP P™þ n@™@ xà>T¬ÓØ“ ¥ ÃÊÒtFi”ÊÃ<_hXü,ÒpÕWê,( Æ…s ¨}wu´F™±* à Àritãp(+„½Ô5ä|Oð@ 0R U”W{´ì£X ÀÁ ¿ ‹)µ€ˆ©¦ç5ãð wä NàÚ`NÀšÈî@&pLÀ,๟ËcüÀÚÓ¹ùÜQ?y™Çßà:hñ À #° !€@ÉÐ @ ½€Äpº ð ð›G ð´B{=ö ðá¿ áðÚ`Ø þ Ê@ pX¾ÀÚ¨0 ¼E å :I—\Õ tÏ€®0ÿ% àªô L Âð 3 M4 H°00 ä×P 49RAÁ­qªà±…JC8 >‘g„(ðH‡~p >à ×0 7> CPƒC@;TùtÏ“,ð”,Oý<ØS>¢Ý‘bZ¢0&05æ î ÖxYÀUc&ˆs<à ‹b“9À£C~™;Ôp9rà9€ñðS7`Þ`€ÃýæàcÁð ºÀã°ç$tU6¿ W* çÞÝ ÛðaþF@T„À¤iùÀ;°ü ï N Ý°²Ýð2ÚAP°ð#@@Sp=0 €ô@ à?0À¼ØN¾ õ0 Á èßð¿ì ¸¬éÀ 02 ö€ðÒ<žt”ë€KÒPÁ# ±PMÂÄ+Íó[ Äã†Y­•öÞ=Q†pұРÖKë ,×pê²âô@ííà^  + D@.àÇôp&à~líÀñ( D0d  öð8ó@óÀ®p…ëŽ=C~P,ã3Ý1å´ÝqÄbþÛ—0Ñå5f\1Œ2~½¹5V“€ >qÞ®JðU9 <˜g`tfC¶ðå|]q«`«`R€ º²ìÁ@Êo3kÑ `ðIð Ž#U¶ÀG¢œåª¡›‡ Ûð .¶pÔ0 AõL0NÀÌðÝVô Ãð?öcÝp 5Àn·p ¼õHEÀEÑÁ@ê0ªÀ: :ÀG@÷P5ªÎùŸ³` E°ù5àûÊüÊ àùäP~PÀ` ¬†LÊ# s€Î"sPä9}ƒ ­@ áq çó,(6–¥äT $öMþ´S=éÏ2Œ åOä$Ĥ §à~\` ® à@×sF ®D €2DD¶S"Žqå’J Ì˜™4h¨8qþ€bÔÈbEFþ0bTñã -ÿ4ZY Š¸#8 A€ÀÅ …•J•¾0²¬è*V¶¤ZöÀM.X0àÀ¸VÉyåÍ›¯`œHBME -Z0 [ºäÎk¡›“nÌA0&À–/as\yDÇ€láz…ãF%,rŒûPèI‘^¹p"™|ÃuëBd88`nÚ4ë®UCW›µmõ,Ø ì†þo»íYØ­l] tÕf£Cn»œƒk²k¯s5ÍÚõ(Q¸ Ab­”RZ5š¨F–IÿXÔ>Ð{‹´Ø9Or|-ZqŸ?ÿû@Ò[É¢Fú#Ž@6A$-Ìð¯÷ã‘$yÓ ÃŒ ýÓ“.ºàdà€¸‘M6ad¢xLÏ$3ì(ƒ‘ð騽Aø•8@ø7¥1–/2J&cà’)™-8Ù¤Œ=þ°ƒŽ2Öûã^–V*ie2D:ydƒƒÒFiÖ bЮ©é¦œvòE> †% ðjp €šeþF!³€¼‘$ÀæÁR @³X`aP_|1ԂЋ4¾ù– ¯» ¬Ø> ìŒ$”8ç‰C ø–eìöfœe ‘ÂQÀ‚/x8 ˜Ü*(Ö¢`;á¢.æÀB,æ8åuh½íÖAÞ¹ˆÝön¡-¥ÄSxÄKÂec lFòâ ‘MþØo"Baƒ¿“áä•9 ŸŒMØ(ƒû  x¿ ã%$<6á/Þ÷8I¯#–èȃ<µ`D<’Xˆ i0˜$Á ’ Œêc À 6Lô¡fà!ñôð@âW{Äc± ¥‡y÷1þƒîÓ t@NHÚÒœ´ü¦ßøƼ¡„àÂ+¯( ¦¢_Ôb9y@D—“,c _@N’ÐqX`,N ¨'@È€€9úÖ7`qPs@ªP7ÈÀÞøÂÂv)Db.?`A`|¡7¼‚DpC3L`‚h|CØÀF  -i HvÒFZ‡HDÈc$‹@±"”È‹Eº~pÔHVDG"YǯA¢ qøX õG‡A”„"ññŽÒ“=É AòÂmé°?”¡ qøÈÃ&‘³uQ"lˆKÔsL0tHƒH<"Jý|¬@-3þ$ñ†7,œd(C‡™m”)±þJ‚¿cjdYÉýzD¤Kp¡¸ÀB`6 IðFrð•þâŸøÀ/¤PRÔm>܉™’ `< …¤@€Z @ ÆTß²ˆÅn@à¬ø U¨Xñ¤XLÇ@p…BxãJ Æ€XáÁ¨ƒ´a') RàÁ/"A„_ @&8Æ))ÉM6â‘Ì$A ¥§!IYIbM“€²@=j(íŸv®O>‰ìÐò¤'q Dèð‡M°ÒbÆCÍ‚, …> ÓX†Uõƒi€Fp04ýHÀ‚,¸ƒPˆGX?à‚Hƒcp€]›5U,¨ÂE¸`àÂ`/h‡ˆ h‡€Q¸7¡@(„&X…PpÐh‚3„3h*Ë\¨ƒW=0„%˜ò4OôĽZÈ.«@Œþßð…&H‡Q0„Z¨…TC(„3 €À…ø¢ý…€¸kp$°,ø‚,ðkp„ñ«Yk@N`pSƒ(¸ƒ_¹4PÛCýËñ€_x€qàJ„yÒ-P,†¡½ISÈl¸‚E†¸†fRÐÐfƒ:õP-¤r¸ƒ;¨Ù/W@f‘K™´9ˆVQˆSDlèL=àZÆ„Y0…fÈEh?€„:´„;pXÏl†;@$hH¸ƒ_¨`€&`EÀ_(K`€GÈ\ƒ  €œ1 í×;h† Є…þÀô† 07˜?ˆ…%ˆ9 NuÌ,pƒ/P„Uˆa˜{}„+P*¨›hø£(„1ø…fhƒBP  ‚¾=‡&p]"h†:¨\‡Q€ø…` ÇQ…GX_¸‡Pb bp(E¨„P…e¸‚/#`@‚àè)"ø)À…Ø€äå‚…˜†­‰‡Í½‹"œ06[ø‚W°+†€„O°…3x)@%x‚p›ð)¨Z0P%Xé…z­€'(„ÆÝ‚¢¸úcE¸là€ ƒL˜±«m˜m{x…U°…WH…þÅŠúú…$¨+h¶½mØ‚+Ãe`xEˆ†,x„ÃØqX¼TÀdg˜E8wp‡³‹¨&ˆŠôQ(„,‡;ø&9hMh†r0Ü%ƒ5X`¨MðÏÅ(e`HƒqH…+‚_h‚5°€0ø‚Q& –TƒH €18„G …e‡ø…'h@x‚/hƒø…C°7À€0–Xâ…Öh†fP=èÊE`ÀU¸ƒUhƒ/Å!ÈGh"„; *ØI†=~4)€„U8ƒLx8„þ6˜¿UXx%ø©Å…5¨„W …Jx)0m»è0€`VHèø„Y@_È+@G@-‹/ ˜…k …N –l@‚[è‡ cìXK9/ Ò¨Z%ø*¸gÐþ€}…O8ƒex‚kh†CX 8ƒBXRXEHx„x‚-°‚U¸Ñ‰Ì È@xº¦‚ì…hÐÓ9†+°\8ƒª •LÐ_ €`X€8…6k°Q=P„B=ƒ'È9 p@¨„x%hè½0H…U€@X-X…`€^(@ðþ …0hy=+È„+`‚&0,ÈÐj°oXR Š¥Ð’ÿ,¾QH€æ)¾‚Hp%øXRx@8„e0"È&@ƒUpKxª&ˆ0 ^)8‡dp¦¨„HP ƒBø…ƒ%h+H4¬08å—Û+¨ÇNØO°ª;À,ð„!(0À‚ .‰¤<& ˆ„HÍ„U`#¸ƒG ‚WPº¾W-ù†n¨E>ƒ5¸R€ææ„T€íe^Ø…Àà)R›¸‚XЄ1ØCÀW` …1¸GVpˆ..þ³£.À¥NO¦®Š›`íJXx‹ÎjøÐO( )‚À®"zjx‚§o¨>l…¸!u š©>‚˜UÈ€$`€:X†3¨ƒ:eÐÞðÐeX†O Ðèfðð†d€' j˜åPh‚yƒ' ]+°)Ày ì 8‚˜€#`#P"*X†‚Wøo Ø’Ð#À#¸U€áWh†!_…6aâj­ð|°‚+ø„/øÏ3ø€ÄôZðÈojf°€†d˜he bð†C¸#@moÈ€%G½’þp£²Øs%P*0‚ÈQísÀòYp (@[ä8Oè࣠Â*a „;˜ÄSÀE‹‚/ K›ÅEÀ‚è?<€à‚!?À?ðƒr˜P˜¨$ØIkXUðTú`¹aبj`†oè‰cxE.èi †Ø³ŒË¹á.ƒ£î@sÛSó‹z€5ij‚‚#p†À{g   g ö{8zÐ.ð?‹þ †Z 2™è˜€„Ð ŽàL ÷`P!$ Œ6ÚãÇ/À0Q8(TÐÄ_ø@Ë:åsÍ5å £W'"`ÖŒ"tEX8Úxc'B˜¡Å C2 #E2É$IÒ(€Òˆ’ƒ˜Qeþ’JN¢Ô%—Lr‰s”f)ArÉ M.Iå Œ(©…T9æ)Q=öØ%žTQ(nN2¤”Z²É&•µ‡¡üaè — Q1ž&i¦6΀<2¨r„3¾áGƒ:$“ ¶açÍ€,ƒ‹µäp¬³ÒZëâàš«®»Rw-°€ P@ 8x£‚|ðIàò‰ GL€-}臟­ßÎZB@ÏâœËk¯Ö=0vÀí´“]ÐC+°ÂíÄóÀ56¹’#z³N‡Ç,²D'¬“SS3J³£å€E•ÒH£ñV’iùþ¤‘oüA2{ÊÇ&{4ÂÇÀÜ#lNòG¢†Úü2Ì7¿<¨Î1+ù²‘ÌüÊvØÑÊ“´‚h›(ÚŠ v@ÍoH" op" dtÑ'csrõÉ‚^"£ €Mh£•vÚ¿xSÈ'¶üÇ ê¨Ò›½x0¾©S -€ñHøò€8à~k€ä“S^ùºÕ3@°<Àƒ-.¸04ŒÀ‚ ©r 7œ!Kd@ß=è@_·ÎAn+=¬03‚ D0Eå’÷jšñ<ðØ€20N Ñø1Ž ƒÂ5Ä^åtþ”¨qI,Ø`¡çÃ\pþœBh•UÆ?dŸEö‰¥’0“!Éÿ¿ád[“Ä0ñL„áY[ ÿȇn ea@Ò±‡­kY»`ˆ‰=0 ôß®F†=üOP ÜÚ×$‘A¸†‚ k迳M"Ex‡Úö¶If $Î0\´ëIð…7j¡ €‰@Àisqxà …À/p\Œb #Å8¼3RîrÁqHÐ01~@ @*°Â Hу)Èâ -8Bh-_x*‘¾qF9F3²@ R`A z 1·Ø$'oáT£ HÀ-*€ þl„ ªTåŽÂ7#¢<æ—Àª’'°ˆ) Rþ*ƒ3›Å!g93T 짤¯u!kXûß»ð¿d&"šÌš ÞPM¬…ÎL&º9A°›‚7£MLŒ“œ„ì@ˆnòÁ, ý—ˆ.Ì°†éÜç8“) ròA BØaÝ&©¸¡†-Xƒ _Œ£Íàc% ‘‰eXÁ ÍÇó(eq|àÐ@0dÉAÀ)]©J[šR4¢Q§ –-„¬B ÉàÅN° x€¼vq@âËÐAt°u<À*U ”º4«,äX0þÁh¼-ÊjVZÀ`ÀpŠ%< ¢ìt Ql)d—¨Ì–ª 5 ‚ ”ÀC+ðP…B%Jj‚Ô/möµÇö²W+ÖA> ì滉‰îӜф¡$’9Nj¢S†ä­h¹)†0°S Ÿõlgh@Ó¾°´ÿL¦ØhXZß.·ø”„D@P”R¿À*± j¢¡ˆB(fQTh†è#*j€Š[xT8ßhA&¡<h@¥X/{ÛÛ^˜žQ¦Ë[€ lQ ¬aÐÁ„‚œ€F Á.d±ŒT¬AÆòÆÎ1®ë\Õ½nïîda þ5h<ëY‘ ÂŽ0D’b(C%]ÊRRjæâ"©x (1¨@Äaf0“šb/k³¬ùÈ ´,fè¿jZV³|“áÀd1ȶµÿ\mk[‹ ÙîÊäܲ:G;N×"›’!5_XC|Ší·ùàÃ⃂€ ‘Vº}™h¹ÞlýÓ2Q"“m‚ËÈ #H þ¸‰Œ‰0ÂP '˜ÁØh0#'Ä6‘SÅ%ã0‚(Ã.„À=Œƒô‰õ`- €7ŒC@8@Œß5€C€0@þ ̂úÕ€ À€-Tà|À*Ñ8´Àxÿi_3´À@|ƒ .@-œC-|ÂàÂ9Œƒ%¸ÊüF3†Ø‚t‡<>€ H$ÂŒœ/hz‚ôz‘=4Ä ¬B(A¬Â,h‚„‚øÀ-(ƒ2ààÀ ‚4Á¶r@þ,\$ ˆ/|ð®"\/Œ<Ú#¸Á(XÁ F\ ÌÀ*PD<Á*To|AˆÀ1ðûˆÀœÌÁ$HÉҸ̫îÀ'¦le&¥n¤~nÀAgž±”A,R;ý-¥nîBý±;=êáÆ–ã²Ó!Ïñẞ¨r¤: ÁÛf"PÃeV:ÙP¢ÖòÙ4‚@Á9 ˆÀí&ç<5į/ȃ!„‚5À@urÀ3ü0Ô- Ù’†,Ã*PCTB%ÔB-ÜE¢r3àÂX~ƒ/dÂ@~‘ä/ƒœ)Œ5„’<)ƒ‚%¬¬Ã,È € Êã+XÁ‡2Ô/øB!ÔçT ŒÂx@Â+¨ÃÞ ´¨ÃŒ‚ Ü© èȲQ% žž¼ê&‚e0f¡ÓÏ7%2“mnà:Y¥¦Á&¤A<½›Ï›¤"U“nßrfznGê¿uê"CYe~êêuê­Æžê¶ožYcJB'K6Œƒ(“òðÀøÂÂÀþ˜ð (6*ÀÀÞ‚‹øÜ‚ŽÃ8ä2|Á2ÈÁR)|ÁÂ#<¼)4ÃB0XÁx.ôk€ TB$Øß2(‚€¶7œ¬œ° À/$5“BMCHUßsñp*œÁ|o4X!|À9È@!¬Á(˜ò/ÀË+Pƒ <~‘.Â247‚à‚6TìH(ƒÈÈö#d‚ 0Àxv%øc´)ðôÈÁ€îòøçaoÁ*dB!PÃ*<‚(Á¬ÀTŒB–RApO6ÜPÂ"T'àˆ›8 S R[“…µ‡P5þ¤þñÊ$Ð&Hâb¡ÐE²7•&91Ù91òêA™¥6òßαÇÖì1ò!³ž¨Ü*–VhM åò¢•KÂhbÄ‚_k5VçDíPƒö¡B9ø:p€RÒÂ,p€P®9$@=h@€ùêót7Ø‚àBtàx‡`åØÔŽÂ,@i7ѱF³-äÀ ´€j¨@3¸@0Ô‚-œ\%´À*Xi%¼àY3än-( d©€C ÀÉRCØ1€/@3„G€7d¥ Plã,Ã/X5Ôzñ€<À´@!Ì6.HÁ/˜,PzyƒÀÊ'œÁðþQ 0€ºfûø ÈÀ+PÁ䀔€Œ‚:”À ”€¨€ œÁHA |:`Œ#ˆÂ:<ž#<†lIáAä¥ØÁ8™ç:28.¯êÿHâ˜â)‚?©S¿á­º}™Œ#C,yÈ_æ¢>¼È3òâþm 9 “&bÙdŠò±.ÆQù Ì$ ŠÀ!Ô€œ |Â0À8Ì‚!40¬BÌÀ,Ü8À€XƒÌ‚˜ƒUàÌš70@ 3¼Ñu|}`ß8hÀŠàÚ``G€¬}3/´ WƼ<@ÚWæò@9€þ̱ýÚ»½uœƒÒÑýÞk0€¬ƒàÂÈ 3‘âJ0_¯8b ¶Ã_ö¸@=8Àr : ߡË8…cÌâÊ&PB´iÁ“ªT·:Ð nu¦þf\:½Pi’jlµ”%Äwf#‹ü‘‹|4¥A”A œh¥“–éSaSÖhÓØ”V×8æÉ”’ìõMøÐSÊxh5¼Â |XC¸Uh—)Ì:„³| ªaŽÀà"@sp)AcFŒ Ð0à† I’Ôx%h`‹AŽ-| @„‡þ( é2‰7- 0öÍ…7_¤túT#Ѐ€”(\ðàÁÈ1®ë%ºrå ‹cÝ:m”=PF+n§X±D ÑI„!"DÄ*˜p`3¥›Iô¦Ë›D˜czóFR—Ç—%u¾ÌGŸ={0¿á5ê0‰ÁÁä:Q˜×pˆAM(uB„ú¤C(ïÛpÄ’f7íDË—crÞ¹KI‚&“‘ô† 'íÙ%qÒ¢=£@ƒ8ý ?é’1ÊÅ`3"O\Œ#ðDÊ(3 qÀACîp0ƒRˆ!‡°¥€p!%\œêè›pþ¡fžøÄ JÉ¡$()¾Xå•lqè—zZhÎ à~ñÅ_\xà›øe¾B8ÉœY’É&tF#' Áðf ¿àR‰§”A'aþR+1(Ôìë(„(¥i+…-¤aLi¤1C -ÌøÓ N Ô´ËÞÀÄŽãì°£²CÛm4>$Ýc“0*Ýd´Ñ[”·>ŒK£;pÄLd3õ7Ô@ÕÍ·DP£ÌÔDØu>þ¸µ‘Mt cÑ^{­tÑVZÙ¤•8ncñøôs’bÿh%ÙADYÇjýxø0zà€÷0@lªÑ$rþª™% +ª! 9fá „j(€Z¤*à€O¶h*¥g”+¾qÄ‚F«FYF…'äã•$<"#ÇÉö›`¬@€'¾)`œ¬ø€„’M.ùÉ”™,¡„{îñ@#TaX ohÁ# àA[8VÆ•rÐ9EQ¢E”K.qÄ¥“Vz@i¤Š2Z¤‘¨ùƒ“F.cD’=håõ¸0 åÃŽàÝ„]ßà•Ø?!ƒ FÁµ‘»o%ÄŽMÒ¦C7Bâ°ã=×u4¿McQÝ6I# MÕÕo<(§„’84CXa‰¶‘I&Ïi3æ8}QN)å”ÕçPú’þ8`…Ú®q[mØŠ8À‚8£ÐIÀ=ÊñaŒUÚRfÁyòe©¾Y¦’œZÀr8„”‹vü‚5ªeœ å _$“–ÒÀ%ŒÈßI _Å j fଆex` TàŽÐ@>‚Gp™Ë<àŒ#Ѐ|Â2Öp ôq €i”ã\(Z<1,DÁž0…)Y s£È@9Ðr¸B‘…6fÀÄÃXò@æ"ˆVÁ°Å9Æq#g,@PÇtà‚#¸ ˜À9Ò a. ¡Ç ÈÑ Á#pE|B°ÇN`ŽØ#ö(µê0­x£nø…70ä½ü" ˜€®y=8ã×ÁvF{‰½uÀ÷ Ç¼ƒh#Ú$¾À ˆVÊx2¤‹{X×ß®'-x @ - A >ðŠW(:P‚t°‹`£pÂ@@‚%y@*øWÐ "0€ ÎÎÁ(žÀ„²zá¾V2ä±}t£Ú^=°±jB=àœ0 “wà ȇ Ð|@æA,Ê! nÔ¼Ȩ8¾Q×h|c©‚/0¨âÄp¾-`ŽQ`Þ€þ:d œƒâF  vxF¨n dÆ„^0AFˆE(–x3ð¦ÏP‹º3¤†2 Ñ ?ÐbàHÀ Q èA– àÆQð`¹¶H‚ð"Râ]Ç<*À„lh†%š±Ö  Ã¡gB|ÀÖhø`Ú@2°y€àܪ…9+†3˜ã·(B¬q (#Ž|†8à0H…8Uð‹xãOøÅdð Á°Æ8°!xÃÀF0˜àŽÎsµ¿¨À7Àñ lÈ@‡ÐÄ- Œg@b 8¬ªá¿n”èáþ€Ú¼ V€*ºÏé°„| Á¼AF4@ŠÀnúÏ‚A²d ÖÀ~¡2@z½¡%Ta>@ÎAV@j 8Àcÿn¡°aðj`ô` ü ¶Aê¡(`ÆÁ´¡baK\f짪!ê  nabÌa4 \ œ*á 0BèC¨Aê¡ÆA|@a æ!\´!”¡ ÀèÁÏa¨O   LÀ ~ÁjäŽ*ânî îl¡! nÊäAp€²€áTIÀ ÁPÀ@¾aTÀÈþX‚r`^¡æAà| \ `|À¢ €Á¬! Ž!šÀÀ¸®jbÁ|`~Á`ˆ!ºjÁÓVA €á\`ÀhÞ%8€§ü ªA4À&¶àˆD\`%ÀÀ8@PAª’Ïœ¯L°ùÀ€ì\a €¯b   ¨ÀP¡ü@AgÀ¶Êúƒ¢{2Æ~a|ápÂ_|€øÆš!¬ àØb`àb Ÿ®Á ba¬`öOÆ¡@b¤‚¤À~ayÀªœ` þÀ-hÁbaî@²àúC© £”ñ„) P¡øСø|@nÁÆÁ~áæP`dÑš!p`Ž Á€a! ¦\ |ÚŒ ªì/¿a©¯Ê&âê@¿2¦#0ñA4±\`FÀà ô fAH4AÀánÁ ^„ë A €lð¨áV¡y bà ô@Æ 2 2a°Áî€ °`¨ ;Má ¾À€!Æ€ ¬¤ Àd`Æá\€”SHaP!yHa B¡ý€—` С#¥M Îþ^~áö¼IžüofÀf â„Áha Ba ¬Á® L! `°àÖ¢à-°€ Ba#a¢ ¬` €G!Íáx¦GpFøs*Ÿ@?ŒO@²ÏV! L! f¡ÃPa HÁ¯®@¬Á4¡] Èd ” ž`žÀ €HJ©bp@g 4! øƒî` äÀ ²€š Àa! r€¬fÓÀA8 =äQFM!ë µÀdàRa dÀ n`h Æ á¡ <á,§•¬ÀÆ¡GþhÍ>“*¸‘c d ^jëÞä.5ïŽ~`a Úqža–@Ä’Á‘P¼Á Ö`¨–Á ¤` ¶À‚ñä €\aÁf@¾ÀX#ï@¬ ¶ \á;›@*áH¡šlfV?@ Va ZÀHÁšÀÜ СÏ! ! ²”áHá !Î@æS'láÀ@ ²€ õ` `ÀÚÔB áš ¾€ `„ᶠ¸à ²À¢€ ÆÀº+ ÎÒºtö´ PÁìA)õ V¡~a þf‹ÖbáAJå` !,áÀÁY/vV¡U€¡aÄ$"¨á r@ ž@¬ p!÷¼/€Á î ðnÁ ! ! Æ€}ÖÌp³ü ˜æbo!anà báB!4áÎR¨ÁÈ°b*YäVbT€ÌôÊáôà € ®À¬ä@¸ ,`>DäX‚V"d}T¾`$â=P“îja$p&ÄUl ¬6›`zj;9ÒH+ê¬à¤` *¡–á¤àÎà ¨ mÇÀÆàô A–PÆaá xþ³˜àô˜ ]4af`ᤠ á <â¸EØp!¬@Ä®3| ap²6v ´ ád€ UK Üà € f («Alx¬  Æ€*à ž¡NABá ,á Àá¨`¯Bx—`4ÂvøL‚ä‚á a S_a ¨a Á¿æfä` Êá¡Î@B¡ôàÆ ]}"a f@®à>ɾ!HüV¤ ¾µG |Á¬v ø! n SIaOƒoªÁÊÁùba á ê€ÊV× þp”Á­¡ Š@`³|_¼ép¡¾ÒI ‚FDò¨Àn‡ ¡€ ε À! ƒ¡ú(Õ3i¨§#Œàd€Îak X¯×·Îá€oq…Ø|gáHáÀTgàn!ɲé2ÎàZÙ3 ® ¨ažX°¡ îÀ ‚ö˜À˜À~å f  a´á˜Óa*ì¾àz A a`n` `€Ðx‘@eKw²ä=~A^ád ä[Ys ê áj` ²ÀÎÁjáøV` !)P!’oD">à ¬Á ¾à¼9„ a¥` Ö@šà²„‡.³`ª¡šàpø” äÀj`@ªiëù’ù²@l×À ΀XKÀ ÚàÀŽ—Á}´A²ÀchõÀb lû*€šá¶Ï·šWš„R T 0“ËzUS' À‚ô àxŠd ´t 8 n唿áꞬ`à>àjaÎþd@ !AÇà Ö€Wqà Öà@íá¶u ðOæá h‰p@*á co€”ààfø >!®À”a5à Ðàžàö¬àÜ€ µH( D7EäáÎÀ Á¨3ëA!B-À®Va®àš Tü€mt£7– ŸáHW²Æà¹SWì¡Ê@æ¨!À5"X Há¾@È6:Á`"‰ía dxzùR ¬àÖ€cA Á¾_¼áT SÁ` Þ"²iR¡}^QFÁ:Øžà pàfØÓë€äÁ´Aþ:ždà |XòÌ¡ê@ÏÇÀ ¬à Æào ÷žÀ !á"f”áäÕ¨ á LaT±à bÕë+À@¢yƒáµ¸=>FŒL»îÀr@ Æ`Ç!`,Áá@TÖ –@@BAàhÖpá[à=¤€Ñ ÀžàŸ4€ àWûd+pÁ VXÎ@pž r;pA,À¾×à” ô”V2 ¾ n`â#ajA –!Æáp`0µôç –!`UÄ p9~!|áAŸ ì¡ |A òÛŽ½ š¡°õÀ Öúþh×€àšd@ ¡<Ÿa š¬Á îØ 3¡KÀ¬#8 Ò©¬@®à @2AEÖ pA!ôË 2a 2¡}VÐWá Öì t‘ôy3A aÚ¿@ º¯cA²š  äà !ÎWá΀Ô ²Õ¢,ÊÎà€Iá êàø Ê ´|€ô€à<¤œC¶[¨ž€x   fè LA“‡@"W̱À(Ò´ö’`-ñ3 µø‘K:~jâ=’Ëg N”€›q}Z üfÁªaô¬ Ôw1K4à¨Âöî¿'¾þ",¶)%@ Р"ÕCg¨)y0`#B¬E±"E<¨}zeE oÞ|ÕJƒ‡2”,@E €`Ü·`,à‘DŠ-’àA2š%ô•äÌ2ŸOpQ ê-Ço†Â ‡!THnÁG6-Z·‚Ù `ëÛ IâÊMÀ+h(Ѣţwà#P îI|h 5\(ñ¹Œš¯'V¾()°@…”3<ðøræIçι°5@I‹JÐcàK.rx຅ŒZ j=$L/_ˆÊf qÅ°cK¨P±æ`š5kÚdäðþ–d€¡\0‚+Í‘äAP"ÛšŸsÁÞ»AÐVÜ­r×ÐÂÁ,È ´TS uXd…áµÀ Î…^hŸâ ŽOÈàÍS0Å{§"DF|S! À 'X]ÔV@%|ãB\Ä4ߨ–Óz`߸ ÀŽ© Ã<¸ /è)¡ -ÑC-¤²E3šD¡‡%z8à‡eu :5(cÞ•„xæ‰'~€„uèŠð§`3 h\é IxÃCððÁÞàcD°mš„/¿P˜DkIàB>EþÀ=0S Ì$=¸°›/Ü PÀw— ‚V0 :Çøƒ5ëÜáÉ5>øáÃ5àÉP…4ÌxœóE EHORóÍ/u 0Ÿ-õiÀ¥…  6\S ·ÄÂÁš ¢£à‚lpWdvÀÔŠcÀÁ h‰ôœ“AxéåD@ÌŃ¢slžÁ|ãc¡ê„0 `€::q„:$A€IÓ&j‹ÜçFdpÏ=%”€ÁüŒA!ÜÓ ”@ ÐC nÐC $…¿x$útŽ_PÃ` ÜöìC’XêJ¤Ð/«!GpràÊ Êp ~°5Øð PNÇÚ `£`®â¿ðð PàPÝPAàc cA Op `õ`ß  Á`crã ãPEÔn7àlŽàEàòÖ6 A.ƒá ¿ð:…â ø@9 íÐqípí@  êpO@ì wHƒ.0à 〠³ ³0P.ïôà4#øþ‡èñ$øpßÐ$ô (5²) `äñ ð <à‡%¿ðˆÇð L€L Ñ`ÀõP³aÃÑp„õ LÀçÀ&À¿ °èë1€1à è°Â7pçðrP'¶ÀÔà 0u3xe{X#q¥ Š° M0®Çà Ì简,Càà0 ³ "/àp À°b6G1mÝ£ Q#®rr*¶° nð çp“’`³€ ³p íèó’ ñ¢Žb Ú…ÕPcaÕ–PàPD¨ · ]± éÖKøR½â6¿@þÀJÐ'0 À¡°—[4@øðÞ  ¤`³` —´nð ªeþ*`¶€ µ0 ?RJksÞÀ¸€ I›7Ñu!Ú±ÁÔ gp¿p § \P,Ç€ÇÀKè€À¥° –P g@9&`À£ rP® ÝÉYàXÀQMðž` _P •@ µðÔ`© €8½·$ð”¢Z[p ¶ Xà z0X0_c`T€³à3z@ Ž’„xEê E ŸAWPŠð JpŸ@ r°NaË cDæp“† cà…p``€£†pdÂUŽà«•VФ¨P h² cþ Y€¤`‹pR© Š`QpY€dãpÔð0õ €‰Ôp‰‘Í° š5 z` K`0` zp¶ð¾P7 ¯_0 Þ0ãÐ Q°‹°QàÕpV`2ˆ¹‘üõVP 7ü*Oð ¯pÏp 7Ðažpw c°Ž°X`¬«G*pT {k OiK «°šO€Â!bR°«P ‹û «Rð TR`W@ —òËú ¤°rP €€º«° V0x°¢–` w°Q€ à cpI«@P0²êDðþÚø…`åžàž Ù²K«°¢` r° pë¶ r@¨`Š 80 ˆZuõ þ£P© ‹û¤€ Þ°¸P Ô`…ð2$w»¥ñˆ«p€°_ÀÍÇpY 3ßåPwíg°ÊÑKW%ЖI°kg [°´Ùû;ɤp”€åÐ ÕK{ ‰¯à ¾Pî[­Í90„1ŽªÓÂÒ´âÙ | þ Q †àঠ*¾?6…Ð WzJ`màÌÙ `”_`FÚÛså ‘É$Ìc‚[Ö"Íðˤ  À_ãà W ¤@·‘À¶Ø Õ“ O %ªi)ö`‘ Ê@‡* 2Þ@½ÔðËp°*þ¹[èˆô 0 3PH wZM€œ{Ôp-ð¬-ðE-æ7€ ±×¤©À<@ Ë¥s €_éŠÐ©+cP3˜® OÙÙ@¡1 7ðkpÔðr\©°å3  ¤` † ð ‘”v ŒŸ ‰û9°£ µ`‡€¶…0 Ù¢ª©ÝVš … u¶˜w3ð é Ê€zÚÐ WÆ@Ú© ü•ç °Ð¹´[°ÍàYpšà5š@¹M°ª‰<ɤ03¤Àï 62¶Ð…"O»!Ïíg1 Qþ°²± Æ‘Ð ê] 0ðÇDë7€×VP ð‰‘ú V@ Ϫ[ 7€5° ‘p «¸±6VÙË{¨¶+‰Ë™ Ëð_ð®ð ‘à.™@פdå þµ€¿à Í Ê›µ pJ ‡À*-r`öwºl00ƒr€Ž@ K° m ]ÃÓˆ-¯‹»…@¥r3Ú±Køâ«Ð -pw—:…«¸à¸ð ©àg ÕÍIÐc Þfm W°Å}[•v¼¡Ÿ0Çà ʼz0 ¿Ü ï õ—”Lþͺ JbnÐH õ_à ã¢ç "(‘à ¸ Ä[P«P{ö\ „† åœ _ðŠP. 0b%_@Ç 0á;¡Õ¦óÀ`K¡É°-2¨½ªôí $ 2ØB€ 80€€qxA*”¦Y³–" •¦&M€-ÁሺYͲÓäय़%WšøA¥ÀÃoð áà7µ2µ8³LŠ”egZÀšë·c–©BåQª3ÔÎX¹ˆT¥+¥’£hÍ“3¯ªZ‘¢„Ô“J>‘å¡!‰/)|Ðð-É€`ðà,G3CG©uÔþŒÔ˜E¤f5ɤÈ8$¤2ÝXæ–š+©V}É1ظ¡œ†ãƒ&„œÚ+cÎœyBàI \¸Ì~¢Réõ«G¾xEe 9Tx¨s&5µ'¾˜Ë‹eÍÁ,C7­’2`sÈ8s¥’•3©\|qC |©¥–šùBŠ/¾Xæ ~qá†GZ°%ª–ù⌤ÈäŒQˆøàŒ•x@ ,p‚…¤À倾Zð&€`º À ¼ñf ê¨C5™a† G™"•Qæàå¾XÅ›`*š¨¢‹2ú悱%¸ÅrÊ©ÆG?ÈL€–jhá þª¹æšü€a–8IR¬Xã‹'\(€[l9à’Xà4`Àû"z€#´ÒŠž$>P¢øÀ¾ o>HÔ¨¾©å oèÁ'ð…#xÐ4€$¼Ñ pA V+ʲ#l \ø%˜oÆùæêàà`ªyÆn°Ä’,î0%`|9§…‚1j£Ø Q4ñÁmìyå|| ÎgB8GƒZ @à[~)@€`¼\`TŽp††r8"ƒ^>¢zÉ€ & á·Z°G™8ZPaÀÓdƒ°€ e¥€sdø3~ùf€ ðæ—þÇ`€qhà¸ÎÀ[Æq_Ƒ„{Œ¸§/ðqᆀ]Xa†…}H¢ºy`'zs‰zÆéæ–Þ®l†ò»ƒ`€0â  b’JŠ,ÂHïr°9¢8 ‡œʹ†ª3Îjnùœ:g©` ÅPB¡…–&¹á/¹´e 8Ç[’P€DX(ÍŠ{Cðàž{08b‚#ŽÀÀg&¸Ç 2ÈÀø TIxTQç#0¸÷ž ®WE ¨?B•‚aò› mqÁ›ayX –`Pæ–kf¹ÅšBLi†fä¸-”€`þ å @ÀlB…€s¸à «Ø‚< 3¬a.øMìµA +YÀºô 6Ð0`<Üã½èÅÅ0À°äaà¿ À/äA€[øÀ¡¸F,h6Žq àã8@-¡#*éAø…/DDH¡óQÚ¤P ÌO(¶øÆ9z£,#”@xÂà @`hœàÈÇ0X]9¡ø1  «ÞXÀAB7ºñ¶·Aƒ|[=€ÃFpÎw¸ J„ˈ¦ ƒhÊà@(ëDŽYh¨ GƒT¢âå-Àq  Âs‡,gEPþ#K¶ÐÀ9@¨Z V@4 €-’w8‚:&à Uè€ÔS…/Øq„¨#GP‚Ž Í#è@|+œ€H ðïxª ñTx„_4PRv÷ø#˜õ¸*ªáo)‚H ™– ‡gTÃòP¾Á·``o´á¾p…BÂ÷Î7¸7[ X†!@J P% l+Ü`9'åa@;Â5K@€ZÈ ø¡"p  y¦)øF¬@Ü%~<ðटùB!7 ‚‘„,㤠ÆÑlqŽäÍ\ò1‚Ô±u€Äø=@°VÈBþ,à¾Q#N€@`!Ž„ØÀ6¶a d(@†¤°¡ m¸à—uA2µÊ3^òJ ˆ ¾ŠÍPãžÓÄPb…\4Õ :Àkøá¡0 À S4aMÕ*nPˆ|ƒ°æ7¾@Àœ••Y[G¨ž¹Á¼T…Ð`N‹çРºÞ¥éóbè]ÌyØýÝz@ Ø +ô…˜€D`˜ºú5ð‹r$ ± Å ,ñŒ[ø¡&cPD Ñ„3ŒÁXXY¼áº‡$-† †{Z „Ô^¸€3Nå$,«IçF%••—ÏþÏÃØ‹‹×‹öÂÚ+=Ìñ‹úÝ †¸Œˆ´J¡V¨Åep¨_$Á( ¡7¾q†BØE ò…/’ #‹ eX@f `Áxq‚bÔÕ®²È‡(@dèb€3ÒvGÁî™Ïg³@0´ñ e©O’¸ƒ²|£;¸ÏƬ`RxÅ*–Ñ€ 7CpÀ rPŽäP-®Á%è3¨*V¡`# «­Èp€€‘8ÀÍÆa„\ŠVxÝ3sêRvxyÎPB2–Ó'ãÅ;ØÓè!ÌÌ! ¤ð‰(":Ð/Æ F'éMRþÀ…¾°Û0(Ä áRèÁzÐÃ* *à*W¸ Ð3$áà‹/xð‹Œiðà Nج½Q ^•¸ƒbŸ ¸—mˆ/šÆóøÅJ#ðIÚ¨j`M`CHûÅ9àUbŠ2bjÑ a Œ¶€ÖµH¡ ¸¡úP†*få.)ø8 ¿âôÀ®¬(F1:À 0CuP@(X=[@Á@‘Ÿ`sì9'ªG0œ°Rce…ç8Ú¢­T¸Z$áÝh*0çZàÀšˆ¥KGŽUêvL ƒ„5n! `Œ.ÖКàqà,¶xþ•ЃÄ$!™.ðRõLÀsØ4€ý=˜çBg4›Èi:u0MÚ÷ây§ÁòÊ´À` : ð³øbçÖ9”D ›/ Må@B9~xƒU ³ð¤ \\á0‚h¼dF"Ëo¢™*~³A‡xF#@#ñNkäÿfø… pz¹sp‡o¹2ª$ø`j‚„68P†pC¸ƒh±‡_€ð†„G¸Zøˆð…Cˆ„fð“zˆ`€x$Й‹@€"úae9ç ]X³«ÓºàµI¯€ €€m €À2%d:þÐ}x À=$Aê‰p‚ü+š’:€$€¾ñ¬Â9#È›`€#M؆ÙÒdp€9œÃk¨Æ “Єk¨e° XT°À¸+–ž#”1o8ôB ó¹db½àó4S¶„¹€î 3|Ø•+â@á›((2š&¸0³Q€ëQ…q¨„1°€qІ_à5¬ƒU¨…qø˜X@?P†XøCkˆg00¨[ð†5X€'ø„OÀ…°]Ôy øD%ð=)ëJžJ¼1už‘9¨wˆ †h0z¬€wŒw(þ0ª±[0‡0A=P„¸{à5‰+jX2dq ø‚-ˆ¹¢è™SÉ¡hzð…)x$€q´ €zІsp«çÉ 0~Øè"t P S€nP€mh¬@R€:ðª.¤]zØÂè†)è(*@°¡‡oØÈ]a´Â™5d"`)Ø ¨y¨ƒx€,¬nP†nT†`‡'¸`X”P_(€[I& ø@Ø‚™µsðÈJ2ÁF¦+ à 3Û ¸€¨Ä]˜€…{ˆ€ð1qtðŒX˜C;‰…Ðþ|Ècù†¸¬P„ÀÃ1˜¸Gmx9 G¸ ¹ÜFÛ\e°‡'ÈR‡Jpƒ'(˜¨Pü{…T°eðcÄ?¨‡s`–³$%x°OÁu€=ºÙ“…Òd¸‡ ˜P`‚_`øw€z`¹”‡jP†"ð?¨†r ¨[ …E˜rÐ&Á;'¡†J8H²$€À€v0s0"Ðw8‡(šh00z0ú Ó€z‡ à€5ÊàV0Yà…)`†b ‡iˆ…¨@…X¨†,8E` ­þò€h0‚ 0_ð0&иb33áa묤2̈þ[©$X ³(oðÐp* ˜>6…UPj2j`DŸ“è¿J‚JØ‚ µó!"Z‹ ’4áØ…€Qè1 øˆtUTp€CÐ`¸†u@‚l@…rP¼ÛÝY€¸B ¯'ôƒcðaˆ/ƒrðƒiðGø‚c¨ ØΡ€PˆBø¸‚+ø„Q%P… À‡ {H@‚:©ЀÀ0”àù©£8£™Z¡€ ˜¦Œ¡ (û¤þwø"ˆ$zpwxL!©T€iqaØ–&x9Ëš(è“‚Gø„°I–_ Šu`&(øü#h‡$¨Ç\1pz`Cцrà€ƒý¯Xø+èùª "\`'ødðk†X8a‚lp(pW@‡càS „c@z$¢Ÿ1 @^•©M!:#Y3‚S#¦ Q¨ ^‹` ÁZðõ9(€ y…M !_ø»`W[ˆŸ­’xRX€~QTO:Š]É¡¡pú ›xœý @Ê_fø øm°Àpˆ…iX‚PþO@°P}†u8À…’AºsXŒh”* ¨aXõhKpƒX?p€-ð„c` `À[¬•@S@ø†ãgP‡{Ѐ-Àoø/Hÿü2‰.yÆËâ'_pUHgsq"Ûcž^ø/0• ÀWŠmz¸^8p0°R½†X`¨+B€HÊ,)Ø‚9÷É€|eO¸×Q8ph‡~u¨'\B ’èLiàL?ðƒ·ñdX†eØ€ ÐPX“iˆ@aÀ?MWp…lÚU€‚ÝEXp.8,p…S¸þmÚsä.çÁhH²¤ªÌˆøÀ+ ‚'8ˆO†hEB¦xfê\Ø”TxõáZ³…¾é™Ï[Òó;Ú(¿3x®$$šÁ% ×’ùâŸÑ€t‡ÿBT˜†¨†ÎÕ„x†¸$˜OЃEÀ·(ˆ‚Ýi _h’0ºˆ‰¢ÁP„ºÔ€WòØL,X„1@‚k€EƒcÐy°Ûó)‹šZƒT@¡ `%Hú¹…X°›:ÐÊ$ ”0ž’ox‚¯z€zè?² p è¬@w wp(¡"àX†× þи†g°Ê™08| e°‚'p2Æ8‡3+è R(®÷XÃU  &pØmèÏ XYt˜a(ÀQè„u‡Ç¹p¨†YÈ‚?˜+X?†&ˆ‚Ê=ð¾1°.˜HÚ%€$tˆ‚- „&ÈQÈ,ia ‡‹¡jî¢í¡ªÜ»Œè¢op°+ð\x…W`$\›Qð¨JŒq()²„B j(&[P‚²°¨Õø)¨Ë4 @8¯&×å#j ^}@À…ñ`ÕÅG0OȆlÈ‚*Ж(ÀC0„(XþHhˆ…Ñ™+€„1XK¸V‹ ø€¹…¿[²%:7 ˜kˆÀ†X€‚1ø‚P8Ø;ÐW`=€s°/ùr)peøxjÐ’Jxâ°ƒ+ …-ø‚gü™øI@¸‚e0‡Ph†˜&XC@ ZÐ=È‚+P¢j¸ŒJø‚c…5pƒ¶,îf†,Th‚1ÔÞn=H…1Ð)ø»&‡/Xƒën‹ZX€B(„Q‚+à*ƒpHbâ`¯%¨CЃ1È$±À¿üÒæi<änÌÂzܲÈcÎÁ 7p0†u0]%«¸PB íT™DGg0P‰2ÈPPÖ‘ È È*ŽžqÀgÜpÅ(JOˆb¦p„0JQOJ”â–pÄ*<‘…,D MˆÂŽ‘ÇàŠ ë(Ç5b€Ž p@!ôP‡3(-jä< ÆsP€o£€þ/š1)õ µƒàT Í@5^ñ ð`›d@j¼ Ú´À¨R8|Q ¡hA)Pa)”‚”ƒÝ Ý´@›)Ú©^|CX.$ÁOÀ‡MHÁ9,ÀNù—ç%ÞÕÎDKy鄪¹ÀnŒ.Œ„U=€¸À˜ßX€tlƒ 6lC=ø1@À88Á_V0ðÐ@>€ÞUKtÜ0b)~ƒ †9`6ÌÀ4@ÂÌÀf5Á"È#Lƒ@eHË7þ€-€-Ø‚Ý| 8CbÀàC㙃Ä‚0T Ü‚6xC†Ð€š(Ð8ŒCÜ><Á7D×/À=| €ð0Á%Aö€;˜À.eÀ HdÀ°ƒLÀôB¾e@8`Ü70Æ8¸ `:ÆÚïè× è@f€”Á=üžÐAA'pA 6TN!¡L!#42Â$ü ‚Lò$B+àA¨MšA ¤Â–‚  üäS:å LB#LÂ%”‚”Ã8HRKÔÂ_€ h4cT}@MµÙ”âqŒƒ-)B*xÞ,þŽÆ,Òj@ €D†7|ÂøÔ‚€¤ÂœÃ/‡¸éYº@-A5pC54Àà@9ç9TÃ5Tƒ‡¦@˜$AàÃà™„h@eeX`3"À_€ø€Ä@ xÂ,8‚)Ü€ÌÀ:ø˜RùN `0šlžƒ 8œ»U#hƒ9| -  Ô@=üBÛÙB-8'5\ä‚Æ|ì"0@ ǬǕÀ8ì”;”SÐK0$ìá'-‚ý‚/h4‚/ EÀEºÞÔ9”ƒ,¤BÄ- C5Ô@ |J7¸5‰Zz‰$I^œ¨©XÒCq> À¼¢~Ý‚5„5LèÁ1ˆÔ0NC4€|Ò+ªž4Z0Üj4‹LÙˆ¤›Ù‚,€=|þC=¸@ƒÚáfH€Í:ã2A!(‚]Ùa0ü²z\2Á @dPA&T ˜D¶ƒ:d€:Dœ:¨ÂD܀ĩ‚:è£3X1žƒ$A2â]Ã,2ÁŸåNAN€$¸€ÝÔ8Ä@Î9ב¨À^z£`kÜX>" 8CÄ9ƒê ЀØÌÛ¨ƒ2ƒ6ºBŒAA ÄBª¢C,¸Â/DÃ…ºÀ_5âüBàþ‚L ýµ®CÊ›7ô‚*x€ô« ÀbÈ€‡$£ d„*šŸÿÀ•ä4¤ ä€D’ȼ9\ k³0Ü @”€:pï9@6Ôƒ=؃9\«<ØC0ÔC˜ƒ•å ܃  ãFãÁ:6L*”C_ ƒàX)ÔhòdÊ QþÁ ÄAlÐþÁšÆ¡ÌVìŠîdþ7‹6B‹>娑þ%C„ñ¬Ïö¬ @).À¤°„TèT¢b#Ú$B½õ;ôü)`C&æìi@$ÑnÁ+ØarX ÜŒ•ØÂé-F0(L”Ã48@(¸Á 8€$€gʃ¸µY- @ây™7DŸ @2zçüBëA½e–@TŸªÂ88€+XCBic øÁ‰A8€A;`I („0¶f`€ÄŸÃì:DŽÂÈß,î”ÝüÂ9<Ýð3:ãÐCÿœ;@²Ýd}žköª›d@»‘HóîÛ P 0À™žÃ(0þ,¤è:¢.§ÔÍ"m`Õ7Ì@•˜€*Ðß=À.êj€2$@þ ¬ƒ0DT)ÌœQ*eOÊ$PÞ(À7xœØY#ª$Ü€h2|) Ü $¤^"¬¦Ñl’lFã值ð8g õ‡—Q pc9„B&„B!ŸL`Y¼ñÎ|˜*Að€Ôùé€*ÈŸ¬Ÿ/4uÀ+ €2 Ãd…)`AþNC ø€+ 6€Cƒ•S^Ùqƒ%²;þ|C;|åP2Ø1DÚ—TB!|€¨ãЦ0ÞeÑ.mùÙKË¢f A+»P¼ÆܨCt@<Ô§ `ŒÂäöýLôÔ=DËÌ *)‚xE'`ƒ+äj¯*A/Äã(èÖ!€A!BœÂ)ÌÁ„ì>BMúó$´%PB|ÁHÕ24KŽG b(w²hÅÂ$ÁÆrB’ ¡N%ÈitÁN‚4ŒÃÂI€A7ƶÈbí¡g\€Uá‚G` ^Ô‚X>X‘e#úë¨ðiÀ€È¬Z\ ,#ü• ("XAþ¬¹± @àÀœ-LC9 Á Ã5€Ê-Ô‚Ý$UŒÕ¨ñ î9 À/8ã8<€ùŒÚx0¼ÕÌ:8Â,AVÜf LCX;À:T@40–œÃé׿$=ð€;=d6ª²åHA!Ë›»ÀIÁ,´C;,€ÐÀˆü‚*x lŸü $ÐE”Ã-hÀßÃ|aë2Øõ'4úX(B$€Â)ü¯šÁ6e=UAr{‚Ò$•WRù„šdd¸ÄÛKæÀâO,Aó‘; ‘c‹G*©ä•L”9@i$-´„KÊ™¥ lX%%F±†ƒ&pØâK¹W‹è& ¤ºî°ã„|ɼKPÈ`ÒKÏ 8€#¼YåÆ9L _°…G\~yâCBAah”‹fYDpnX"”'Öà H|7@ (€EÎøEŠ/Zx@¾9ŒÍÀ°b$YkÜ0¤Eùåøej )@k%HQéŠJ ¹¡KB¹Áa2qÃ0Üx†þ–;²('Eš@â„bˆEf€ÂÏîCM¼¾Xå —pa”L¨Xf G°(gˆ+ôXb Ÿ¬‘Cub° 8`€'ª%iR”‚ ˆ£Æx„ Öe „W*i$h‰%ŠcÉÈ‘&LD”¹b‹’^‘úœs  Té¡jÙâ•{Ž¸À™ t \ %à+d¡‚WlA*5d Q4¬Œ0ƒ¼E‰;X‚ƒ™8Ä!*A…Q\˜Ãþ0-¼á ˜Hƒ$ ŠB9ƒ#¾€a »ÑÂ1ˆI˜*´XÅðÅBðÌA÷0 \àþ[@[<ඃ’ð€sÈà€HB0lñD €«: á†&L£wƒ#Üp¹¡Q¸)‚!Rð@ß8Í°€|£V°Â|q¦â ¿ÈVñ€W•àâ 7’ðŠU¬Âkp,ñ)"[UˆnQ tÌ‚ ™)"rÃ(4è Ë‚%V!w˜ &°‚†‘â ô¢H†,œ‘da÷À@²ÎQ8ÄAìá€Nˆb<íiv€Äo]b§øúétá2L"j0ƒ„p‰StÂ8Yµ@ÖÃ9 «X¨*Ã(؈A4þâ =½v´ÐˆM a¿À€ìJE+ °[ðà§üÀ'¤ š1 ¸PÄ'Baˆ,db ]*  MŒAV)¶‰U€e €CÑ ¨á j< ÔÕ‚1€È/ßx‚²pˆ”X‹°Ä"Bá4E´(À`å[C Ëxñ yàâ~d ΠÀÜ0ž`>€ô‚´A”A´jÁ|àä!þìÁ‚› ŒÎÁ¾¡l¤ŒÀBà´ÐžÎœA ·pº!,ÀV\€ € †`ª_Üð ýì } ;¾Î TÈ ‚h6¡ 6¡~È „`ð„H¤R*ãÚÂ.AD`,hð Xè;þaJá¼ ¤ ¯M4nh/ žT y6’à@  p¡ÎáΠôpÁ Z ×|Áö€J|á–ïŒ@•¾¡= dΡx`ÛÉ(-¾ÎÁhh žºÀCè¡Q¾|ÁláÈÏ)¼A~š0ŒÀ`«Æ¾Áf Ã&ÂEÁ|¢ bÀf $ƒtЈ€p%¾!›j¥<ˆ@ N¦fŒxÀÀà~Á<¤j¾AâA~¡ ¢¨Œ€ dr¸\`~~áw…$ƒajÎaþÛ‚í>€$匀ü€ ˜ŒŽBÀh2&à €éèAºÁ  >  .  ª§àFÏ_ìð‡Â.ªð@×ÊUHð„¡á>á n b ²€DAb¡ZA…& 2ñÌ@ƤNòñ@‘ªŽr!à’`$ƒ!à~A@Ï!èAt@|Áî¡BÀȼáBà û’` ÀX)›”€J `à‰Ò”€–¡ÆÁp"bÁHPá´¡’@”H²G)jaB²CÈ3°þP¼Ô!|AîÁŽ@Ô   Áü` –ÀVr¬ÁÊ!¾è Üá ¿¤Üá8)o0`VÀ<@zC=FÇäÆÂó87D`¿á> èa“ÀšòÂx$\tAãÈJ HÀŠ,2àÜó^!ŒQŽÜèÁEså\ Χða ¸f•ÌƒïÁTSÕzv”]Òˆ ýÚo*€ ÀhR˜ \€öÂÞ1¤J@u`$ïÆš  !~¨aä”(AÏ!ZÁlÏvŸøL›ø^÷lÇ”£)ѧz f#†ŒÕàÆà„:5ºA ¡; QϲvþlaüÀ`¡èp¯èЈ’àjÁöZ@xÀ ÀRá ĨC DY ÙÏ#¼p«·ºéê³=@š™n’a–îF¡Î@×”ö á ’ÀB "á ’g ’AéŽÌ\û÷¸pYBàÆÁY슀e¦Ié!2À’á’¡h ‚ X´Z ¡ J@)™I{VnúÕH€•‰ ‘›‘»ú*‹lÔ•›.6…ÈŽ`UašÅTñwt€eÇü ¤Ó®!  À¬˜`%RøAP€€^b\W`šÕ¡LÀ² Æ€¬ášÁ„þÆ J¡è€Î6ð„(¤ã‚î°a&¡æT:Îö^þîaŠØ£ñPå{,EA,A ®àÿÊe h¡‚Ád!”¡ Ô@*¨;º€b! @¡èAÊáœ4”«W›ëjá~“~ób=(Öªß `<Æa¼¹Æû×&€Ô¡G¥N|G=À1ÛGKàüà°Æ€€  ¬@ôÀà8·Ç3€5ïÁljl‘JD ›IW²êàwjGIàƒ{¤€å=WŽTŸuÒ2€ä0@G‰L=ÏüȾ I@(ôÈÔŒàrÀÐ>ÀV@þ µI»ÈTAC1À T*àÞb „!Ó Ô„a€ÁÀᶠd”}4WôdéŽ@Ú*¿àƹÑaС 1ܬ ZAÐL„ DàȻ撼•]ÝûÍR£}£½…(ìö¬¬.¡ æÀ¨ÀVÁð  ná2€IQ  Ø@ðð:‚˜Þ€DÁJ@ü€ÃƒÐèy§u’à{¡LqFò–‘nªú<ÙŠ^áù¢á~¿aBr<œ°Ûƒ ¹Úã÷àxÀPÁå– šAŠ@jà ¡j€·‚–ôC„sC þx6~ªE’B<¦7$ãÇá>Ó°  =ªúŠ†k/Œîä&Ÿs…Pt‹>~^QŠ®Èx ;$Ip`ÐN£E]ºOödy$I]àdI’ ÐA ÀÖabÀÊÁ®¡ ¾àÀAš›’À&ÿÂ@)ï! ¹C‰¬´ bÁbôMÊaª  €]  D ¤…Í@_>_ØsXØ!ÙßÍ„õWÿ‘ýõ‘ý!€šÁ¸@Ê!hA\@ˆa˜Àð`õ;¾£bÒ`bÁ¢¡Þ‹„“ø’Ý©dp¡3Àžþtd’ïàù­üËßá>‡W4 |Çì”ÌýšWäAXk `àharZÀÍÈ4«¸X>‚ɳð-Ø8 왫hÑ– ¶ É·Á(±…`œ= òÎ4©÷K™L,Ô«÷wçè¹0jÙFz&^}±€4©R¤7o~7Î…‰ Ѿ™1ª¢QU©‹V¡‚;wÑÆE3áê¯rå„9ˆáÃO9 Lã *_Lœcâ‚^`Á%2Hõ²âÈ„{îyPwæÑŒ_Ç°ùÁfÅ1ã¢<ò4„ ŠqLH&BH,"ʉ溔´Xåþ„¼F¶ja¸Y¯žc{µàPÊ Ñ žMÅ…]ÛÀEŽ”Ñ2¨'N]¶káDç”sbmìˆ @€àáKÀÞ\<ȱJ’sáž €€{ ºgO Ðò`„ÜâGQ4C‹´ÜB‹2 ÜrK xx‹5€# :èÐb )‡àÀ-0„’É3×ø`͉¨ s 5TsK5åÄâ€~|ƒÀ€çü¤ç$¡‘F˜ãƒ2×hrE0øQ~Ô@‹ˆØXô6ŠTFÄ[,b5ؘÈc5ÕyMó<ÃÄ3S¬óË:W\þaM Ä  óK,X3)>€Ã…+>Ì…\3D Ø3ƒ#«`1ÆTñŠ$< Føƨ!_(á ¤hA%^á eâ 7þÀÁh¡‡Ç¢£Ï0Å"¬ Gènd[iwCXáž@‚B HüR†¸†n 6K c-ꢰŠLÐBw0E(n`[¸­Á24ƒBPã€xÄLa‰p cX®qX ¤pCH¾Pˆ˜à9 €èA€¸` £àPB ZÜ€ÙR,B‘…(LƒxÐŒB(¤)Ñ8¢®@G Ú‚ºdð žØ‚ïL…(¢ è°Äb°;ÚYœðrÝ1†G0Á|Ù'¬ðˆWx`^P‚0À+Œâ ÐÆ ®0†+|_ØÂdp*0à þñ(À ‡@âØF7ô‰1œa 20.±ìãk8C*~„T"*¯(„H¡‡lÄâ”u¨Á86à‚_h£Ýpª¡ kÌ  [PÄ!,‡KLbYÅ'¾£…4Ì¡ëX×ó_Œy{bαp¯ÌÞ8Ã+A…BâPÀš hÉáOÃ’ð74cÃI#{Ò[à€ D‚|¬ˆ‹¸ÃeMT/’¨€Â € 㡃v½kÆVá`Øt‹ g\ê0xãx€DžpƒW,g8¨ë< ¨àMÓ®A¶jà@ãHBþªÆ@…G¦<È ñ(`Ü×Pø,h]ZÌÀ¤hÆ zëcËkFË‚(|à Wp‘X‚LaˆÈa^zà¼Ma =\!1@‚\G$8 hÇ/dðŠ‘­‚ L`‚ ðs…3”`Š!(²Bô&è Ǩß(*0ŠQHÉî° n » €€Ê8TPˆü@€ ,P#X*€nŒ ¤ìÄ0ƒ;(¢¹¤ˆE ^qƒ3䣘"y7à¡” 4txùC¿a;Û¡ÃbáqddÕH@€hà x€ 4ð„<á Wà,þ+qEÜ`xÛÏ×à (7…XÃ7¨Ñ¿5CÀÝIï0q=£M>¬â—Ï›ÁÜ0&,b']G9 a nß HC9”!‡3$@cˆE&H!ŒÜÀà0¢Sq ð ÔðE>PÂÀ[àE 'râÏ`WÀ3ÆOƒ÷ ~12¿Àà„ ø… ³`‹_5 ·Ð c`F*Çà@;0Q@Žð7àH£‹(T âòwðÀ°z0ÖPw€jr \0MàP M€_ð2`MÔð –DÐ @éVþp½Ð ðR T « K` ´ƒÖÐcÐ,W  g°„ «ð† `ûðpc¤ð 8@ 2õ@pR÷@úãiêF ©T` Fc@Ť k° P Pwx€”p ZðZ ™W1o@|Ð<„ç@D£gD€z¶ð ç ¸€ p¸¢ÁðV Ð W@ Ô Þ  ð¾0ÔðЊð¿Àeà†ÌèiR  Ð`ò0k  OÀj 7 O@òxzPc@]cp8Pl¡€r0à7ð šþ ³ –`?¯ekp2ðgðÂÂ$a Á@gP *X¯€ Vðì8òðkÐ ÍðP õЫÐ\_ >R [@ ’&P&€98ðc0 M c £ 𠯀c€xLð Y@t¸pnjg0&0-OÑ [ð?•M08p>¦pK°X0r ØàlÀš`Dà£09D R +OMp‰1Ð %àsÅxˆ‰‚²"“Ë +M  }ø£°–¬ò©°2 0²² † OÞ gø =€pF@ 9° *°˜þ-@\ 3 À€~p šðH Æ å  ðdÜqhß! œ°yÕijp å@Èd%ÈÈ$¶ O  CK  ù… °ž¯À¶ðVpQ¾p`@E_ ¯ Ë0cÔ eø²„ Ï ËÀ2pøWRpŸ€° Þ Ú£ cͪ¡P7uSŠ° ¤P…ð øÃ*]˜Ô@ ¯ÀŽUžsC ¶@_Pw- gÀR 2tìX °Z4{Ë`@wb€Ð¿ÖBL𤣀 ðµà 4ã Ëpoõãcþ9ð<à—.pmøD`&RjOô°& ÀôÀ<ð s2^â Ч®PèDð FpM0b¿@L ^FÐ0DGà@>·Tàð nAä @« >ð `¿àÚ@ø:ð@  ¿ ½  Ð °&ð –âÇ (Õ€dc60 #C€ p ƒ09ÄyÓ)ÝÁCt èŒæAŒdUPdÔ =?6¬"W©@ Á€ ¯pV@ T Oð =F eö 2àoR 0-@©þÐRpFÐ $ð - ª$  !  à ‚E JÀûW¿`Rª½€ê@©@J°MàOðOÇ&`D‚p¨çð °@$p†÷`÷p%ð à ±©å ›•Z…a±Èú P»äã}ë3 ráÕ­1 å€ Ø M‚LÐp[K ð z‹·ê0ðLàà°~à ·`!Ð LÂ÷  F  þ:@f›VL¸ð ap£°µöp^½à í€^°¶»²bí €Ñ;"—" $l× "z$¥ [¥C½Ø­SÕÙ6T ¡g®ß¹€´°Ö®gà£(‹@ £@7¶ù g€²@Ÿ-9à ö$Žçp%pG€ÎÐ19 ¬|i40Îp÷0PÛ ÌGð<`BëD€ FàFà÷ Lç¶Ð Î@ì £'@¤ðã©Eëzªp®Knk¬0fÛÄi(˜Kî€^%€€¦æ£9ð«0þµìÅL¼ÀMl¶÷PÆ LG ÁG@P¬ÎÐÁê »ª0º <³g` 8 Øà ã Âp ÇK0 Úp¨p 79“µ„ITfìLÌĤ ¿0ààqa°  Ð ®;pG0–bY€ãÚÀ5™&@%ÐO@ &P¸ê`Éê QzC PÈ(à>@$¢SLëpHBp ¥ÐCßÑ;ÔÕ)ØŒXz¢Ç¾Ø Ôðð Þ Á`ã  òÀ>à¹ÊÏÁ < Þð  7@WÞ`¾ê Ÿœ 9Ðlþ¬»’Á¿!! 4 0º!Ìð ËÕЬ$ ÂJ¾ðÐÀ8ü¼F¬ % Îà ‘ ´þµP€‘3ô°Áü´N¬ üÉ÷à ¿0 cº`§¿° h çpKŽÑ ¼²˜4@PÛÆÐÆ^\Áµ\©TËÒal¬÷ŒÁ@ u uQàææçYàc LPFÀ>çÔR Ÿ¶ q¦ +@Æ};±0õ0Ýн@!à:0ìPÕ ¼,L Ö «àL€ Ú0 wp£  `Fç=@©}•êþŠš-Xp àrÛÒP s s Û»U=D¾½hÜ]pÛÑ@ F ÁÄ<¥.Ó<Àæ  5P!5€ EP§3OSà ¤ð ð‰DêÁÞì= -ð W𫀯gøÐ0-`¸@À¯èå -É’lÇ î `È!Ô0ÊÊ0° ðªÑg• Yd #n ÌÒ'ǽ°Á­¦ÛD@TìgÐ Àî`Pqf€7àz.àdç ª° hP `& S -à ˜Ö°Ð1ó 4!‡àþÈȳz€Ø€n°ÀঠÓà U©î02îÐеƒF@í  J‹^¶Ïhª Á Ú¢ë$ …® tœÄ Œ1èàX äô¸xÙm~2 «p« ½ªØ€Ø0>"Ð à" °­Yµ×, ’ð‚ ë¯nÜ´Þ‹‚°CŒÐ— ®0Ï}I‚E J@K%ºPƒ0  ³0øÕFR°uå¼ÐÞí.P¤2`·)]8iå ÅN0e­rOpD  vL¼Æ ®ÆÁ@6ÿRkz× ´ lþTÑqÿ ð³$n ô@ ¾à:[© ¬ m £Ð1˪´è/ôß.`Œ9€x˜ªÁ2.p¨¿ ¶€ ‘à-\ õýA<éñ¶` p0c R`Ø<«p ‡3‹P,Y ø¦ Áæîà8Þ%@ŒL°òê’= äFnÐq Tì}kí€ã^>0 û5ƒ,ä\°‹ÀÇ>ðV •C⢃½4ÑÐ1(à C § êf@1¶Ø­…Ö­] ‰ðÄ-à1Éì:¿@[n*óÀÔ°kM0¨€ K Çà J_þÀ¿° ‡ —fàÛÎÞ/ßP–*àu5ƒó¶P20˜àóR`E0rƒzªÆ/ü(~âð#¤ À wÀp~@[^^@\dkÝýaÓåÓô@ºéOºP+ðÂxKmP9à¤îpã9p^ ÃhAðR¤ãœûeda-0ã, ÀW³/Ô¦áÀ¸`.Œ| ÊoõŠ8r ”!QVq¹æ ’?Ø\˜`bÂ… w>}Ù²Šˆ‰ ¿!p1î—[¶8€€SmY+0©N›×¯_}ʆDÏt ¬]äÊ5W®°þEÉò¥\9?1b CŠ+&îJD3!B„9J™4H 'Fœ82cF²™I“&s"CFòç.oìÐiëšPÚ @ÕV0l PaeÌ3´Páh6ëªHhÑrPÃÇ(Eª Àùsç øvæUŽ`O>)ð`Ü7! dY%)“ž;@Á‚;À}üVT»EKجEäxF7p¬X„?”y`  €æ {Ž +¤ÐzLì’h‚oŒÈPC&2àÁ…_L À…–"àœø%˜s¾±ñ›qŒ€Êª'qA[€£`¤JBo0b€þ`ƒÑ@ ‘á€"f¸Æaü8& O¬)ç‹;°Á¦‚qhçÅ‚2¡d¸‚ è€Áð…°å(m@g´þ´tʉ˼ÔbpÅšÈ" a\YË(¶›—öóšÖQÆŠÌ©†/ ˆEi¤YÌ -¡L‹Ì´¨¬2\' D’7º¬ BØ äš´üP-¤æÂs!6xâCr‹å€I ?B¹Æ8ˆe 9à€~’𹄦Zf™¨e€qàœxR ¨e@ž°*‰ŠªÇÌÑfm, àaˆ ¸%?ÀyæþšP )„ƒ[8H ‹En)ç@À Pyå•-ˆæe˜£ª‚hƧw2p€sŒ0"ÍoL8c”oÜq¡„8 o¶ðb À…" 8Ñ…¾PÄ=Ù˜j_lÑ GæøR…y°‘k½ øb•cb‰BŽ¨(£KÈð'wdd Œø& oÇÙ€Š0ÇN\tkb)GuÅòu¦bEÆpeaÐæGPË?ÆX¤ ? Ù×?¶ á`€ËE(GšS¤yÕ0äË¢!NÁBQ. ä -´èB‹=©B˜rb ÖþZ€ƒ hŠ+¬œkf1DZÀ¹6Ëpð€Ö¨€=X×9± @V8Ã8 8ð€9I(R@oœa-h/Úó{Ô ÕØ` ÐQZôG„á:h‘€r„BYH€Êq‹Eè~xÀ|~ò‹o'b³G*ƒ(ˆ b$hƒ< BÏèñ`«XÚ!˜€$G}"À}Ü à¿€ €oØ‚CX@â…"üâgÈAßó‹e¤â ðÃ^‚u8`zà‚°°ˆºEƒ ?aÂ"]й#€ÈAC|Æäà 2ÀAþ˜h£ÙÀ:²‘%Ì!X:¼%”ƒ zÀB90 kda ¦ð 6lé:kPÌ”CÇ€Á…i€k°ÈE ,7(ÈAA±†ðС©Ê!ªˆ:…(B…KL¢œÍdÊ€‡»Ä"àsÁ9ÎÁ¬h€¾X5¶ppÀ°Â nŽjز?7@…2¤ 4ø_k¾QO+¨ÀIø†¼ñ€ƒ 1~bN_Ñðõ ¾ hq ÝÌ&%aKQA‹jd. ‹EüÊÁ~Pã°Å>° ä'??ÔKQë&((ø†€‚OVD„&Á£à˜þ@züÂpF Ñw¾QGuÀZmH¾pð ¨e+Àwo`RÁ7‚Ñ‚œ€M°Æ10„i¬CP¸bÐ=ü ¡À“ >@€´£'îÈßxp†/àRÄ^ñŠ'à.xÂZPˆBÂ8Åd’GˆÂHpÄÖ„-`cŽ†–àˆ,èAHˆÁ4åº!ƒ PðÜ4šà+4¡@†Hßb! ”:€ \†0:qŠuX Óh_fPŽj„b Kø­J1=BlâlPÃ+QS‘v~ƒO¶hO‘b„&@B¨p*¢À>?pÀÖà:îÐþ ¨@ÞÀEóô?#R.¾WoÈ& üc@0ÒZ Pã  E@0 ä@³:`€` a@-%á5l ŽA‚ÁàБ倃r(ãE ø„d€ õ>àXG•­Èîu"²ÎAw<Á t]Å*a…ÒŽ‚{B@-d ƒ(a¡ÆLK€ àËx꜃ñøB¨)HñŠ3\AÞ £7Vñ @‸#Æ 9|!\è:špc~Á `šЎ é÷Oè ˆWLÇ [´ö B«`À ¶àˆ&Ü` _à’'LþS,-‹p0vÝ WÜ¡ŽÃBá¹¾lyHø‚'šqŒ²|A¸Ž˜A¢`á†-YÈš0*¨Á¤X…n…;D‚ÜÙ0„!žƒ&Ì!fD#Þ0ß*Ä"-ØH£mѧ& *á)5p à€Í@8öã€[,AVH…=ŽÕâ– 5Œ`‹ü‚R¨ó>‘ƒ$P#VHÂ/Ú%ÔÂÔ6wvæ‚3¬YXÇf‘lã⤳Ƶgá‡U,mX8RØŒ1à`-T^‰eXOÏ ‚QðUcX¬'à ?8ÂŽX°€*þŒ" T Â+Æ°bHâ hB’ðH¡©àÁ >Q‰ÎÊaà9‡¿ñŠTà Š8Ã/pAŠà7 Æ–‰ž? Nµ ¤­À|[áwø¬¡ˆf”ƒ c8†é¨°ŒÃKgD8Š ƈ=¢ÀE&¨ÐfHáPQÁ+¾`öU" ˸ôG‹9¯B¸ðÃñ{Høà äÆƨÐ(¬£Qcpƒê. kлÛ=a…%ˆ•l¨,P„S€‚RÀ‚/0Œ/ø‚%˜­,Cø‚Dá‚U@k°J¨†RØ„@à„2Pp j8=8ðŸ`fþÀ%X©ç¸€j˜…(¸1x)€„O J:‡œˆ/‹ð—'hZ{\P;+(³'àQ3´ã“R(†r#øE$H60…Lp€10S@9ðÁ;PŸ(ÐC0Ѓôº+à%˜YÍ{…+Hjà3jÀ0…°„Eð„Uà2G°$,ƒ5H19x`€_ Ïú€ #€X†L¸ˆ´Qû‚B°®j 8€2C€()8‡X†QPÅe >\x……-Œ+ƒOø–h`¸;€‘Â-; (˜Â# po þw-*x0¥û…Xƒe›S‚ù_8ƒO8«+¸‚/h*°‚^ €X…3‚U"x„;€C989Ѓi@, .È ?¦(€„â =˜F4¯UXWˆ‚l˜¦NPÀ*8jò„-è„cð»s,È‚cX‚Uh@Qx%ÀJð„j‚Mh„F J°œzˆ|¸x‰–ox€õøÁ(¼BRÐeð9¨µH †x+x9P°‘x8ø"£'X…®\_€3¶“£J@< †eXƒ+¨HЃg$…K[4ȧH@+¸þ%†E0„YÐà€1 …™…X€ZXH¨57¹‚wù"|…,`‚]ƒ&†y°E0…K™(8„-È€3È„WÇÙ<>àù«ø‚L …o¸‚GPoX†BX†_ð…ƒ@€\»‚‘Zƒ'h9)º-pƒ5PE ™k =Q‚/ƒ$0‡àâžUÈ‚º¹ƒ1ðƒ%ˆÄðZ±QË€4‰,#`€Gƒ$ 0ø„ð†Èoˆ«öГ`ð3úÌ¢† ‚<*Ø‚0 ´‚Ká'* HB:†1¸À¸(®u[à9$(¸·1˜6ZŠ,Xi€G…*‚Á¢JKþ „(Ⱥè„lPOàQAl,80ŒV/<( ¼Ð† „8#ø£L‚/@…¥,‡ÝX‚U ¡ØY=p€qðEèÏC8ƒs<ÄT Ù{È1S ®#o ³+Àh=:0àŸ9 †}âÌ4R`HÈ„-P8m˜?˜G¸jЄEÐC …ø(ÐkP†Z¨ …JðÍš´~\½º‚3†+h†_˜" Œ-È‚BX…qˆEø +hëx´9zG&`¨ …5ÀÎ<Â#8ƒJ(½$8‡ï˜¤+øÄBP8´'ðjøJÉ£°…XœþãÜ@‚\»t˜Þ»kƒU˜ÅÌ(ÐÌR¾_ &0z…X`€B@4 ò†A9!y€hIº_PGj0) ‚/À,81ØQ(øØ$h‚1ƒP®zäk¸†+¼pk†UX‡@7479@LK[5Ø‚9ðÑš•Ý‚nZ…+8…!ÀGÀGÀQȆuˆ-°.Aøƒ?PƒVXÁrø[p8ˆ#Ê“‘Iܹ†¥j”’ÿ†C(eX…LxJø‚_¨+BP´…Z˜ [8Ø6jx‚ Ä…1P„eh÷ +PÑ?ñÇT¨þ…-¨„Wx€+Pºsx…H€5€yˆÌU€ChÔ1ÐMðf°$à0‡=ù‚JÀ…¸ZƒU(-4kjÐ>¶L‚@3\{9 "+„W`€ú€Q¨Õ/(Š…Åc‚ø…¨„Gx;Ñý‚‚5 Ž-54g=1û*T±'ø´Ò‡„•*(Ö»‚Ch†P„I‰9¸‚(pS°pjࡇ‡Ñ…8Åehº’‚3%ݵE€é‡$8m`€f›a€†•Qh$ˆ†_PW¸lHªÀ`À‚1ààñšOèÊñš`8¬ºƒèÒþ£.kЄz-³U6,°„Uý–ø`è*ˆåš.ˆ‚+ø)Ђ?ˆƒ2ˆƒ´™$iŽ~áf@Ü–XpðqY‚HX\(„5h_ø¬Qƒ¨’ À‘x‚èÖðGR°둤{´eP¹•‚e˜—;H)`XƒW0‚€c0 P…{ô”,°C¸=0…fÐH|TH¸ƒgІ>I0ø¬p”[ƒUˆEÐQû0ˆ„´{…JX†U¿3Ø‚Gx9pƒUàÌNç|ŠÍ‚@8ÌÞ%\À…TUo\[àx‚:ù'äÔþs(KÌ,@€ ‰ø…Tjð…' †&H€•|®Pè,ˆ‚&àgœ¹ýwr‡žáž‰ áˆ91"JéàF”Á‘o¨? •XðAÑ t“A霱h›r°†½À¥º)à‚c°¶ $¸hkp`À`à>iÀ…¸m‡]µ‚à€sÅoø…І˜‡sù  Z1J¸EÑAlÚŒ—3 ´'ðkx†PÀMàtö™9¨ðG ˆÂÅëj„fºØøB<³À]&Ñ€x'×}3“‚ 4­ð©À%  jpþ†^p †½î…  †#Ð?Ð @…%ðT†ƒ`= 0¸Gx)¨…qPR@BHP‡°9è…ÞÂû„ ø³*×£ª£¿ìl"ø³ø&`"ÈwX¤``Sˆ‘„0ŸH‚¨p¡»°¥Ë¹ A¹&p…¶Ñßà p!l˜†cðƒ@’”Ï (è^ú (†b…ð€b`… ¸€dðb@kÀþ  þ`Pqq(_À ¸€ ø(…A˜6E±xâX‘ø_ >kÀ?¨’gPe@…)l@l0‡q` ¨1_m †Q'lZ\X€(¯¹(nÜ™_Hsì$ ã% €Ðmð¸‡è8( ð¸Äv ЄÿP”X0©¨†›!¸†0søÂ&ðmðyI u¸‡#ð‚^P ¸‡ P…Øs ø€^È«úªÑJ‚ ‚¶ÓÇ_ÈmX€«ž³iÆIᆆ€Ð,#xzàÆoËÐsäF#Ð|þ‘8‡ck†q@†PhІ­˜Œ@‚39šˆ‡xp£d'Ÿaˆ}xø!?(Ã(…lN˜ÉS‚XÃ@ -‚W)…K˜!(…äXAžæ™ƒ9À‚â)i(‡NðƒïÖ’f… ¸‡ H 8vfp‚xã'\°éd_¸P%À€…øð_RÆ`ƒ*ئn˜‚Õ çø“9‘¦€zHz ôz†Ýa‡~)‡(‚Р"𘸠ªl¨‡d—vy‘†º‡@?hŽjP†"˜{`¹—{| «ð…0oþ(ÿ°–j@–Š…Y@Tx0=€œ¨ h|¹§|Ï€Qo‡DS„ h‚ ùF"€0w°_&¨iа" ½± ‘|ÉŸØý?çû³vrÜ³ä œy‚+ƒy`\h‚fˆª¹?~#`£‡sЀn€€r¸„}72I؃8h„V¨‚F`„7„€/N؃7à„ê „@ ƒ=ØϨ ó—Œê!>ø2øF`„F0ÚK(…»@h€øÒäý[®…Êô,ŒuQ„­[8­œX"Ju‘­IzÞ&Üó¦#Ä…Ä*ˆ!JÍp±\Üþsá–0òÍ€$l§@`ËV¡öP9§I ?ÂhѺ…®ZµkØøæ‚çn¢EKb‚3 HøF@©:´ª•«aAß¾Ô VÀÅ/5üÐò¡i–ƒjXÑ9ˆ5uI(´É™F W {ùÒ -Zô7#Dάuå•œ'&ÜZuF'½ Fè•nç&ÔÑ»GÃðâŽ#G>a9ó ιpG€€;çÜaÏ®ž#íšX9Ce •&íÜ ðëçÔb BJ žâ4â$HPI’8qÂH þIÒEœôW ‚öÇßœþØŸ’⟠oøƘ!‚Bœ²ÊRxa‚+Xœ’ÅUpEŽd3‡#PèáIF§€Ê%_ˆ… %xA^`‚çŒ3N9X¨áÈ5õàL4Ù„ÔBÍË<ñIp2ÈÐ~„ g”C‹«¢‰c·hÅWðM ¯œ€-i¥Â4”ð eðĆ@ÖØgê €-ßH:Ž2 8@‹càŽ¦·À Iw £¨X²†ÂÄRƒ^ `£Æƒ RÒ«€IF”ðŠr0P‚;%d ;&`à³Î"çA³ÓJ›\´Ï>KLÚþÉÔ­·Ñ¹`Ä/ÀFG@9äÀ=%”à™»î~s€=Ê<ÑDgP³:—4Òˆ]8ø_€œ¼!H"Wèß„a‰P±„üß›l2ȇ"`!G%MxÀ0Ž`ñâ Q¬sC(†ÜaÍ4jDÑI)Q\2Ç)\ˆ TPñÈL¬ðB>ØøQX2C9·xKåMp“7RP“.jò€7Pó‰Á³ÔÔR*´d¡Gœ× ÓöV\ÕàÃ9X¡È*¨ZÎЀÁJ,à‹2M(B -~TƒÍ£êÙ‚@<°@-Ê8†6)³$N~ø‹,q ÜñŒþ¸jŽ9iÑ*š D\±F¿ô ÉÔ­RÈ*ìÒã_šðlrØïzÇû%ÚvÚ~+=ç”à¸s¸F˜ÀaØDý÷ÑÄRÁ5L„‚gÔ­Lò„üI’ÈoðñÆÁ˜ œ& '¬ …˜P(aü¡˜Ä$‰M0 >(±…Q”àšˆ*b±C,†ÐCÚPŠEÜÀQÈ‚'š .` W¬@…/Œ¡0@Ť! O¸Á¨KÒ”jò´ I¨ñ\xC˜Ú¼¾¸àRX…%h!Œ1˜"³àŒÜVƒ_˜ã†Xƒ!´¡ Õþ¡QuÀÀŽ£!r¸()Àá¯,®/b @˜°sÁ10Ðà €jÜ¢wÔ„® QDás¡ \õ´`²u¡1¶°#|€ <…;Ú±ŠU|ÁßÈ€ô¨ã¿-ÇYËQGs˜ã¼+—º€;FƒæyK:Èž­ÚÁ„vàÍ&À6ÐÌgÆ ±ðÃ1Nq ,h¥¨Â F!€‰ø;X"öc°qV(A +Püæû½Á@él1ˆ”\Âcr0?Á³ …%®@Š,>¨ƒnPX‚¤X€…Uœ7Â1ÊщlHþ£ÂàN±Îõ°Jx€7 ¦<á …/αRj¬‚N$€LZ`74c b‹kt‘N´à€<à&(ÃH#×x„^,çø€2d°ˆ1€£+zAÞ9΀s¿P:nŽEèašš+-f±ˆUDÁQ(ß,NG'{Øc:Ž&]°ŠG0À¿€ÄÅ9\aO Œ ˜pŽq9KêXÁ 4ëœâaÀ5¨ÆhK‹ÔÓv¥æ¨N·~ Ìë7ß(¥®ƒ0Ýc&o‰?”cCp¢pŠmîÁv0˜ÁÄ°Ÿx–3b Ca ëÂOþž]ÀÐÃ$0I¢Z0C+…3À ã`€<¼ñ @äT…x…¼a@æ°. q+X£ ŽPƒ%2‡RÌ¡ƒ~A‰HplCGJŸŒœã=hÁ#’ð|càÁž  ßH®€„gX3¨îÈ•¶bŨ¸çb‘W9ulì…zq„-ä Q€X‚cH›G¾ð±&瀩êt™+Ì2 (G5:wCÌÂeë dÚz‹é+Ð$=г/ÁL(Ax@b5¶:ÇÎ0Š dà50æ1©§ÉhØ)ÑÕ¸#£¯áØ£:þ.—v¸šsئôHv˜wa·½Å†* m€£~XG6.!‚IüAa˜0'À V¡ýS˜Àß„n-!FÌ?³PD¿?8˜„žÈÞ/R,ƒ_â [=ƒ–A @ô=` aˆf@aŽð„ÔЊ*€¢è× Ìp 5@áÑ(G…­”[¤õ.øž°€oÔbOÂ9¾± €š¸†5$ºMÙX¡E ”Á[8 ErÍq6ŽâRˆÄìÑŒE(ÍS·x²O,”Qb Za!Q±h;³€„` tXC·ÈÊ™§'”5ö …þx~a‚v”@{(D%® 0á  ä 0aó`‚©GÍ[·¡½Qò–w¤­ß 6î˜tt°séoÀÖ@^ž`‹ÅŽãè%¤ÁˆVh».§ bñƒ¼ƒôÇx\;7ÎØ~ŠÝùùíZØDè &P#d!B0÷;“˜OP‚,dñ‰J¤B Öˆ0J¡£A´‚}`€8¡P¨!ó†0ø™@)hA-”  àBHB ó @ n€Ä-€¡‡%Eå:`Ž[h"°Ì¯á‡[pàpòÀ(t@ƒ ¨ÀÜÀþ'hC*€)t™2ŒCÁI Àã¤Õ@ÇÀ, Ä $8À,C(‚B”:DÁ :pÀBÔÀ7¨™ä˜Oå€ôl X–ð@k\ÁÐÎ*4Á7 ”C(8B@Á1dÃ:8d ¬CÛèV,:Lƒ)à DÁ!PøÊЃ¾¹Ãlq‡+õR·|ƒ¦ÙàkÐCd@€°€@<Ï9Ð@ ˆ%´#At&ˆÁÁˆ$8—A¢ãÝ„A…H"ãi^su ÀÈþ\—p4þB ž'€B0Á70Aö0Øù`öDC-j€Œƒ 8c¬ƒ0xȇ4Â&Ÿ$¼ÄA :`:ˆ€óY_Ø<ðÀx5àOi($H•C(Üù¡‚ü)Í-ÌÂœ8ÀéÀÀ ¬ hÂœ 0àÂÜ <Á'lPà èX|Y5ŒÃÂ#œ)$Á8€-€³IA|Y=ÆÜ! 04CŒN3èŒ#Ü€#  ÁA=„ÍtZ ðÀ0äÀXÁ#@ÖXAº¬Xԭ Ò<5ðÙ(|.˜‚#xTàÁT.Bþ8Â",ÂR)8‚)¼ V®ÂÈ"p)˜B;~@¨•¾iÏm(“Ð!óDÇóD‡P1`€ì€ßʬEŒø€€B üÁ$AÄàZ$ ‚B'JBuÁÀàuéf^¦d^9•"ÄXèÁ\ÌàAðQ(pAˆÂ^‚gîÚãLf‚&!d¦hŽ"¸Oð'˜þ„4ê&´%Ä%x‚' \B­ŠŠÌÁˆ‚ÍLaˆBHyˆL‚º5&3êG9a”['Ô@0H'ò’ÃL|ãD`x#.TÍœÁ|‰Á Ì XA&ˆé ¬Â<BTÆcÌ€)|•¦(B‡ 8‚áÃ=`€ŒB€â$dAPÝ%øà/PÃ’ÆŠãdã2|<ƒ"ÀÀ3‚)\C€Á,Ђ&ÜA3peP‚)<š)ÈAB]Á#ÂD«*ÐÍ+<à×*0ÁÉœ¾QöÁ ’"<Â*ŒÅdÂ,ƒBê 5)X‚(Ã1À‰(ÈAÏþÞ)\ÁPC¤ÂŒƒ<ȬÁ24Á”€ ò€;P$v8²Ø]·@¦ Ó±ÀN<h@õQ˜ 8@xÈ%L¬ÕÁØA¨J‚fj&¥†'ŠÓ¬¥Aôt¦þ<¯ '0g+„Þ±’ÁÄÁ&à0Xné=ãPÂ%à(nŽ€Â)\D `n¬=Ìþ€æ~hA#ˆB'X@0¸C5B+u.…-dÉœ{h€.ðÀ2¼Bt›ÆÂ"€Á Ha800¤U€:´É¨LêDÁKú:Àÿ-Ç'<‚ü‚WÁô‚(C!ü× íR þ@ Â2Œƒ0Š&€ÁÐÉX9D!8ÂçܧŽiœR3<€<‘7–ŒhÝ|Á´Ã9pGÐCLmÁlA!´Ã/¨eœQÁ*ŒC3lºÊAk0A3Ü€%´†7$Â'|§ LÍ*´€4…°\A3„\œÐÞÀ(0À90ÚÖ!0- ð^, €ˆ€+”ÃU9ø ä #(œ%°*ðuAb¤!$B`&¨râýˆA¤”A8ê&!ØÁüÁðÁ§Ò üÁ!ë& HèÙ°l‚&7â$Øxr Ø°šþp–² ££r×äEæe&'Ä(¸Âó¸ 8Ÿ-¸@R¸À´Àô¼T0,€|Ádä}1Àè)TU(ÜÀ àÀôÜ5äV Â…B,TÃ4 éÜAÐ8ÊXA!h€<4P¢‚Â-H$å2HA0 Ñ_$N‘‚2 ‚&ÐBBüÜ!gCƒ.°É@…@B‹Î€؃Š @¬‚‘JA;|  ÈöD‡NxÚ9<Á<ÂPA%Pñ((‚x€dÂ(,¸ÐBµ‰(‚܃:TÂ*H 8ƒ/xÂAÀ0lA30@;˜€þSCRód\f]Úy¸€ |@(œÂ‡”‚%Øq•ߊ”0 A À1ˆBé%ØArQõA|&äÂAk&&$.##"”A° ÓAsR%ÐA A&´A&ï„X×+ó%ÛÁlBèòT¶º)òºýÁqþA h†øŒSÁ´²§†A°ªH€óÙÄ<_xÉMÇ”áÂ(àI\´H)@*H…!”Ã[-$¸A(Ã3p€œà4DRdC(pÁ5˜aLD5ÁÿõÍ(Â`ۃà @Â*‚"(Â8$Á}€  ø‚DâÔ*C(‚þyFˆ%ºŠà°~ÒÂ*ÈÄÂ3|LV”@3ì4 ŒlÁ+ÐÃXBÄt âÔ#¼Â7|$¼Â*¼Âœl¼B!@‡Ÿ ¨€ ŒÂNž‘y@ ,C*¤|‚ Ü@*¨€( |€èJa¸€¶Ði AV›U¯í¶ôç€0 _¸büA鶂xu)$M9ˆ‚#tõ¢ÆÁ!KÂ`ÂLf€*!<®â굧V‚¨XB ²t B&äù#|Á%T¼5m.do×*’ðÁ©îýt®†ðÁ&0#0cè59ùhr:›gþÇØ2´Àï @0à‚Š}Ã/Ðö<5HÊú2ÂXAdÜBD­CUÃø€2Lì,ˆ3 ¶Ì’“ÁðØ‚,¶ÀÃ5Ê`cÓ69DþR2©b“?Þxà A"S“±Ê,£¬ U5TÕD, ƒ“2Þ-<ÊÈ£´±‘Kb¡6Ùh®ÇÀ…s¾ùæœ` ø%˜’À…š3 Áà^€¥‡eHˆh x1 ] ¡; ¸'"< !~ùÚ\F#ÎAÚ Àjü¸%?Z€Ák®¹¨œ[,-‰sƉ¥g@ÀÁrÄ1uôpu~¡Ç…_2(žÜ1ÂΉÙ^ î¡·C”}&¡Y R??bA% HÀX¤=1¥Žg|P€`ªýË+C4B„S(aƒŽIÎ $¨=ÈØÖ.ãþL’¯%«ŒMéhD(>¨@^¡ÍE­ÑEÁ2*µ²à°c“4ÊPC06À¾³ ÅïdDܸ& “Ñ.c•±VÕTŒ>±LÕC1c“_}Í‘<òHLò˜#.‰m¶ÚnËúÊo‚±eAÙ‚`œž‚)¬8#RR±a™<Œ×€<¸ç„&€ Âûîv Z8àoø惠ja `f™aT¬†èà€,âTï ؘ||Œá€$ðÊzq‰ŒÞxÂÀ„_D( p‡ rp3”@‚:£—‡&2‘ †þÚÆa øÀ pÑ y<Àõ°€9äc i=xˆÆ„q <¨›ˆCøÐ…=Hâ ”ƒ±(.º© Fƒ‚E‡^±!tð*ñŠJBQ¤QìÀ²ô*NdÑcÊЇ:Þ‰­CØÌÂÇ>ÐAvˆhƒ¡:´¢iàÄ©(YII$‰°C&…"‰=hæ ‡Šƒâ;Omb}DTèp #x Y½Np ¾àÁ°ZHA Þð5l …¼¢=`"ÐLLd €20d š'ˆ€5# „(~pr` <`/<þ€F!0dÁYÐÃ"fá0ZøàKG, ¸+à"´‡9ê¡ mÔÀ½j¯{@ ÁØi…+„‚¿¨@4L &„â ÑØh 0œ4ÚÙJWJËÒæç € Æ1ŽoŒ2°ª´ù,ãôXÖêáP"›0'†™Í,&u:MZ§DpQ c Kâú;5Œâ6p# VQ…2Ð-aØ‚õ•F). ‚ˆ!ºhGÙ½ÎWlh”I¹A²0­`Ä…RØÒñA o8KÂÐ-´¢'vhDñ‹+ƒ§úHˆ2ë~ð@þŒÀ»eÝ&h âA-¼ÁoÔB ¨EóÎ@ ÜÒS1z‚ÐC^#ˆ¡ V|s '`…@ ‹)ÄŒÄý¦¨Àß|CœB€Æ\ð@³¸ÆV‰Pp`HƒpeøBR0GìZ¿æ(ÀBj/gDÔ^ýÀ2ñ&Œ#î!²ðˆ l‰¤ê8‚*Tq„ˆ¶0"µ©Ò†«ôÒhMÀ$(Ït€v€:˜À=ê¡ ½–õÆð€‡8üœèÂbå2f`ƒ\ ñ&LŠ!-›|TìñŠ°ÚÀ[x…'Κ*úxÈqÊêiþô(§²ôX¿â#ù˜Æ© 13!aÄ euü§ÀÖ(3S²­0+\,÷Ä;õŠÁ"Kâ‹^x¦õn-…'È`—€¬ ·e´ÀÁøÆàc„)àða™Äñð –. €8VòÜhÁg )ù‚–±o|ãÿ@JÎaK\AÂ`(îàˆgø! 0„ÆŽ[(Ãì­A n1í[\»ÚæYÐDâ£2ˆ„5´l0(°Æ"ÀPpÌ# õÃ>èzÜß÷ö°‡o´âÅHdº‘… pSk€—ãž¬Ñ Qð-ƒ£Úàþ ¯0Ê­nê¡,~q8ä!ÐièUØpˆJ„õ[°Á'Vq˜³°…­Áj“ì`n–4˜r°Ëlb;ÇéÜqñKåHî×Ê)ÒS|µCï‰Làt€:2!„LT® dØ[cÞÇ¢!³›ýgø@¦U€P¡ÔHBj‘„ø‚FøòDz étÁ´ ]àœûÀ‡ ÿ‹/gçð†Õ  ]ʦòô R ¢³X0®±°p@Ípµ§e(#ÓN-¯©²`üÂh°Æ8˜  TÀฃÜ} mtL% Úo÷ýþÒ^TФ(ÛJmäø$Á¾x@ÀÑÆî}¦7Æ!xàVÀ îÀ ‰.I1DŽ­DÎê$æ­Ê"5âÆý‚0á  á¶¶`,A 2Áø†å` ¬À ¡l`Ö !HÎudgÎ$0NçŽÎqjÌ'z¢ÆìqpÌ@ § ZA(Nú,Öï.Aþ°©“Hn À§‚£ž XKVR’À ¾ @@hñ8àæÁ`äáìA”Á°Å:qaˆ´ÁÇZ –`¢ÐzC>è4 š!f8À BaôȲ8`Ÿªf‡„¡ò£„¡äò|ÀBäáí~äAäÁš!BѦaüÀ\!n@¬Á €šRä¡—"ij0-ඒdtcA<@{úít¥PjZ¦Z` à=np’€Œ`ìî!>à èáT,.-¼$Ñ­B®Ë`®D®ÈèþDqÉ þñVn: a >áÎà  Œ;ýQo ,Ú¨,rd'èÒÓèÉSÚ n"Hv(‡qþ/ð@¯bgÈÀÞ®*@’®â„H²dNx 8% ž vdÀæç–Áx…A¢a4A D…a´Á´áÀ*€ 4‚oÜíE=è\`ï~áÖ¨ÁjŠ=äA² Ä HÁ?hÁaf¡ÐÁ€ PAÚ‹D§f`„ap€–àÆ ”¡¦Í4!€A.Cáb@Ð €ab Á„! þ”¡– €O9 .Âüà"À¥¬fZª…F_I"2&ÈC`ÞC^a¤eArp4M0@¢aA J¥ÔFN¸Qä0rØ XÈBvöˆ,…ÿ ¦Ê^a:§‡;sµViÕV{ÕÎÀ.8ÅWÄì<Ñs=/ðWèଆu@nrÒȳú€ $ r¬,äDh' 0iè ËChéYªäJl¡´êŽ” [p!%—ád€ÆàÆp` øÏ*À¡WáÀAäÒ¾`,ÊòõÀ¢Ü-½Á]GÁ *aLí ²` b¡4a Hô@þ´4 P4anÀ „! äÀ€¡ á¦!šAF–#PáÙÁBaR!žÖÁa rö ŽÄN£„ „Á ¶ 4H$j 5vÚ, ‰æ§ð d~jáàxpmö„¼áyž€বe~ZÀš€à6á 8AÚdp­Ì"çW·XïªU﨎„®¡ ÄÊV¹ Áq•;m5¦ó ¨ÀÜ ‘ ²«—äš!‡õ ƒev\'è6ÅWDN±R#5ÔB2ÊÐ P |Â5‰„ç`&„`~á¤`x¤ í¾þÀ fÀ°`¢à Á°ÁÚà æ± š`° 6 b î€ b!† ápÖà Ρdà p ×|7 4PÁ²À –àÀà–@`Á Áî€S‘ ¦Á<á!ha4 ba2c! Ú`na À–€Ða ,ÁÀÔ ²À²` :!ÀA ÁÆ`añÚ`ü€k%š…í€Æaj@̉›˜‰`w €–á–á FŠ±‹ ¼À € (•j -TðP#XäätßÓïêç"GqÊ€þè"¡/Ê·róÆT@W}ÕqS!îÀ/äst%pXË"nàæs w>gçó€­ê( 4R,|¡2Õ¼;©€`4KL¼À~ @.! DÁÚ6ÇÉš¯ ‡rü*èˆ.³ÊÌqŽÎ/ð a ¶àz¼ÀÀé,hr+wz*!#óªYÕstt­ÓÂÎì Ù «ø(vàâ¬PP.©v²jöÚzaeèîm¡H@Äû,€žà þZÀ_ºa[΀>!ºá ÁàÆù ²€¾¿€¶ üÀÐYŒ¸¬)›á^á ”r*À À€]Àp ^àÚcðÁ–áBA#| ,a8@€a œWaOõà‚9 fÀ?¦Àáh, Œ¡¼!¬`ÒAp¡^a¾` B! ¸àô`IôÀÐ ô Æ Š¬ ¬Œ ÀkÓ]¸Vˆ¼AÌAlöÔ`Ê ’öß«8 —À~A|à HÁFaù‹`°!–Y\aLྀþì€ 8¯DŽ΂¯BÆç¬Yã&t.‘*Gè0 08åè2¡Élõ·:²àÊnäŒõ®L! ÇWô(‘ØÀ³6e 0ÿ@oÕ†PœÂÀ¼„:¹gLªvàDî\ž'¤à R¡¯ `!6 Ráê`–=áTàH! HAùBÏà*AÜàv ¦ øAÜÀ ô¦9v}H`RÀHïë R À `aÖ Zànà r >@¨!ºú ®À:e;Πv¡b¿dAÜ^ï÷/„i¨Á ¼ >þÀ½aZ` aD:¬aÀa1ÁÁ¬!ÆÁüö¾!,@ˆæ¡ æ¡˜YD +áJ¡ž¶:¡D@Dá…=Á¸×a(š¾à3 `ý;Áýñ Ê•’&¢—9„‘ÙÄÇÌž=œìØ¡“§"E3ÂÌlJS†M6ó”©H²OD ËL,òÏǸRA—‹o~°è6¬2'8~ ƒà„«ÔjHÁfƒŒ1Ú8XHà-”¹Xx PbÁq2´ø0ÀŽe*d±º€ÁÝ îaèÑcBYLÉ`„/LŒ˜ðâ!C/C°ÅƒX\ÄK'CÄK ëäçJ'û­c`'P¸rL "!‚ˆ`(U´REqÄ(”PbÊ%ÒĈ :M…žH# QJ)§ˆ‚…4sœ"‚Á”IÑAˆ Rˆˆ”fðAJE©‘‡“EÕ¥R0T"Aþ!¢=ð¤¦M6rH$BEeKFREPi`’FSeìY•R{ÚÁG„¼ñ„ðñ†$’tÑE"pbGƒˆÞ8l¹õÖ%d€À-åÄRP)Tª"Ä"M9”ÓI'å¬ê*^èô÷:-–ƒÎ:¼FE ×\ƒW„\ãJ¨1XsŒ+1øC èôåÀ´Â`SPøE9٠አ®³­èÄà+³ý•C6Ù@ÁD4ßDcBî¸ÃÁT`DT0Ž(ÁŸ4ãˆpãŽPtbáŽ:Îá°±4< AqÅ;Šr ( ˆH)“´Ç!v…tØGZ bF)þB˜a†Ž¢ˆPŽŽ ÄaÆ$Œ2H­€BjTA‰('õ!Mn¹e”X–d•ZlÒQCÁä Eq&I0±‘I!*rÓš6½òæQl4U‘˜G…žd]e7!”{\•èd½±‡¤a„!&˜ìÑÊ (ôÒË/mµµéô|“p…ƒL¢…Èìr Btóæ:Êlºé;’®c…£Z!Ì®£ q9¬[èCíGûîZ|£ì¢*ªë­ <ª´Wè¢ ³ºZ”2ÈŽšOR=(“Œ<É0‡j4BÉ&ƒ´ÒÈ&\µ²‰›0"ÊCã‘F”)o’Þi MGþŸv¤±>’ñÊú¶g‡¬xm(Eá’˜Ô¦tä$G9GNB’&¥œ€žFìp’¤ %H:Iâ‘°a6@CNÎv6d"G‰ÒHèD” "å*‘òJ¼â”ŠÄm{àÃ&U8—|E ‚ !´à‡^dr‘s‹0PWÌasfà'µ(Á½]XT$Á -pBpA|ÈC´H†7!+„@CÈ@Ç?hñŽZ 2ȉFpBZ¤ á3™•Â .c˜ŽvtÈ™Rƒ„Ä¢Ì ½AÒedØCV¢? -%e! žD¨þép$HzÞ¢Òòé‡MùŠŸª‚þ‰¦„aO‰Hƒ–/ò-*˜`Cú€µ°ém€RŠ$*2'“ ) ^ITÞ&¦>Èo{xCV:3;å›D±`ŸŽÔ9œá6øÄNÚôŠ3¸%3\ÊþDÒ’·¹dOMº'¡>%?í‰%l@C?톰 o`ÄÊ‘  ŠmÁ@4ü ½IÜQ b‹ÄŽfTIL"¡à†D`b—%åeAy ‡«4,r”LÇ(‰7ÂQ|è‚!Æ.lqŒtÜ#øð:râyäǨTCÑP1•DyIPĵTR÷‹ 41AP½¥¡nR©J,[j¤xõn³¼e"¥UþBl´¥kåhB6ŠÄŽ~¥£‰à(&à)8H" „ÂŸÄ ”;‘)Ov+G x¯ða‡±Ü!þªÕ–<Éf`ÝëÌ¢Vìï(ü<R¶6õ¤i?ŒÛSªB'jvÉmbb !ô4ΓDIRœ©X@ú†F,4-&xKä$Š Ho‹ŒêBF3š×$.7¯uÉGß FAlÔ¤HŒ+]aÝë‚t¯'=ÜGŲ[Ýr7ª’(o"ìRF…å¼ &È’’Òµpp i_תR¶æ7Rn]«Tò;K—Äò–NâˆIZJà¦t”¯Íï[ÜQ1ôAG”ë['Ü×#z•¬U¹ÊHåàµþ‚™}œ¢ú'‚ÂÁ‰0&Ñ7DÝéIE,V碂¸HGZ8Ú#"±Šœ°IM€„MÔ ¶‰²µ,‘R~(%·PõlJQ$Õ‡’".]DÿÌàà wŠÑ€ba2¤—»Ö iœË\1< a†.„#¼á O8‰Î+¬[aþ÷¿÷Ëh¤è^úÐtÝèIóËÒ×Wч¶›Y»L=ù ÄFt‰I1!‰“Bª¤Ý«.õ*†„è2Rÿ]k"ÜÊÑ>\U»t&ĬóÚ‡ù®ÒpƆ›"§‘’…µ7±UÌÕîNt°‡èð!5€bGs€ØË„ðŒþ⯨Ä:ÓˆBâ°EÄdOÅ–5€ Päͽ™5Ob­eÞ`ß÷îag¹‡C1ж¬%U¥ Cy“H^õ敼‘ïvJqìFZ¼‡ø]Á"WWÓºä½)¡a½è Ó•¬8„ƒ­uI^¦¡ “6œßÔš‡¹ÎI°= — Œß•òR-'/xÃð¨ÃZ²* ¬ádYt$æUØ’héFà ÀêRÁ®¶ŸÊÀVÉÞs(N"áRÂ7:ܘm_.Q&±aD„(²° œ!jÂIN*Q‰TÜáhìþa ¨¤ÄO]x9ñ¨. Ž«tá$Á‡4ÌÁþx"Á#wð˜å6¾ o8wŲ݋c¼ ‡û2Ä#ÍÝ°$ñ¤ït¡§ÎgˆW˜»³§ëÆ%Ìúâm¶ný Þ©{^…ç·äº‰]× ÆÒ«d—%±×êi[ßoøRÑP¦oண¼ øû§½¥n`Ž»üzÛºVgÙ§û‘Åe¹ÊFP¦J¬ $X*ÊþÜ`‰G¬b[€6 •`n…P [ ó6JÑLÓ·'?TMùXZÇá×'¶¶W|Åvp ˜Ç×îppУT gØÅ]''^ˆÃh‚–zª÷‚¤'lxÅp7õtŒæ‚°ÇpõQ¹wr¼·\×EzzÕrwu'Úgþ¶…•(á§Vÿ„'Å×V½fù¥}OQBLEÁn7C-QVPÁZJÑ'tóöOJck÷~gø'ô4oô„O³$qãv5dAv˜ –>x rð–ð&(á 14a¸!æjúà7X-eB}Ð?ueVÆ_ù… BT e‚!8‚( „´E _)¨g`^ye8b^wP™( ‚ÐQp&éetºh8ï%iD8„ÐuqÊ…Wäh¤ÇWUÇVøSK |dQy{À7xX±´LúäôÅ_…“€|À*~«[¯d|N1X`e¬Ô€kÕ6K1V1'eþ˜ˆå8b (7Á$PÂ(MÒÁ6MÒù$t€jþxL>$%v#'Ù~†}rA]RY‘XüµK‡£M¥P÷À÷ 0‚Ø ¢ g"§[¦öp%Wg¬hR%ÕŠ÷t&ÕQ’°]­(^­gPãeq8(i+È\`ÖƒEÙ‚SGWXkpëg7‘R8z“*%kÕ|ºfUa±K³•C;t…V xBa¸}o¸ubõ6.Õ€$&V¯Ô€ñdŽ³ô5OAM4NvvQR‡n÷ÿ¸$YÃ$˜OcA°—ëÇZTAbþˆçh³eóõQí5 BPõaþ#‰ô (p’sÀ9dRâ’–9‹¸^ïõ’£VzE‹Ð%lÎõp¢_¢×š]ù]ùQM×›B7„'ÅKb`b%Y–u÷4k•Œa ‹ÄÉ‘Àæ“5_¼Ä›$%l.—~%$&é'nÙ˜×K[Soo¹}§r|buù3T’èCw‰@`Ó4„i‡‡i˜54JÝ —K8‘Xè6„mÐms'ûXuScÔ`3›yçàŸ‰è€°Üõ(·_­öVÁ{¯xPÁH„( zÕi”åå]æ5j9)lcW²¸p®ç(²×ƒaùå`ÆuÊÇQ~³W 1þrBø\=X82z]—Ö£8´Jw5Xà9žPZ|ÄeožU¡žÿänç÷'ïæÎ7výcY±Å$ô6vˆŸ¢Ô¥Í¥Ë§ *[R&xV `³µ[1UF6c"I’P/R ðzƒ¢RH´QÖ•a±÷‹±GgVŠ¥(„­Ø]µ—oöt¯G“Vùt;ª“v8µ f—_ÊEkxÖq)a@×ru’ÆWp¶\•Ù•…a,µ5!V`xò‚ÅJƒ÷Ÿa¥eH(\—Í'`o©`T1E–rˆžó(%ìÖD[Ñ$FÑ'Tþä˜8eË9U7Ø´Cv°(`ôŠþ²(–Ô§ “³)ôà Ò0ƒPj'Ø“Gœÿ…8ucU‡“gŠç‹Å©k7Uƒ–z•¦¤×It’pÚitö%h7%£“ÆV†ó±™Œ¢™(|»ÄW{ƒ¯H„7Ê ¶¸VQ×£›ö•$WVÇ—•Ë™_‰¤s3'~“Kmh`XX–x“Xc²…%aMÛ·OáY—ö[Ù%P¦éÇuaûs ?úsJ‚ÑYšÔ=úº>Œ`A"Ø `-õ*\ÑÐ £É¨Gq(õ±J*°4Ùš?7±Y8‚+¸îZ¸|0_šH_ˆó”yKdAPèóo›°C‚•2'%þT¡4д>‘'kƒºu“œTù¸3fJ‘2_-W¢%¸1¸ºËÑxeŽHlø“2Ñ„>'&úƒˆˆû()Q¡»ËxC±?îé4àd$òIC£„$ ˜Ùú6 (&C#qÄbù3CfttÀ!k§1¢$¢ žp ¢ sÐ9ƒ sHúª¯#3ùz §@ ño[š·ð (p#fÐ|M†b(îªFAô üÀ{àfATS\ÁÜóÐ#Ãçc>0 ¯  ¾jë0ZÐ0ëë0qp sP .¬1‚­°1B ­Ãr„>ÜÃ=ì=­Àþ=›àÁéc>Z1)9ÌÁæÃLÜÄLÌ=>ÌÙ£¼IE"ƒà3B`IŒD1B0s#:"Æǃ*¥`030s ÙâP XÀ¥°¾=r£1¦@ U€F“—é˾r|ì{Ç/Ìc¹s<6b3" 0ÒÀrÌ#gü:;r X€¿ÒÐ", °Êò+ý! ä2à|q’‚!€þë¿ r*¿y½€÷à¶~Pp“CÁPR†ÄHÂ,Hq'3“ ¯“Á“ ¡™ƒÁÖÓÄLÌó[Ì/ì0Ø$¤B7c0à 0°þ*å@.Ñ2ÎëàÚàÖþPp £PÇp   LÀC<Ã#/,ÌŒ4*6Â0s l<\À¾o| §1‹ÄÏ;b#‰L1ÍƧ`r ç¼ÓàÓ°þ»®ÐÊà# Là(M¡îP 〠~àé¬ Eð 2 ` -.Íãß   à æ0 E€ ·àÊp EðÔ5P 5P»-Ñ2-Ór¡Ï,Ó’EÕ€ 5p ØÓ~à·  ÊP ðÔg Õ·ðÖ  ¨à0Ëݱ/L`%€êàF`%š¨²f"(Ó¦\1]\~€öÑ þ7’n+Ñ ô@@ðÙû*xá"¯ÜÊþû*PÀ;¨R*Úì: ÃÈØÛ±­Õ¦íê²}±+á| þ°õð.m ȽÝÐ N Ä@# .€F@ F0ô` 00¦<-Ár¡Z=Þ¶} þaÑçÓ`Ñý1 æRg- «\-g]ßgÓ>ß> k6ÃQÚ0>à¿ ð àÁàP. œ›â!@@¾  »p?@S .@ Éâââ@ à :@GÐâ,î /®GàQ$@%@ $ þ9NÐ)Ÿíã0Áþ Eþ .Pçà !Ð pBØP#Ù)áA¿``N `!Йp±)Î@l~€àa~*}Ù—-kÁ¿—miaË·ŒÙ™ÍÙðÙÝðPŠ>-Õ`ÞŠ´ -ÁbÛ¡b ÓR‹Î1¾}Îö]ßå0Œ­ € ß õ  Ú€êÚ`p°@ŸíS`ëœ F D^Ä@ ç Ú ÉpÔ­Ý!©ö` ª Ô^íÔ® õíõ`öÐà0­ ßn.P/ãþpêãÒêN¡§1Øpôp@¡ßðîbî' #’=~pN° »»ð! \¶ÀpBµìæ´ì8Ž€nNp”=nÁå]nòX~Á ò)m` ,_ÄÞ F`˃mË$pªàæ$0á›Î 4G`ËqkË@ÙpîæŸðDFàôðD¿ð 4õn»ñN4’!™Ø ¼QÔŸPå=ï%ëéÐìÐö‡^ÔÝ@ áNNÀà .À.ôЂ?EU>Î@ G@ ªÐâQgþùÒ Ñ íK Ñß`L` L  à ÚààÑp L€ 4]ØÀrû±‚´™—y\^p÷` 5EòùùEržç²i–òù@êð%ð½Ðã  °€Ò$íðnLNÒîà%€pNpo>E¿$à$àFðàÿÀ^@Ð Wû_~ÎõáÁƒ‹oõ*Øs¡ÍÅ64bÜ8&$H`"L‚‰ˆ9z¸—A¤H÷¼d0ñ랇0ÜðÂÄŠ 2ôºgä—w&2ürAàœ‹¡p碄‘þ‹FŒˆì5R$6ªõ,¨@À %2Ü;’„@—eUð@B1÷ø˜‚Á”üD@z&üü·ì` &@zøCMÃLLT¨€"Z4ªÚ¢ùÐVá—0?±ùˆáÇU9±B—ƒòy#GÃ=.ûz¥À73`õ«K²°_Ž¼xÅE‘Â9f Y³—U÷LÄ<™¡UÈÚÆEƒÌ…¶_¿¢•èƒ O9bèX±ÊQå F{?;{é–šÁ#Šá&°YŽÆÌ~@ë~AAÎPˆe(D¢?Jã/¢‘øC¡7Dé—o¾ÙÉzJp§sxrE–§ŒøÆ­–"? <Êoœ€;fv5.5/tcltk/pow/notebook.tcl0000644000220700000360000002074313224715130014773 0ustar birbylhea# A Notebook widget for Tcl/Tk # $Revision$ # # Copyright (C) 1996,1997,1998 D. Richard Hipp # # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library 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 # Library General Public License for more details. # # You should have received a copy of the GNU Library General Public # License along with this library; if not, write to the # Free Software Foundation, Inc., 59 Temple Place - Suite 330, # Boston, MA 02111-1307, USA. # # Author contact information: # drh@acm.org # http://www.hwaci.com/drh/ # # Create a new notebook widget # proc Notebook:create {w args} { global Notebook powbg global g_notebookTitleFont set fontName [font names] if { [string first "g_notebookTitleFont" $fontName] >= 0 } { set Notebook($w,fontName) g_notebookTitleFont } else { set Notebook($w,fontName) [list System 16] } set Notebook($w,width) 300 set Notebook($w,height) 300 set Notebook($w,pages) {} set Notebook($w,top) 0 set Notebook($w,pad) 5 set Notebook($w,fg,on) black set Notebook($w,textFg,on) black set Notebook($w,textFg,off) grey50 set Notebook($w,fg,off) grey50 canvas $w -bd 0 -highlightthickness 0 -takefocus 0 set Notebook($w,bg) [$w cget -bg] bind $w <1> "Notebook:click $w %x %y" bind $w "Notebook:scheduleExpand $w" eval Notebook:config $w $args } # # Change configuration options for the notebook widget # proc Notebook:config {w args} { global Notebook foreach {tag value} $args { switch -- $tag { -width { set Notebook($w,width) $value } -height { set Notebook($w,height) $value } -pages { set Notebook($w,pages) $value } -pad { set Notebook($w,pad) $value } -bg { set Notebook($w,bg) $value } -fg { set Notebook($w,fg,on) $value } -disabledforeground { set Notebook($w,fg,off) $value } -font { set Notebook($w,fontName) $value } -textFg { set Notebook($w,textFg,on) $value } } } # # After getting new configuration values, reconstruct the widget # $w delete all set Notebook($w,x1) $Notebook($w,pad) set Notebook($w,x2) [expr $Notebook($w,x1)+2] set Notebook($w,x3) [expr $Notebook($w,x2)+$Notebook($w,width)] set Notebook($w,x4) [expr $Notebook($w,x3)+2] set Notebook($w,y1) [expr $Notebook($w,pad)+2] set Notebook($w,y2) [expr $Notebook($w,y1)+2] set Notebook($w,y5) [expr $Notebook($w,y1)+30] set Notebook($w,y6) [expr $Notebook($w,y5)+2] set Notebook($w,y3) [expr $Notebook($w,y6)+$Notebook($w,height)] set Notebook($w,y4) [expr $Notebook($w,y3)+2] set x $Notebook($w,x1) set cnt 0 set y7 [expr $Notebook($w,y1)+10] foreach p $Notebook($w,pages) { set Notebook($w,p$cnt,x5) $x set id [$w create text 0 0 -text $p -anchor nw -tags "p$cnt t$cnt" \ -font $Notebook($w,fontName) \ -fill $Notebook($w,textFg,on)] set bbox [$w bbox $id] set width [lindex $bbox 2] $w move $id [expr $x+10] $y7 $w create line \ $x $Notebook($w,y5)\ $x $Notebook($w,y2) \ [expr $x+2] $Notebook($w,y1) \ [expr $x+$width+16] $Notebook($w,y1) \ -width 2 -fill white -tags p$cnt $w create line \ [expr $x+$width+16] $Notebook($w,y1) \ [expr $x+$width+18] $Notebook($w,y2) \ [expr $x+$width+18] $Notebook($w,y5) \ -width 2 -fill black -tags p$cnt set x [expr $x+$width+20] set Notebook($w,p$cnt,x6) [expr $x-2] if {![winfo exists $w.f$cnt]} { frame $w.f$cnt -bd 0 } place $w.f$cnt -x $Notebook($w,x2) -y $Notebook($w,y6) \ -width $Notebook($w,width) -height $Notebook($w,height) $w.f$cnt config -bg $Notebook($w,bg) incr cnt } $w create line \ $Notebook($w,x1) [expr $Notebook($w,y5)-2] \ $Notebook($w,x1) $Notebook($w,y3) \ -width 2 -fill white $w create line \ $Notebook($w,x1) $Notebook($w,y3) \ $Notebook($w,x2) $Notebook($w,y4) \ $Notebook($w,x3) $Notebook($w,y4) \ $Notebook($w,x4) $Notebook($w,y3) \ $Notebook($w,x4) $Notebook($w,y6) \ $Notebook($w,x3) $Notebook($w,y5) \ -width 2 -fill black if {![info exists Notebook($w,expand)]} { $w config -width [expr $Notebook($w,x4)+$Notebook($w,pad)] \ -height [expr $Notebook($w,y4)+$Notebook($w,pad)] \ -bg $Notebook($w,bg) } set top $Notebook($w,top) set Notebook($w,top) -1 Notebook:raise.page $w $top } # # This routine is called whenever the mouse-button is pressed over # the notebook. It determines if any page should be raised and raises # that page. # proc Notebook:click {w x y} { global Notebook if {$y<$Notebook($w,y1) || $y>$Notebook($w,y6)} return set N [llength $Notebook($w,pages)] for {set i 0} {$i<$N} {incr i} { if {$x>=$Notebook($w,p$i,x5) && $x<=$Notebook($w,p$i,x6)} { Notebook:raise.page $w $i break } } } # # For internal use only. This procedure raised the n-th page of # the notebook # proc Notebook:raise.page {w n} { global Notebook if {$n<0 || $n>=[llength $Notebook($w,pages)]} return set top $Notebook($w,top) if {$top>=0 && $top<[llength $Notebook($w,pages)]} { $w move p$top 0 2 } $w move p$n 0 -2 $w delete topline if {$n>0} { $w create line \ $Notebook($w,x1) $Notebook($w,y6) \ $Notebook($w,x2) $Notebook($w,y5) \ $Notebook($w,p$n,x5) $Notebook($w,y5) \ $Notebook($w,p$n,x5) [expr $Notebook($w,y5)-2] \ -width 2 -fill white -tags topline } $w create line \ $Notebook($w,p$n,x6) [expr $Notebook($w,y5)-2] \ $Notebook($w,p$n,x6) $Notebook($w,y5) \ -width 2 -fill white -tags topline $w create line \ $Notebook($w,p$n,x6) $Notebook($w,y5) \ $Notebook($w,x3) $Notebook($w,y5) \ -width 2 -fill white -tags topline set Notebook($w,top) $n raise $w.f$n } # # Change the page-specific configuration options for the notebook # proc Notebook:pageconfig {w name args} { global Notebook set i [lsearch $Notebook($w,pages) $name] if {$i<0} return foreach {tag value} $args { switch -- $tag { -state { if {"$value"=="disabled"} { $w itemconfig t$i -fg $Notebook($w,fg,off) } else { $w itemconfig t$i -fg $Notebook($w,fg,on) } } -onexit { set Notebook($w,p$i,onexit) $value } } } } # # This procedure raises a notebook page given its name. But first # we check the "onexit" procedure for the current page (if any) and # if it returns false, we don't allow the raise to proceed. # proc Notebook:raise {w name} { global Notebook set i [lsearch $Notebook($w,pages) $name] if {$i<0} return if {[info exists Notebook($w,p$i,onexit)]} { set onexit $Notebook($w,p$i,onexit) if {"$onexit"!="" && [eval uplevel #0 $onexit]!=0} { Notebook:raise.page $w $i } } else { Notebook:raise.page $w $i } } # # Return the frame associated with a given page of the notebook. # proc Notebook:frame {w name} { global Notebook set i [lsearch $Notebook($w,pages) $name] if {$i>=0} { return $w.f$i } else { return {} } } # # Try to resize the notebook to the next time we become idle. # proc Notebook:scheduleExpand w { global Notebook if {[info exists Notebook($w,expand)]} return set Notebook($w,expand) 1 after idle "Notebook:expand $w" } # # Resize the notebook to fit inside its containing widget. # proc Notebook:expand w { global Notebook set wi [expr [winfo width $w]-($Notebook($w,pad)*2+4)] set hi [expr [winfo height $w]-($Notebook($w,pad)*2+36)] Notebook:config $w -width $wi -height $hi catch {unset Notebook($w,expand)} } # # Locate minimum dimensions of frame and expand to it # proc Notebook:resize w { global Notebook update set minWid [expr [winfo width $w]-($Notebook($w,pad)*2+4)] set minHgt [expr [winfo height $w]-($Notebook($w,pad)*2+36)] foreach pg $Notebook($w,pages) { set frm [Notebook:frame $w $pg] set hgt [winfo reqheight $frm] set wid [winfo reqwidth $frm] if { $hgt>$minHgt } { set minHgt $hgt } if { $wid>$minWid } { set minWid $wid } } Notebook:config $w -width $minWid -height $minHgt } fv5.5/tcltk/pow/orbit.c0000644000220700000360000003633113224715130013732 0ustar birbylhea/* gcc -Wall orbit.c -I$BIN/tcl/include/ -c -O -o orbit.o ld -G -o liborbit.so orbit.o */ #include #include #include #include /* Declare prototypes... */ int singleBarFastGen(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]); void sunPos(double MJD, double SunVect[]); void polToVect(double PVect[], double Vect[]); void rotVect(double RM[3][3], double Vect[], double RVect[]); void eulerToRM(double EA[],double RM[3][3]); void eulerToRM_righthand(double EA[],double RM[3][3]); void precessEuler(double Epoch, double MJD, double EA[3]); void precess(double Epoch, double MJD, double Vect[], double RVect[]); void invRotMat(double RM[3][3], double InvRM[3][3]); int vectToPol(double Vect[],double VRet[]); int rotPVect(double Ang[3], double Vect[3], double VRet[3]); void setEuler(double V1[3], double V2[3], double Euler[3]); double norm(double Vect[]); double angDistance(double Vect1[], double Vect2[]); double c_given_RADecMJD_return_SunAngle(double RA, double Dec, double MJD); void fastRADecMJD2Roll(double RA, double Dec, double MJD, double SunMin, double SunMax, double SunLimit, double ReturnVals[4]); void vectProd(double One[], double Two[], double Result[]); void normVect(double Vect[]); int c_given_RADecMJD_return_Roll(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]); int singleRollMe(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]); int Orbit_Init(Tcl_Interp* interp_instance); /* replaces internal workings of "fastgen" (and therefore also "given_RADecMJD_return_SunAngle")from Tcl version with a faster one (in C) */ #define DEG2RAD 0.017453292519943295769 #define RAD2DEG 57.295779513082320877 #define EPS 1.e-12 #define PI 3.1415926535897932385 int singleBarFastGen(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]) { double RA, Dec, MJD, MaxSun, MinSun, Span, SunAngle; double T1, End, Leap, T2; double c_given_RADecMJD_return_SunAngle(double,double,double); char buffer[40]; int istatus, itstat, itstat2; /* 0 = out, 1 = in */ Leap = 9; /* good figure for hopping around step size */ /* get our Tcl args */ sscanf(argv[1],"%lf",&RA); sscanf(argv[2],"%lf",&Dec); sscanf(argv[3],"%lf",&MJD); sscanf(argv[4],"%lf",&MaxSun); sscanf(argv[5],"%lf",&MinSun); sscanf(argv[6],"%lf",&Span); SunAngle = c_given_RADecMJD_return_SunAngle(RA,Dec,MJD); /* append MJD and istatus to answer array */ if (SunAngle < MaxSun && SunAngle > MinSun) { istatus = 1; /* in */ sprintf(buffer,"%f %s",MJD,"in"); } else { istatus = 0; /* out */ sprintf(buffer,"%f %s",MJD,"out"); } /* ultimately need list of data pairs (Start/End times) */ Tcl_AppendElement(interp,buffer); T1 = MJD; End = MJD + Span + Leap; while (T1 <= End) { T1 = T1 + Leap; SunAngle = c_given_RADecMJD_return_SunAngle(RA, Dec, T1); if (SunAngle < MaxSun && SunAngle > MinSun) itstat = 1; /* in */ else itstat = 0; /* out */ /* look for a transition */ if (itstat != istatus) { /* we had a change at or during this interval, so focus in */ for (T2=T1-Leap+1; T2 <= T1; T2 = T2 + 1.0) { SunAngle = c_given_RADecMJD_return_SunAngle(RA, Dec, T2); if (SunAngle < MaxSun && SunAngle > MinSun) itstat2 = 1; /* in */ else itstat2 = 0; /* out */ if (itstat2 == itstat) { if (itstat == 1) sprintf(buffer,"%f %s",T2,"in"); else sprintf(buffer,"%f %s",T2,"out"); Tcl_AppendElement(interp,buffer); istatus = itstat; T2 = T1+1; /* force an exit */ } } } } /* okay, we're done looping through all times, now clean up results */ return TCL_OK; } void sunPos(double MJD, double SunVect[]) { double t, m, r, l; t = MJD - 4.5e4; m = t * .985600267 + 27.26464; m = fmod(m,360.0); m = m * DEG2RAD; r = 1.00014 - cos(m) * .01672 - sin(m * 2) * 1.4e-4; l = t * .985609104 + 309.44862 + sin(m) * 1.91553 + sin(m * 2) * .0201; l = fmod(l,360.0); l = l * DEG2RAD; SunVect[0] = r * cos(l); SunVect[1] = r * .91744 * sin(l); SunVect[2] = r * .39788 * sin(l); } void polToVect(double PVect[], double Vect[]) { double R, Lat, Lon; R = PVect[0]; Lon = PVect[1]; Lat = PVect[2]; Vect[0] = R * cos(Lat) * cos(Lon); Vect[1] = R * cos(Lat) * sin(Lon); Vect[2] = R * sin(Lat); } void rotVect(double RM[3][3], double Vect[], double RVect[]) { double y0, y1, y2; y0 = RM[0][0] * Vect[0] + RM[0][1] * Vect[1] + RM[0][2] * Vect[2]; y1 = RM[1][0] * Vect[0] + RM[1][1] * Vect[1] + RM[1][2] * Vect[2]; y2 = RM[2][0] * Vect[0] + RM[2][1] * Vect[1] + RM[2][2] * Vect[2]; RVect[0] = y0; RVect[1] = y1; RVect[2] = y2; } void eulerToRM(double EA[],double RM[3][3]) { /* useful for viewing */ double phi, psi, theta; double cos_phi, cos_theta, cos_psi, sin_phi, sin_theta, sin_psi; phi = EA[0]; psi = EA[1]; theta = EA[2]; cos_phi = cos(phi); cos_theta = cos(theta); cos_psi = cos(psi); sin_phi = sin(phi); sin_theta = sin(theta); sin_psi = sin(psi); RM[0][0] = cos_psi * cos_theta * cos_phi - sin_psi * sin_phi; RM[0][1] = cos_psi * cos_theta * sin_phi + sin_psi * cos_phi; RM[0][2] = 0.0 - cos_psi * sin_theta; RM[1][0] = 0.0- sin_psi * cos_theta * cos_phi - cos_psi * sin_phi; RM[1][1] = 0.0- sin_psi * cos_theta * sin_phi + cos_psi * cos_phi; RM[1][2] = sin_psi * sin_theta; RM[2][0] = sin_theta * cos_phi; RM[2][1] = sin_theta * sin_phi; RM[2][2] = cos_theta; } void eulerToRM_righthand(double EA[],double RM[3][3]) { /* useful for rolls */ double phi, psi, theta; double cos_phi, cos_theta, cos_psi, sin_phi, sin_theta, sin_psi; phi = EA[0]; psi = EA[1]; theta = EA[2]; cos_phi = cos(phi); cos_theta = cos(theta); cos_psi = cos(psi); sin_phi = sin(phi); sin_theta = sin(theta); sin_psi = sin(psi); RM[0][0] = cos_psi*sin_phi - cos_phi*cos_theta*sin_psi; RM[1][0] = -cos_psi*cos_phi - sin_phi*cos_theta*sin_psi; RM[2][0] = sin_psi*sin_theta; RM[0][1] = -sin_psi*sin_phi - cos_phi*cos_theta*cos_psi; RM[1][1] = sin_psi*cos_phi - sin_phi*cos_theta*cos_psi; RM[2][1] = cos_psi*sin_theta; RM[0][2] = -cos_phi*sin_theta; RM[1][2] = -sin_phi*sin_theta; RM[2][2] = -cos_theta; } void precessEuler(double Epoch, double MJD, double EA[3]) { double u0, u, phi, psi, theta; u0 = (Epoch - 15020.) / 36524.22; u = (MJD - Epoch) / 36524.22; phi = -(u0*1.396 + 2304.25 + (u*.018 + .302) *u) * u * DEG2RAD /3600.; psi = phi - u * .791 * u * DEG2RAD / 3600.; theta = (2004.682 - u0*.853 + (-.426 - u*.042)* u)* u* DEG2RAD /3600.; EA[0] = phi; EA[1] = psi; EA[2] = theta; } void precess(double Epoch, double MJD, double Vect[], double RVect[]) { double EA[3],RM[3][3]; precessEuler(Epoch, MJD, EA); eulerToRM(EA,RM); rotVect(RM,Vect,RVect); } void invRotMat(double RM[3][3], double InvRM[3][3]) { InvRM[0][0] = RM[0][0]; InvRM[0][1] = RM[1][0]; InvRM[0][2] = RM[2][0]; InvRM[1][0] = RM[0][1]; InvRM[1][1] = RM[1][1]; InvRM[1][2] = RM[2][1]; InvRM[2][0] = RM[0][2]; InvRM[2][1] = RM[1][2]; InvRM[2][2] = RM[2][2]; } int vectToPol(double Vect[],double VRet[]) { double norm01, R, lon, lat, c, s; double norm(double[]); norm01 = Vect[0]*Vect[0]+Vect[1]*Vect[1]; R= norm(Vect); lon = 0.0; lat = 0.0; if (R == 0.0) { /* eek, failure */ VRet[0] = 0.0; VRet[1] = 0.0; VRet[2] = 0.0; return -1; } if (norm01 == 0.0) { /* we're pointing straight up */ VRet[0] = R; VRet[1] = 0.0; VRet[2] = 90 * DEG2RAD; return -1; } norm01 = sqrt(norm01); lat = asin(Vect[2]/R); c = Vect[0]/norm01; s = Vect[1]/norm01; if (norm01 < EPS) { lon = 0.0; } else if ( fabs(s) < EPS) { lon = (1.0 - c/fabs(c)) * PI/2.0; } else { lon = atan((1.0-c)/s) * 2.0; } while (lon >= 2.0*PI) { lon = lon - 2*PI; } while (lon < 0) { lon = lon + 2*PI; } VRet[0] = R; VRet[1] = lon; VRet[2] = lat; return 0; } int rotPVect(double Ang[3], double Vect[3], double VRet[3]) { double RM[3][3], U[3], V[3]; int ireturn; eulerToRM(Ang,RM); polToVect(Vect,U); rotVect(RM,U,V); /* note dual behavior-- we're setting VRet implicitly to return back to the calling program, while also setting a return flag (ireturn) explicitly to also return to the calling program. */ ireturn = vectToPol(V,VRet); return ireturn; } void setEuler(double V1[3], double V2[3], double Euler[3]) { double phi,psi, theta; double TempV[3]; int ireturn; phi = V1[1]; psi = 0.0; theta = PI/2.0 - V1[2]; Euler[0] = phi; Euler[1] = psi; Euler[2] = theta; /* note we only seem to do this to check the return value, as we've already set our return vector (save for a final tweaking of its psi value) */ ireturn = rotPVect(Euler, V2, TempV); if (ireturn != 0) { printf("Warning, problem with euler angle rotation, continuing\n"); } else { /* replace our psi angle with rotated longitude */ Euler[1] = TempV[1] - PI/2.0; } } double norm(double Vect[]) { double sum; sum = sqrt(Vect[0]*Vect[0]+Vect[1]*Vect[1]+Vect[2]*Vect[2]); return sum; } double angDistance(double Vect1[], double Vect2[]) { double d1, r; d1 = Vect1[0]*Vect2[0] + Vect1[1]*Vect2[1] + Vect1[2]*Vect2[2]; d1 = d1/(norm(Vect1)*norm(Vect2)); if (d1 > 1.0-EPS) d1 = 1.0; if (d1 < -1.0+EPS) d1 = -1.0; r = acos(d1); if (r < 0.0 || r > PI) r = -1.0; return r; } double c_given_RADecMJD_return_SunAngle(double RA, double Dec, double MJD) { double SunAngle; double SunVect[3], TargetVect[3], TargetPolarVect[3], NewTVect[3]; double Euler[3], RM[3][3], InvRM[3][3], FOV[3], RotatedTargetVect[3]; sunPos(MJD,SunVect); TargetPolarVect[0] = 1.0; TargetPolarVect[1] = RA * DEG2RAD; TargetPolarVect[2] = Dec * DEG2RAD; polToVect(TargetPolarVect,TargetVect); precess(51544.5000,MJD,TargetVect,NewTVect); /* precess to J2000 */ vectToPol(NewTVect,TargetPolarVect); FOV[0] = 0.0; FOV[1] = 0.0; FOV[2] = 1.0; setEuler(TargetPolarVect,SunVect,Euler); eulerToRM(Euler,RM); invRotMat(RM, InvRM); rotVect(InvRM,FOV,RotatedTargetVect); /* is this TargetVect or NewTVect? */ SunAngle = angDistance(SunVect,RotatedTargetVect); SunAngle = SunAngle*RAD2DEG; return SunAngle; } void fastRADecMJD2Roll(double RA, double Dec, double MJD, double SunMin, double SunMax, double SunLimit, double ReturnVals[4]) { double SunAngle; double SunVect[3], TargetVect[3], TargetPolarVect[3], NewTVect[3]; double N[3], W[3], X[3], Y[3]; double YNorth, YWest, Roll, Ratio, MinRoll, MaxRoll; void vectProd(double[],double[],double[]), normVect(double[]); sunPos(MJD,SunVect); TargetPolarVect[0] = 1.0; TargetPolarVect[1] = RA * DEG2RAD; TargetPolarVect[2] = Dec * DEG2RAD; polToVect(TargetPolarVect,TargetVect); /* Hey, wait, do we actually use this at all? */ precess(51544.5000,MJD,TargetVect,NewTVect); /* precess to J2000 */ TargetVect[0] = NewTVect[0]; TargetVect[1] = NewTVect[1]; TargetVect[2] = NewTVect[2]; /* vectToPol(NewTVect,TargetPolarVect); is not needed here */ SunAngle = c_given_RADecMJD_return_SunAngle(RA,Dec,MJD); if (SunAngle >= SunMin && SunAngle <= SunMax) { ; } else { /* printf("Bad sun angle: %f %f %f\n",SunAngle,SunMin,SunMax); */ ReturnVals[0] = 0; ReturnVals[1] = 0; ReturnVals[2] = 0; ReturnVals[3] = -1; return; } SunAngle = SunAngle * DEG2RAD; SunLimit = SunLimit * DEG2RAD; N[0] = 0.0; N[1] = 0.0; N[2] = 1.0; vectProd(TargetVect,N, W); normVect(W); vectProd(W,TargetVect,N); normVect(N); if (N[2] < 0.0) { /* north became south, correcting */ N[0] = 0.0-N[0]; N[1] = 0.0-N[1]; N[2] = 0.0-N[2]; } vectProd(TargetVect,SunVect,X); normVect(X); vectProd(X,TargetVect,Y); normVect(Y); YNorth = angDistance(Y,N); YWest = angDistance(Y,W); if (YNorth <= 90.0*DEG2RAD) { Roll = YWest; } else { Roll = (360.0*DEG2RAD) - YWest; } Ratio = cos(SunLimit)/sin(SunAngle); if (Ratio > 1.0) Ratio = 1.0; if (Ratio < -1.0) Ratio = -1.0; Ratio = acos(Ratio); MinRoll = (Roll-Ratio)*RAD2DEG; MaxRoll = (Roll+Ratio)*RAD2DEG; Roll = Roll*RAD2DEG; if (MinRoll < 0.0) MinRoll = 360.0 + MinRoll; if (MaxRoll > 360.0) MaxRoll = MaxRoll - 360.0; ReturnVals[0] = MinRoll; ReturnVals[1] = MaxRoll; ReturnVals[2] = Roll; ReturnVals[3] = 0; return; } void vectProd(double One[], double Two[], double Result[]) { Result[0] = One[1] * Two[2] - One[2] * Two[1]; Result[1] = One[2] * Two[0] - One[0] * Two[2]; Result[2] = One[0] * Two[1] - One[1] * Two[0]; } void normVect(double Vect[]) { double NV, norm(double[]); NV = norm(Vect); if (NV == 0) { Vect[0] = 0; Vect[1] = 0; Vect[2] = 0; } else { Vect[0] = Vect[0]/NV; Vect[1] = Vect[1]/NV; Vect[2] = Vect[2]/NV; } } /* wrapper for our c routine for return rolls and ranges */ int c_given_RADecMJD_return_Roll(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]) { double RA, Dec, MJD, SunMin, SunMax, SunLimit, ReturnVals[4]; char buffer[40]; /* get our Tcl args */ sscanf(argv[1],"%lf",&RA); sscanf(argv[2],"%lf",&Dec); sscanf(argv[3],"%lf",&MJD); sscanf(argv[4],"%lf",&SunMin); sscanf(argv[5],"%lf",&SunMax); sscanf(argv[6],"%lf",&SunLimit); fastRADecMJD2Roll(RA, Dec, MJD, SunMin, SunMax, SunLimit, ReturnVals); sprintf(buffer,"%f",ReturnVals[0]); Tcl_AppendElement(interp,buffer); sprintf(buffer,"%f",ReturnVals[1]); Tcl_AppendElement(interp,buffer); sprintf(buffer,"%f",ReturnVals[2]); Tcl_AppendElement(interp,buffer); sprintf(buffer,"%f",ReturnVals[3]); Tcl_AppendElement(interp,buffer); return TCL_OK; } int singleRollMe(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]) { double RA, Dec, Roll, NewRA, NewDec, Phi, Theta, Psi; double c_given_RADecMJD_return_SunAngle(double,double,double); double RollEuler[3], FOV[3], FOVVect[3], PosPair[3], RollRM[3][3]; double XOffset, YOffset, ZOffset; char buffer[80]; /* get our Tcl args */ sscanf(argv[1],"%lf",&RA); sscanf(argv[2],"%lf",&Dec); sscanf(argv[3],"%lf",&Roll); sscanf(argv[4],"%lf",&XOffset); sscanf(argv[5],"%lf",&YOffset); Phi = RA*DEG2RAD; Theta = (90.0-Dec) *DEG2RAD; Psi = 0.0-Roll*DEG2RAD; /* changes geometric to astronomic reference frame */ RollEuler[0] = Phi; RollEuler[1] = Psi; RollEuler[2] = Theta; XOffset = XOffset*DEG2RAD; YOffset = YOffset*DEG2RAD; ZOffset = 0.0 - cos(sqrt(YOffset*YOffset+XOffset*XOffset)); FOV[0] = XOffset; FOV[1] = YOffset; FOV[2] = ZOffset; eulerToRM_righthand(RollEuler,RollRM); rotVect(RollRM,FOV,FOVVect); vectToPol(FOVVect,PosPair); NewRA = PosPair[1]*RAD2DEG; NewDec = PosPair[2]*RAD2DEG; sprintf(buffer,"%f %f",NewRA, NewDec); Tcl_SetResult(interp,buffer,TCL_VOLATILE); return TCL_OK; } int Orbit_Init(Tcl_Interp* interp_instance) { Tcl_CreateCommand(interp_instance,"singleBarFastGen", (Tcl_CmdProc*)singleBarFastGen, (ClientData) NULL, (Tcl_CmdDeleteProc*) NULL); Tcl_CreateCommand(interp_instance,"singleRollMe", (Tcl_CmdProc*)singleRollMe, (ClientData) NULL, (Tcl_CmdDeleteProc*) NULL); Tcl_CreateCommand(interp_instance,"c_given_RADecMJD_return_Roll", (Tcl_CmdProc*)c_given_RADecMJD_return_Roll, (ClientData) NULL, (Tcl_CmdDeleteProc*) NULL); return TCL_OK; } fv5.5/tcltk/pow/pow.def0000644000220700000360000000515013224715130013727 0ustar birbylheaLIBRARY powtcl.dll EXETYPE WINDOWS CODE PRELOAD MOVEABLE DISCARDABLE DATA PRELOAD MOVEABLE MULTIPLE EXPORTS CreatePowCurve PowCurveCoords ConfigurePowCurve DeletePowCurve ComputePowCurveBbox DisplayPowCurve PowCurveInsert PowCurveDeleteCoords PowCurveToPoint PowCurveToArea ScalePowCurve GetPowCurveIndex TranslatePowCurve PowCurveToPostscript PowSetupColormap PowTestColormap PowSetupPhotoImages PowDitherToPhoto PowGetHisto PowPhotoColorTable PowPhotoCmapStretch PowImageScale PowReditherPhotoBlock PowCleanUp PowListGraphs PowListCurves PowListImages PowListVectors PowListData PowProcessCurve PowSetGraphMagstep PowGetImageOrigin PowGetImageOtherend PowGetImageUnits PowGetImageZ PowTestMacMemory PowPutZoomedBlock PowDestroyData_Tcl PowCloneData PowCreateData_Tcl PowRegisterData_Tcl PowDestroyImage_Tcl PowCreateImage_Tcl PowDestroyVector_Tcl PowCreateVector_Tcl PowDestroyCurve_Tcl PowCreateCurve_Tcl PowCreateVectorEN_Tcl PowDataPtr_Tcl PowCreateHisto_Tcl PowDestroyGraph_Tcl PowCreateGraph_Tcl PowTestImage PowFetchCurveInfoHash PowFetchDataLength PowExprDataInfo PowFetchVectorInfoHash PowFetchImageInfoHash PowFindCurvesMinMax_Tcl PowCreateDataFromChannel PowCreateDataFromList PowGraphToCanvas PowCanvasToGraph PowPixelToGraph PowGraphToPixel PowGetImageClipbox PowWCSexists PowWCSisSwapped PowCreateCurve PowCreateHisto PowDestroyCurve PowCreateData PowDestroyData PowRegisterData PowCreateGraph PowCreateGraph_internal PowDestroyGraph PowCreateImage PowDestroyImage PowCreateVector PowCreateVectorEN PowDestroyVector PowDrawGridLines CreateGridPts GetTicks PowGetTics GetTics CanvToGraph GraphToCanv PtBtwnPts CalcXY SolveXY CalcCoeff PowCreateContour BuildContours TraceContour dllEntry Pow_Init PowInit PowFindCurvesMinMax PowFindCurvesBBox PowFindImagesBBox PowFindGraphBBox PowSortGraphMinMax PowFindCurve PowFindImage PowExtractDatum PowPutDatum PowFindVector PowFindData PowFindGraph PowGetObjectOption PowPosToPix PowPixToPos PowInitWCS PowParseWCS PowWCSInitImage PowWCSInitCurve PowWCSInitGraph PowXYPx PowWorldPos pow_worldpos pow_xypx Visu_Init convert_block_to_byte convert_block_to_histo equalize_histo build_lookup put_lut AllocateColorTable linear_lut non_linear_lut spectrum rgb gray hot cold hls blkbdy invert_cmap bowlerhat tophat randwalk_spectrum lut_ramp set_hls convert_HLS_rgb hatgray hatct lut_thres bgr_ramp bgr_ramp2 bgr_step bgr_step2 rygcbm_ramp rygcbm_step gray_ramp2 gray_ramp4 gray_step4 gray_step8 spectrum2 inv_spec color1_lut color2_lut color3_lut fv5.5/tcltk/pow/pow.dsp0000644000220700000360000001337213224715130013764 0ustar birbylhea# Microsoft Developer Studio Project File - Name="pow" - Package Owner=<4> # Microsoft Developer Studio Generated Build File, Format Version 6.00 # ** DO NOT EDIT ** # TARGTYPE "Win32 (x86) Dynamic-Link Library" 0x0102 CFG=pow - Win32 Debug !MESSAGE This is not a valid makefile. To build this project using NMAKE, !MESSAGE use the Export Makefile command and run !MESSAGE !MESSAGE NMAKE /f "pow.mak". !MESSAGE !MESSAGE You can specify a configuration when running NMAKE !MESSAGE by defining the macro CFG on the command line. For example: !MESSAGE !MESSAGE NMAKE /f "pow.mak" CFG="pow - Win32 Debug" !MESSAGE !MESSAGE Possible choices for configuration are: !MESSAGE !MESSAGE "pow - Win32 Release" (based on "Win32 (x86) Dynamic-Link Library") !MESSAGE "pow - Win32 Debug" (based on "Win32 (x86) Dynamic-Link Library") !MESSAGE # Begin Project # PROP AllowPerConfigDependencies 0 # PROP Scc_ProjName "" # PROP Scc_LocalPath "" CPP=cl.exe MTL=midl.exe RSC=rc.exe !IF "$(CFG)" == "pow - Win32 Release" # PROP BASE Use_MFC 0 # PROP BASE Use_Debug_Libraries 0 # PROP BASE Output_Dir "Release" # PROP BASE Intermediate_Dir "Release" # PROP BASE Target_Dir "" # PROP Use_MFC 0 # PROP Use_Debug_Libraries 0 # PROP Output_Dir "C:\BATGSETOP\Release\lib" # PROP Intermediate_Dir "Release" # PROP Ignore_Export_Lib 0 # PROP Target_Dir "" # ADD BASE CPP /nologo /MT /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /D "POW_EXPORTS" /YX /FD /c # ADD CPP /nologo /MT /W3 /GX /O2 /I "C:\BATGSETOP\EXTERN\tcl8.3.4\generic" /I "C:\BATGSETOP\EXTERN\tk8.3.4\generic" /I "C:\BATGSETOP\EXTERN\tk8.3.4\win" /I "C:\BATGSETOP\EXTERN\tk8.3.4\xlib" /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /D "POW_EXPORTS" /D "__WIN32__" /D "NOBOARDS" /YX /FD /c # ADD BASE MTL /nologo /D "NDEBUG" /mktyplib203 /win32 # ADD MTL /nologo /D "NDEBUG" /mktyplib203 /win32 # ADD BASE RSC /l 0x409 /d "NDEBUG" # ADD RSC /l 0x409 /d "NDEBUG" BSC32=bscmake.exe # ADD BASE BSC32 /nologo # ADD BSC32 /nologo LINK32=link.exe # ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /dll /machine:I386 # ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib tcl84.lib tk84.lib /nologo /dll /machine:I386 /out:"c:\BATGSETOP\Release\bin\powtcl.dll" /libpath:"C:\BATGSETOP\Release\lib" !ELSEIF "$(CFG)" == "pow - Win32 Debug" # PROP BASE Use_MFC 0 # PROP BASE Use_Debug_Libraries 1 # PROP BASE Output_Dir "Debug" # PROP BASE Intermediate_Dir "Debug" # PROP BASE Target_Dir "" # PROP Use_MFC 0 # PROP Use_Debug_Libraries 1 # PROP Output_Dir "C:\BATGSETOP\Debug\lib" # PROP Intermediate_Dir "Debug" # PROP Ignore_Export_Lib 0 # PROP Target_Dir "" # ADD BASE CPP /nologo /MTd /W3 /Gm /GX /ZI /Od /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /D "POW_EXPORTS" /YX /FD /GZ /c # ADD CPP /nologo /MTd /W3 /Gm /GX /ZI /Od /I "C:\BATGSETOP\EXTERN\tcl8.3.4\generic" /I "C:\BATGSETOP\EXTERN\tk8.3.4\generic" /I "C:\BATGSETOP\EXTERN\tk8.3.4\xlib" /I "C:\BATGSETOP\EXTERN\tk8.3.4\win" /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /D "POW_EXPORTS" /D "__WIN32__" /D "_MT" /YX /FD /GZ /c # ADD BASE MTL /nologo /D "_DEBUG" /mktyplib203 /win32 # ADD MTL /nologo /D "_DEBUG" /mktyplib203 /win32 # ADD BASE RSC /l 0x409 /d "_DEBUG" # ADD RSC /l 0x409 /d "_DEBUG" BSC32=bscmake.exe # ADD BASE BSC32 /nologo # ADD BSC32 /nologo LINK32=link.exe # ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /dll /debug /machine:I386 /pdbtype:sept # ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib tcl84.lib tk84.lib libcmtd.lib "f:\Tcl source\fv\lheasoft\src\tcltk2\fitsTcl\fitstcl.lib" /nologo /dll /debug /machine:I386 /out:"C:\BATGSETOP\Debug\bin\powtcl.dll" /pdbtype:sept /libpath:"C:\BATGSETOP\Debug\lib" !ENDIF # Begin Target # Name "pow - Win32 Release" # Name "pow - Win32 Debug" # Begin Group "Source Files" # PROP Default_Filter "cpp;c;cxx;rc;def;r;odl;idl;hpj;bat" # Begin Source File SOURCE=.\pow.def # End Source File # Begin Source File SOURCE=.\PowCanvCurve.c # End Source File # Begin Source File SOURCE=.\PowColormap.c # End Source File # Begin Source File SOURCE=.\PowCommands.c # End Source File # Begin Source File SOURCE=.\PowCreateCurve.c # End Source File # Begin Source File SOURCE=.\PowCreateData.c # End Source File # Begin Source File SOURCE=.\PowCreateGraph.c # End Source File # Begin Source File SOURCE=.\PowCreateImage.c # End Source File # Begin Source File SOURCE=.\PowCreateVector.c # End Source File # Begin Source File SOURCE=.\PowGrid.c # End Source File # Begin Source File SOURCE=.\PowInit.c # End Source File # Begin Source File SOURCE=.\PowUtils.c # End Source File # Begin Source File SOURCE=.\PowWCS.c # End Source File # Begin Source File SOURCE=.\Visu_generic.c # End Source File # Begin Source File SOURCE=.\Visu_Init.c # End Source File # Begin Source File SOURCE=.\Visu_lut.c # End Source File # End Group # Begin Group "Header Files" # PROP Default_Filter "h;hpp;hxx;hm;inl" # Begin Source File SOURCE=.\pow.h # End Source File # Begin Source File SOURCE=.\powRegion.h # End Source File # Begin Source File SOURCE=.\tkpict.h # End Source File # End Group # Begin Group "Resource Files" # PROP Default_Filter "ico;cur;bmp;dlg;rc2;rct;bin;rgs;gif;jpg;jpeg;jpe" # End Group # End Target # End Project fv5.5/tcltk/pow/pow.dsw0000644000220700000360000000102113224715130013757 0ustar birbylheaMicrosoft Developer Studio Workspace File, Format Version 6.00 # WARNING: DO NOT EDIT OR DELETE THIS WORKSPACE FILE! ############################################################################### Project: "pow"=.\pow.dsp - Package Owner=<4> Package=<5> {{{ }}} Package=<4> {{{ }}} ############################################################################### Global: Package=<5> {{{ }}} Package=<3> {{{ }}} ############################################################################### fv5.5/tcltk/pow/pow.h0000644000220700000360000004446713224715130013436 0ustar birbylhea#define POW #ifndef _POW_H #define _POW_H #include "tkpict.h" #include "tk.h" #include #include #include #define BYTE_DATA 0 /* unsigned char */ #define SHORTINT_DATA 1 #define INT_DATA 2 #define REAL_DATA 3 #define DOUBLE_DATA 4 #define STRING_DATA 5 #define LONGLONG_DATA 6 /* on some system , e.g. linux, SUNs DBL_MAX is in float.h */ #ifndef DBL_MAX #include #endif #ifndef DBL_MIN #include #endif /* Sun4s do not support %p, so switch to %lx */ #ifdef HEX_PTRFORMAT #define PTRFORMAT "%lx" #else #define PTRFORMAT "%p" #endif extern int pixelSizes[6]; extern char *WCSpih_Message[]; extern char *WCStrans_Message[]; /* Typedef for a PowData structure. This is the main way of getting data into TCL */ typedef struct PowData { char *data_name; /* The identifier for this data known to TCL and the calling program. Also the hash key. */ void *data_array; /* The array full of data. */ int data_type; /* The actual type of the data Byte-0,2 Bytes-1,4 Bytes-2, 4 Bytes Real- 3, 8 Bytes Real- 4 (not fully supported for images), String - 5 (currently supported as the "z-vector" for a curve only. */ int copy; /*if non-zero, indicates that the data pointer "belongs" to POW (i.e. the data was copied at creation time) and may thus be 'ckfree'd */ int length; /* The number of elements in the array. */ } PowData; #define MAX_WCS_DIMS 2 typedef struct WCSdata { char graphName[1024]; char curveName[1024]; char type[6]; int RaDecSwap; int nAxis; double refVal[MAX_WCS_DIMS], refPix[MAX_WCS_DIMS], cdFrwd[MAX_WCS_DIMS][MAX_WCS_DIMS], cdRvrs[MAX_WCS_DIMS][MAX_WCS_DIMS], rot; int haveWCSinfo; struct wcsprm *wcs; } WCSdata; typedef struct PowImage { /* this associates "physics" with a 2d data array */ char *image_name; /* The identifier for this image known to TCL and the calling program. Also the hash key. Also the image name for VISU/pict */ PowData *dataptr; /* The data array you want for this image */ /* Tk_PictHandle *pict_handle; The pict image handle */ void *image_handle; /* This way we can toss around Photo *or* Pict images */ int xoffset; int yoffset; /* The number of pixels in width and height you want to count before the image actually starts */ int width; /* The width of the image in pixels */ int height; /* The height of the image in pixels */ double xorigin; double xinc; double xotherend; /*The real coordinates of the upper right pixel. Primarily for WCS usage, but handy to have in general */ double yorigin; double yinc; /* The origin values (at first used pixel) for x and y and the increment per pixel */ double yotherend; char *xunits; char *yunits; /* Units strings for the min, and inc values */ char *zunits; WCSdata WCS; } PowImage; typedef struct PowVector { /*This associates "physics" with a 1d data array*/ char *vector_name; /* The identifier for this vector known to TCL and the calling program. Also the hash key. */ PowData *dataptr; /* The data array for the vector */ int offset; /* The number of data you want to skip before the vector actually starts */ int length; /* The length of the vector (number of elements) */ char *units; /* A units string */ } PowVector; typedef struct PowCurve { char *curve_name; /* The identifier for this vector known to TCL and the calling program. Also the hash key. */ int length; /* number of elements in the curve: == length of first non-null vector (in sequence x, y, z) */ PowVector *x_vector; PowVector *x_error; /* This may be NULL */ PowVector *y_vector; PowVector *y_error; /* This may be NULL */ PowVector *z_vector; /* This may be NULL */ PowVector *z_error; /* This may be NULL */ WCSdata WCS; } PowCurve; typedef struct PowGraph { char *graph_name; double xleft; double xright; double ybot; double ytop; double xmagstep; /* This is the displayed size factor wrt the delta X */ double ymagstep; /* and delta Y of the original PowCreateGraph call */ double xoff; double yoff; char *xunits; char *yunits; char *xlabel; char *ylabel; WCSdata WCS; /* The master WCS data for graph */ } PowGraph; extern int Private_Colormap; extern int slice_nb; extern int nb_slices; extern int Pow_Done; extern int tty; /* 12-23-03 BD change to permit pow use in C++ programs on linux. defines isatty with an exception specification, and this definition causes compilation failure in any file that includes as well as pow.h */ #ifndef __cplusplus extern int isatty _ANSI_ARGS_((int fd)); #else #include #endif extern Tcl_Interp *interp; /* Interpreter for application. */ extern Tk_Window mainWindow; /* The main window for the application. If * NULL then the application no longer * exists. */ extern Tcl_HashTable PowDataTable; extern Tcl_HashTable PowImageTable; extern Tcl_HashTable PowVectorTable; extern Tcl_HashTable PowCurveTable; extern Tcl_HashTable PowGraphTable; void PowInit(char *, char *, int *); /*call this from a main program before doing anything */ int Pow_Init(Tcl_Interp *); /*call this from a tkAppInit before doing anything */ int Pow_InitExec(Tcl_Interp *); int Pow_CreateCommands(Tcl_Interp *); int Pow_CreateCommands(Tcl_Interp *); void PowCreateData(char *, void *, int *, int *, int *, int *); void PowRegisterData(PowData *,int *); void PowDestroyData(char *, int *); void Pow_PhotoPutScaledBlock(Tk_PhotoHandle, register Tk_PhotoImageBlock *, int, int, int, int, double, double, double, double); void PowCreateImage(char *, char *, int *, int *, int *, int *, double *, double *, double *, double *, char *, char *, char *, int *); void PowDestroyImage(char *image_name, int *status); void PowCreateVector(char *, char *, int *, int *, char *, int *); void PowCreateVectorEN(char *, char *, int *, double *, double *, char *, int *); void PowDestroyVector(char *vector_name, int *status); void PowCreateCurve(char *, char *, char *, char *, char *, char *, char *, int *); void PowDestroyCurve(char *curve_name, int *status); void PowCreateHisto(char *, char *, char *, int *); void PowCreateGraph(char *, char *, char *, char *, char *, char *, char *, int *, int *, double *, double *, double *, double *, int *); void PowCreateGraph_internal(char *, char *, char *, char *, char *, char *, char *, int *, int *, double *, double *, double *, double *, char *, int *); void PowDestroyGraph(char *graph_name, int *status); void PowCreateDataFlip(char *, char *, int *, int *, int *); int PowCreateDataFlip_Tcl(ClientData, Tcl_Interp *, int, char **); void PowCreateCurveFlip(char *, char *, int *); int PowCreateCurveFlip_Tcl(ClientData, Tcl_Interp *, int, char **); void PowInitWCS( WCSdata *WCS, int n ); int FillinWCSStructure (WCSdata *WCS); void PowDumpWCSstructure ( WCSdata *WCS ); int PowParseWCS( Tcl_Interp *interp, WCSdata *WCS, int argc, Tcl_Obj *const argv[] ); int PowWCSInitGraph(PowGraph *, char *, char *, int, int); void PowDitherToPhoto(PowImage *,Tk_PhotoImageBlock *, double, double); void PowHandleEvents(); void PowWishHandleEvents(); void Pow_PhotoPutScaledBlock _ANSI_ARGS_(( Tk_PhotoHandle handle, Tk_PhotoImageBlock * blockPtr, int x, int y, int width, int height, double zoomX, double zoomY, double Xoff, double Yoff)); int PowFindCurvesMinMax(const char *, char *, double *, double *, int); int PowFindCurvesValue (char *, char *, int, double *); int PowFindCurvesBBox(char *, char *, double *, double *, double *, double *, WCSdata *); int PowFindImagesBBox(char *,double *,double *,double *,double *, WCSdata *); int PowFindGraphBBox (PowGraph *, char *, char *, double *, double *, double *, double *); int PowPosToPix(double, double, WCSdata *, double *, double *); int PowPixToPos(double, double, WCSdata *, double *, double *); int PowSortGraphMinMax(PowGraph *, double *, double *,double *, double *, double *, double *); void powDebugDataPrint (char *, int, WCSdata *, int, char *); const char *PowGetObjectOption(char *gn, const char *obj, char *option, char *objType); #ifdef __WIN32__ __int64 PowExtractDatumLong(PowData *, int); #else long long PowExtractDatumLong(PowData *, int); #endif double PowExtractDatum(PowData *, int); int PowPutDatum(PowData *,double,int); PowCurve * PowFindCurve(const char *); PowVector * PowFindVector(char *); PowImage * PowFindImage(const char *); PowGraph * PowFindGraph(char *); PowData * PowFindData(char *); int PowIsInRegion( double* , double *, int , char *, int* ); int PowCalRegion( PowImage* , char *, int *, double *, int , char *, char*, double* , double*, double*, double *, double*, double*, int* ); /* New Tcl Commands */ int PowGetRegionMean ( ClientData, Tcl_Interp, int, char **); int PowWCSInitImage(ClientData , Tcl_Interp *, int , Tcl_Obj *const []); int PowWCSInitCurve(ClientData , Tcl_Interp *, int , Tcl_Obj *const []); int PowWCSexists(ClientData, Tcl_Interp *, int, Tcl_Obj *const []); int PowWCSisSwapped(ClientData, Tcl_Interp *, int, Tcl_Obj *const []); int PowGetImageOrigin(ClientData , Tcl_Interp *, int , char **); int PowGetImageOtherend(ClientData , Tcl_Interp *, int , char **); int PowGetImageUnits(ClientData , Tcl_Interp *, int , char **); int PowCreateData_Tcl(ClientData, Tcl_Interp *, int, char **); int PowCloneData(ClientData, Tcl_Interp *, int, char **); int PowFindData_Tcl(ClientData, Tcl_Interp *, int, char **); int PowRegisterData_Tcl(ClientData, Tcl_Interp *, int, char **); int PowDestroyData_Tcl(ClientData, Tcl_Interp *, int, char **); int PowDestroyImage_Tcl(ClientData, Tcl_Interp *, int, char **); int PowDestroyVector_Tcl(ClientData, Tcl_Interp *, int, char **); int PowDestroyCurve_Tcl(ClientData, Tcl_Interp *, int, char **); int PowDestroyGraph_Tcl(ClientData, Tcl_Interp *, int, char **); int PowDestroyImage_Tcl(ClientData, Tcl_Interp *, int, char **); int PowCreateDataFromBuffer(ClientData, Tcl_Interp *, int, Tcl_Obj *const []); int PowCreateDataFromChannel(ClientData, Tcl_Interp *, int, Tcl_Obj *const []); int PowCreateDataFromPtr(ClientData, Tcl_Interp *, int, Tcl_Obj *const []); int PowCreateStrFromPtr(ClientData, Tcl_Interp *, int, Tcl_Obj *const []); int PowCreateDataFromList(ClientData, Tcl_Interp *, int, char **); int PowCreateCurve_Tcl(ClientData, Tcl_Interp *, int, char **); int PowCreateHisto_Tcl(ClientData, Tcl_Interp *, int, char **); int PowCreateVector_Tcl(ClientData, Tcl_Interp *, int, char **); int PowCreateVectorEN_Tcl(ClientData, Tcl_Interp *, int, char **); int PowCreateImage_Tcl(ClientData, Tcl_Interp *, int, char **); int PowCreateGraph_Tcl(ClientData, Tcl_Interp *, int, char **); int PowFindCurvesMinMax_Tcl(ClientData, Tcl_Interp *, int, char **); int PowFetchDataLength(ClientData, Tcl_Interp *, int, char **); int PowExprDataInfo(ClientData, Tcl_Interp *, int, Tcl_Obj *const [] ); int PowDataPtr_Tcl(ClientData, Tcl_Interp *, int, Tcl_Obj *const [] ); int PowFetchCurveInfoHash(ClientData, Tcl_Interp *, int, char **); int PowFetchVectorInfoHash(ClientData, Tcl_Interp *, int, char **); int PowFetchImageInfoHash(ClientData, Tcl_Interp *, int, char **); int PowSetGraphMagstep(ClientData, Tcl_Interp *, int, char **); int PowProcessCurve(ClientData, Tcl_Interp *, int, char **); int PowListGraphs(ClientData, Tcl_Interp *, int, char **); int PowListCurves(ClientData, Tcl_Interp *, int, char **); int PowListImages(ClientData, Tcl_Interp *, int, char **); int PowListVectors(ClientData, Tcl_Interp *, int, char **); int PowListData(ClientData, Tcl_Interp *, int, char **); int PowCleanUp(ClientData, Tcl_Interp *, int, char **); int PowSetupColormap(ClientData, Tcl_Interp *, int, char **); int PowSetupPhotoImages(ClientData, Tcl_Interp *, int, char **); int PowTestColormap(ClientData, Tcl_Interp *, int, char **); int PowPhotoCmapStretch(ClientData, Tcl_Interp *, int, Tcl_Obj *const []); int PowPhotoColorTable(ClientData, Tcl_Interp *, int, char **); int PowTestMacMemory(ClientData, Tcl_Interp *, int, Tcl_Obj *const []); int PowPutZoomedBlock(ClientData, Tcl_Interp *, int, char **); int PowReditherPhotoBlock(ClientData, Tcl_Interp *, int, char **); int PowImageScale(ClientData, Tcl_Interp *, int, Tcl_Obj *const []); int PowGetHisto(ClientData, Tcl_Interp *, int, Tcl_Obj *const []); int PowGetImageZ(ClientData, Tcl_Interp *, int, Tcl_Obj *const []); int PowWorldPos(ClientData, Tcl_Interp *, int, Tcl_Obj *const []); int PowXYPx(ClientData, Tcl_Interp *, int, Tcl_Obj *const []); int PowGraphToCanvas(ClientData, Tcl_Interp *, int, Tcl_Obj *const []); int PowCanvasToGraph(ClientData, Tcl_Interp *, int, Tcl_Obj *const []); int PowGraphToPixel(ClientData, Tcl_Interp *, int, Tcl_Obj *const []); int PowPixelToGraph(ClientData, Tcl_Interp *, int, Tcl_Obj *const []); int PowResetWcsStructure(ClientData, Tcl_Interp *, int, Tcl_Obj *const []); int PowGraphVToPixelV(ClientData, Tcl_Interp *, int, Tcl_Obj *const []); int PowPixelVToGraphV(ClientData, Tcl_Interp *, int, Tcl_Obj *const []); int PowGetImageClipbox(ClientData, Tcl_Interp *, int, Tcl_Obj *const []); int PowDrawGridLines(ClientData, Tcl_Interp *, int, char **); int PowCreateContour(ClientData, Tcl_Interp *, int, char **); int PowGetTics(ClientData, Tcl_Interp *, int, char **); int PowTestImage(ClientData, Tcl_Interp *, int, Tcl_Obj *const[]); int PowGetRegionStatistics( ClientData, Tcl_Interp *, int , char ** ); int pow_worldpos(double, double, double [], double [], double [][MAX_WCS_DIMS], char *, double *, double *); int pow_xypx(double, double, double [], double [], double [][MAX_WCS_DIMS], double [][MAX_WCS_DIMS], char *, double *, double *); /*see the sample tkAppInit.c in the POW source directory for an example of how to set up a user function (readpha) to allow passing data objects into POW from C */ /* * The structure below defines the record for each powcurve item. */ typedef struct PowCurveItem { Tk_Item header; /* Generic stuff that's the same for all * types. MUST BE FIRST IN STRUCTURE. */ Tk_Outline lOutline; /* Outline structure for lines */ Tk_Outline pOutline; /* Outline structure for points */ Tk_Canvas canvas; /* Canvas containing item. Needed for * parsing arrow shapes. */ PowCurve *curveObjectPtr; /* Pointer to the PowCurve object that this * item instantiates. */ PowGraph *graphObjectPtr; /* Pointer to the PowCurve object that this * item instantiates. */ double *pCoordPtr; /* Pointer to malloc-ed array containing * x- and y- canvas coords of all points * and errorbars in curve. * X-coords are even-valued indices, y-coords * are corresponding odd-valued indices. */ int numPoints; /* The number of points in the actual set of * XDrawn lines * == (length of pCoordPtr array)/2 */ double *lCoordPtr; /* Same but tracing out line */ int numLines; /* == (length of lCoordPtr array)/2 */ char *pointType; /* "Cross", shape to draw at point. */ int pointError; /* Draw point the size of errorbars? */ int pointSize; /* Size of point (absent error bars) in pxls. */ int pointDisp; /* Whether to display points or not */ int pointFill; /* Whether to fill points or draw outlines */ int boxFill; /* Whether to fill histogram box outlines */ int lineDisp; /* Whether to display lines or not */ int stairStep; /* Draw lines in stairstep fashion? */ int logX; /* Take log of X data? */ int logY; /* Take log of Y data? */ int LOD; /* Maximum # of points plotted when */ /* Level Of Detail averaging is enabled */ /* Use 0 (default) to disable LOD and plot*/ /* all points */ int curveToPoint; /* flag to disable point to curve processing */ int capStyle; /* Cap style for powCurve. */ int joinStyle; /* Join style for powCurve. */ int hidden; /* Hide curve... don't draw */ } PowCurveItem; /* Definitions */ extern Tk_ItemType tkPowCurveType; /* * Prototypes for powCanvCurve procedures defined in this file: */ void ComputePowCurveBbox _ANSI_ARGS_((Tk_Canvas canvas, PowCurveItem *powCurvePtr)); int ConfigurePowCurve _ANSI_ARGS_((Tcl_Interp *interp, Tk_Canvas canvas, Tk_Item *itemPtr, int objc, Tcl_Obj *CONST objv[], int flags)); int CreatePowCurve _ANSI_ARGS_((Tcl_Interp *interp, Tk_Canvas canvas, struct Tk_Item *itemPtr, int objc, Tcl_Obj *CONST objv[])); void DeletePowCurve _ANSI_ARGS_((Tk_Canvas canvas, Tk_Item *itemPtr, Display *display)); void DisplayPowCurve _ANSI_ARGS_((Tk_Canvas canvas, Tk_Item *itemPtr, Display *display, Drawable dst, int x, int y, int width, int height)); int GetPowCurveIndex _ANSI_ARGS_((Tcl_Interp *interp, Tk_Canvas canvas, Tk_Item *itemPtr, char *indexString, int *indexPtr)); int PowCurveCoords _ANSI_ARGS_((Tcl_Interp *interp, Tk_Canvas canvas, Tk_Item *itemPtr, int objc, Tcl_Obj *CONST objv[])); void PowCurveDeleteCoords _ANSI_ARGS_((Tk_Canvas canvas, Tk_Item *itemPtr, int first, int last)); void PowCurveInsert _ANSI_ARGS_((Tk_Canvas canvas, Tk_Item *itemPtr, int beforeThis, char *string)); int PowCurveToArea _ANSI_ARGS_((Tk_Canvas canvas, Tk_Item *itemPtr, double *rectPtr)); double PowCurveToPoint _ANSI_ARGS_((Tk_Canvas canvas, Tk_Item *itemPtr, double *coordPtr)); int PowCurveToPostscript _ANSI_ARGS_((Tcl_Interp *interp, Tk_Canvas canvas, Tk_Item *itemPtr, int prepass)); void ScalePowCurve _ANSI_ARGS_((Tk_Canvas canvas, Tk_Item *itemPtr, double originX, double originY, double scaleX, double scaleY)); void TranslatePowCurve _ANSI_ARGS_((Tk_Canvas canvas, Tk_Item *itemPtr, double deltaX, double deltaY)); #endif /* _POW_H */ fv5.5/tcltk/pow/pow.pch0000644000220700000360000000017613224715130013746 0ustar birbylhea#pragma precompile_target "MW_PowHeaderPPC" #include "tclMacCommonPch.h" #include "tcl.h" #include "tk.h" #include "pow.h" fv5.5/tcltk/pow/pow.sit.hqx0000644000220700000360000005047313224715130014577 0ustar birbylhea(This file must be converted with BinHex 4.0) :"h"[GbjcDA3!8dP84&0*9#%!N!3m"`#3"!@q8dP8)3!"!!!m"h*-BA8#K`#3!aE rrb!J!h"[G`#3(1S$#BB"U!$$!S)#9`#3!`%!N!q'!!!"$[q3"!2JY&mZ),5@8hX !N!8#"Li!N!BlJIrarr`!!-0!!!!pi!!0"A"[Gbkj!*!D',X*KJ#3$aB!!$ZA!*! $&J#3!`&069"b3eG*43%!VhJcrE54)Dd!N!8#"Li!N!BkS3!!ka!!N!D6m`CiQYZ "#rr1A#+3!#cmb#h(9Vk3!%d@2R#l9LkR#eXSf32fDeHZl$52ka9Yi3YIC!ZHHR* kH(Vi[!MqBlpCa4Fcb@*Hr"E#@Tl`aFJQbr1&h,i'C-"fC0()FR`Cm5),fH5@)`X Rbj0EMLa(0PR)SQ4(MT1&,drf4rBNb5,C$#Zm8TR2[B@lcdkbF'p,plU3!&r)m89 b#eR),@56fa&1&SjIb!U`$[,Ul"[Bc$`h1hXl,krcfLkFX$SRAQGHAYTE&UXhcpp 10-Z6MhV,Xmq"ICVCHf9REqIPpACqNQANG@D1%J'CN8@bH"RCPr'Hl,c)-K%!#b" Jr18hb%(RP@qpfIBL,-+,,'4jcpKY!,i!C-!M[f`R5H4jhUMRM9c[MAckflb4IjV f[#XH`qIZN8dMr$TRHG)*j[`d$C1ddNU6TD#G$haY+8I4%pa,Aq9j1jcpfDIHXH- (21p0)pkK(GGkV6GH1[S,1%k6X`50Zpk+A-)Gj8jaeh02iTl-hF!pKAXUpc(F#Hi klQ20c[pah-Gc6qFqJIY%lT1i6qBqKIY8lY1iCeLX@8THhphFkiZm9H%lH&l,r8Z 8j9QZ(-CZ8VKrj)'2hX54fYAb)2HA&T%LhRF@PD446%U4lbSU([('cImXmrpjXcq ZU(V%Hdh4$4([YHDrh2jA@%HYY[m,LSk+H(Z+MSTiYeUFLbbI9F@rpRRQ+CRcIbQ +U6041XC#[Bd$#BU$15Rj%m8da46A'HTPMER$VH6ShX$["'QV96X(&d8)m40ckK5 '1d-YCQ*)34aFTT!!MTFTM['SE`6T3P"TpVq'`ZG`cQZeTST5abHQEMh8AJil![E 0-e3c)H3hK8q(e&!fECpra+p&ITB&@AA*6mpQYDAHUM6QlQKCpF+LH5e"e*ZiVqE ZiEk9qaEZflK[jlk,qaHiAmlp'ZklZ9r"r8VZ9h'rQ[XqDk!&h)hFm`a5JD#Ph%Z i1lNlZ*r,VD%YiR0[jflR"Y,fF0r!I52hcGcAF&r($4hD@8"Ba,Z@Hlj9$`J'C&S ,'!1bJ#Zk&YJ$dS!jTmSY"B4&["X0jRr1i2NFS`0!qFZi0C8`-(qk83$S3V04!Q! Gm*aYm2idSaCcZHG`cq4Z-SS`bfJ$p!"JK#)mRrXjh1GbRfHd!lU`PIYjh%rKhPC !X'B`i++qRm(pE1iA&&!EmICcVq&HbkeTBD6*6AG$+el)[B&l)hFhpahF6qGq%IH Gh*Zi,qAHaAd20dKe,IIeh2GbRer!Hm6E9X!e%!qX!qN1[9PTG1NLlTG`Ya9d)Z, 0FcqCZjIlaGbEZDrJILVhCGa2%"$Tqh,Z*h)rbDL5#d(3SLlZah)[jCl'[C'lQAX *pbVZeG`AFkrKAXYp#IHkJNkT9Ga1H#1Ap*+Me8i8*A'@4%%&*Y!i-D@1mA&fcf+ NQYN@MP,Q,Z[`8&KG,'-hI+*-8+`Vaf'e@5C@198fb3'''iAIqVlpHAiCN!#NUFE [$VDQ5a+9S$qNCVH&!Yh`3-e@llTG4-"KcTDhXhDQ2[RbHT`(D4cNPFPM[5K*Jhq Kmb0R9H$#YJA(4+ZYE!F#NM6UdYf1'Rkl(SGjk%IKm@"2kLpdJrMIj+NV$QHjlqP RphqV@9FF"XHFr,Z$Y"['I[iIk4[PT%DIXP@[R6K"BN@J4a%)C#YH#L$B44'IR6Q -RaiCKdMieH6m#!,LXe'eqC(r65-R4MC[NTbGc@RV+hC,&%CdGc8j)jM[@Ea8SM1 #GA`dr-LIm)pBRIL'A4d*f!`,e,A#@',d(h!Rr9BLSIQ[Z910HLl!r"IZq[a!J1L [***2DJ3a`Vq5!$mjVb8)rNU#G3-QA8qP`B3T54BJ8#X*fP2$+*,Y$GLQc5`Q$!b S$f!lCQrB)6re)@c(0T)Mf++UhA'h"MRaSK,UMmHNDa19`$hpH&"$Z)jU'1'%+&4 YSK,16l4i[iMYT,`f5rfL[ilYj$bkR9M42mGf5KMAU%hdipK1VH84J`8aUBkR4Id !F6qQSBFCdHBCFST*V$pp0XL)&p03`m`*#,'f-BJ`DcEe'3+)DC!!S[&b(,@0[Y& pTaJ%L2dP0SB10#f1IBEr1Hmj0SR!(TH)cX!"EFM3!i-)f"J!B!!$'m-8-M!4ei! $``cBISXIKM@`ICJI"L1`r4-r$%[3cMTI-eb"M6`CdX#'CSRiM`fKR`%1E!b0-$b !MB%3kSrYMrKKm!2E&rKK%!6E[r,$F!LPC4L$hXI'8!(ea-CJ!i-If"J#`4FE!`d -Gf$l$AiB!-(f!AiBr-$f&AiB#J'#'2*J1!3E!bS-Jf"Mi%&NqD3'-3`qDKX$'G3 Cfkrc!`jLHbmr-Pb8I*`I-!4B!m8CPX"'Mc%dJBfK#@jXB#$$%pM!-)BXX,fH(iB lX,f((iBmX(f9(aPGU0F!#N-If1Jam!3E!b$Ff"LJF8Cp)T[9kr31YMIc!aCMqb! ri!1fVr($S!M`be!-H)X0,'"3""YeBD!$'lM03!FfF)["$Qc-f$(JJHh2q@(3!p[ ImF2!"j!!6Rm`q)%0l'"J""XjJb(B'$L#8f"MjJe-a[DRr-M!aZ3Rq+&2S3E8$,k "MCb%L$HSTJbIB#-R"TZ`-Dc%8"%f-)Pqa2CPIX"N+!B$2Jc%B!1R'$l#4Mr!3E! a&!8@BG0cHQE`"GXlq4'KDXU(q@'B#DS#MSUm-&@p4CpLSeH&Udf9$eL0MH%U"V+ ``6NBKX,fHAl!@'a-16#S"IeKm)JkB`12K-P08pdC!-,'B!l$40KqKapUL1f6aYf `IBFI"SqJ83cm-+5&$CaP#!NEr3Nr`SBr!dhBIS8I"VZ`[BmIm"2EerN"+r3j9KM !%"3fZ!4$6GM!,iDAX0%RB#-f"U(!H@cd!6A%pMIm-)#Nch'LX!alBB2c%"-E@!N 'BU0A'@,$4Mi-XQ'$!c(-KZeMr0"hf,l0$`05qKb[!5d'hE$"+m!3E1!DI!dE[F3 !&ECIj3IZJ`fZ`-!F0[S!AUc2G(&%m!dEr!H1L3f-!8q`dDZ[-aZaIYPXlq+(AX- 'ET'[2LHSYq!4f1"lB$)fm"[qJJdXJbpMSfIHD,EIj!F1K3eHqbDcr4XrF!Gp6T3 '3"aXm"pk"aZiqGYQSfrIBMCb!fH``6Pqefc`blFkfdRUJlHC$ElhGV2"-Al2E'$ F1ma'Ai%$f-$DhcFEI3"IeZGN$36qSGRJXH!m0RVVMmd'E[f*fDJ[Z@$l"$rd&cC U$qr3ja6akMmc'jMpEV2"*H!lf1KAZ"XfF!3Y!KZp"!jJ)cH`%4ZFr[eQqbBrm&C p6PApk"GXi2U(c!Efr+ACi(j`GQc`SSqBM9j"Lm%'$S*Tf-#AMjZ0RU61f-J6r-I f4AlSI@cr`FqRRHddpHKRc!Dq8MGXm1I2QBeqr5ZcJ6(`&'c`!63IE1!Ah"mEI3k 'Bk0Rd'U`N3pclYM!#@ULc`aaGrJ80SB`iCABi(aI-KZF'4c!4Pr#cE("KG!"X)& jrf!f-"%ZL3f-J'YMSarJaGM`q8Hc`EI!F(e1&cHL2YMJi[HE$Hle$E2"GHPVE(# cEjN0$S0HK!emKfYJ!pIqf@cd-e`-'hhbAE14'lUC2M1&pfK"f0!cd&+`SAH!AGM !URmh'pbB[XB'9[fRfH!f-M%h%kab*FfCi*Slp6D62R5R,'G5,k9qe'F@h%X9%U+ fD5e+ZBR[b"DiRA,6ij%Yk#E+4LjQS4FS0adHf3+A9KU!aDDjRc)9G"CpUF6VX@P -9fjD2E)&[&0Z%MfbKGj@'Xl&TQZY0)5V6b-$`8V$ZpLdYU@%AGJd9LN0)Q262%! 4apJdEeFDr-@Q1Dh4)E&TcUBdX)Y0F`bPIXHQX9MCi'UMhKk!'f,6rDQ%5rSmKVS S$3GMdd2%bZEc(i0'TV!EQpCpP,!GQpBqP)D&X@QX8ZTPE"UVP$JA0XhaP23rE"U VP$4-E"UMPHPrM`'VP1PrXc@M,[VIE2*4T[r04Xr3EdSi0V46dIpQSqmSdrpQJpr +p,rCm#4PqYpXH+mbr@mfR%QCrMFE$U0-rjZY[K6pEcEBT%crQd2I+Y2rjP!MCIV I($3lCIVI(23TSreLdrLY62qE!eBTdrrQ`+Z8kApci*r+p,mjF$0PqYmFZ)Fbr@m 1@+P-rfX#8j6TIdhdQc,pViNmPHPr6@J'b[5r*[Lp-[f[59Udk(p0k"I+p,mQH,N brDp*@#AkAj1`5[5r*VL+-[f[59JPqYpFX%DCrMGA@#AkhecKTHKrFi80S[r044G 4T[r04BY4T[r04DG3T[r0&Ak,rMFAVUP-rjX,Ie1Qrmf&fbM6rqD"aFVd[hRU5p( rjY&Mb[5rHH5[62qETli8r@qHX%(d[hRS'XVd[hP`G@AkhcbiU$,pEaim5TRq0ar F9kErcCI',IVII1'dk(rc9A[4rqDMK5R6rqDMqbM6rqDM-5M6rqD,ViMq0ere&[e [2Ta0QIlA,!`3rDpCp4EpVjQq9DEr09-MCITIXr)@rDmCrFM-)'$6'SFbrDmC2Up -rfZ'IbV6raE!Ij6TI`[%!d6r@`!Q+Y2r&SJ(L2khJ2SUdrm@L!H)rVG!r5hkh`* KRZKr#q#)b[5r"I"#CIVI3VL@-[e[SA"1p,q&`PV4raB+DdAr@bJH*[VI3M3ljJf -$@`6r@qK1*!!k(m,d3L8kAm,eG1Lrl8)5d6rDi&M+02r@Y66S[qeJ#r+p,m@F5r 4reVi9kErYD$aQ2N1E25Ck(mYD"r+p,m@m3c4reVKR-Vd[eDiPM,pVa9HS8crD`8 IPHPrVH)hS[qeL[1*rYH+4U*-rfY&$e+Qrl@UhU,rYD)G+02r@Z(-b[5r4I"$CIV I)[%mdIm@UEp&reX%VLR6raE4BmVd[dASIFVd[d9SAXVd[d@UYqKrLj5hk(r3,QA kAaXm8jRqekCkLrlA*X`@rDm0l&1Qrl@ThU,rY9%[CITIQr)@rDp0R&,d[cEeYqK rlH+8S[qe#mp%rfZ(QbR6rpT9Ep(rfX&hCITIZr"-p,pfqNfCrYI1[c,pVahp5jR qeil@SdcrDdHc8+Er,BCM+p2r&JY(4IpE,0iQqYpLiCRSIiY9Ep(r&JY(4IpE6"f 9kAq,dCq8kAq,dDH8kAq,aHP&reXL6Lrkha)D8*RqY`31TNcr@`)28DEr,9'p4Ip E!KiTdrq@d([+p,mPj+C-reZL[%Ar@i,ZSdcrkd#c8+ErGF$$PHPr(H)VS[peL$H )rYF"TL[6rcT8Ep(r1Y4RS[peS'mTdrmka!9&rqY8Ii[qeiNfS8crki4M+p2r1S8 VS[pe`TH8kAqGiU1Lrh8+4dArka3(&If[8ja-p,p1j5hkhe,P,IVI8Z'hk(pQ$J6 q"qq$lm%MiBR`2AJHr!kH#Bq%hm'Ai%R`)cJHh!j1"jH$`m(Gi'a`06JDh!`q#Lq $Mm($i&rZ)bMZibIS"1J!m(Pi22`G(3'G!2i1IhBI9UNpd1)qcS,H!+F1(NGahjP #+d-M3hY$@`[HTZ+J[39[9+&p(AUA#Jd[H*X+23Vp#0d)[3LG#2d*I3QG#(d)A3K p#[d*A3Jp#"d))S,ZJpk$cS1qJkk$RS11Jhk$ES0HJik&9S0'JcD$*S0qLQk+TSP 1LMk+0S[fLMk+,SSHLRD,lSS1Lak,,SSHLJk+rSRZLGk*cSQqLDi*0k1&p!qk*AS P1UA4*lAQLcD**SN@L3D*pSMQ#%q#(m',i%2`)$JB(!XH"2q"pm$4i&I`,EJBr!I H!pq"jm"[i$A`'AJ-r!AH!Pq"Tm"2i#A`%AJ)h!i1![H!Fm!ei"L'@m!4i!C`!VJ !(!$q!Eq!!i$pB$lm"'i"ei#(J2eJ2PJ2aS2YB$TB$SD$h@!f@!e'JmeJ-PL-YNN 1j)m'MrD1jSl@MXB1rdCVe6L$CST@LND+2S[qLND+0SSQLRk,pSS@Ldk,0SSQLKD +"SVfLHD*eSR'LED*TSQ@LBD*GSPQL9D*4SRZLck*,SNHL3k*rSMZ#!q#rm"li$[ `($J@(!UH!lq"em$"i&*`+,J@r!CH!jq"am"Ii#h`&AJ+r!31"dG$"d(r32G!ld$ R3'0"3d(R30p!ed#$36p"6d&V3Gp!ed$23-G![d#h3+p!Td#I3*G!Md#(3(p!Gd" [3'H!6k,IS$1J,k!VS#HJ)k!IS+fKUD'PSC!$RD(ESFZKRD'CSC@Kkk(*SG'Khk' CSC@KND'0SBQKKD'"SAfKHD&eSA'KED&TS@@KBD&GS3HL@k&AS91K6k&,S8HKeD, 4SXfLbD,&SJ1Mmk,&SX'L[D)6Sr'LqD)(Sm'L[D+jSV@LXD+YSUQLTD+KSTfLQD+ 9ST'LMD+*SS@L,k1$SRqLHk*hSR-DI42G"Ed&A3#Y"Bd&l3CY"Sd&E390"@d(M3# p!3d(V3&p"Dd!23+G!)d&E390"Id"238G"Id%h35p"-d"V350"'d%633Y")d)(36 p!ld#V3(p!pf$f3"d123hG$Id0[Fa0M3m0$Hd0M3f0%!d2M3mG$Ed0A3ep$6hi5p d-r3bG$,d-A3ap$"d-23[p%+d,c3[mkMEHG-cp3U$eqB*V60f,(Yl`M6,+c1"Hm* MQ4XbAa219qVGAT,Qa,MBDl6QeXcRqcc#e4YApJC4cf[-9@TMYDeEAD$0PCDIYIf SX'i)MRZYb6eVSCHGcGqNUa2CNF`PDG5TYRR#B8fP9L9BialrqZm)$qrSh&#P(Sj IbpE2HekC,r,[1ED[KGc3Mr1`'q!XXEBfCkU41@qX0`mH8NE'0e-FrEkB+8l1+@J 1c&i$L&%D!+ZqcmZkhU&DFmqJ#iaIZLP-8+NX'AZ9pUcQ0BZRqZeJYG4"CB1S6Me G$kPR@,b#5cTGRP2,CZDkE&6DiTIV,4e(9ip)KBc0'fd$EZ4`AUqhPPBZJq9l'U# %LEE5lc,3[`fIh[K)N!$5&C%p8A#-*e+hpp+N(@4CNRUl``aN#Pf@cH5GFmQA[E, "r23P3Z0kJ-Mi1RBYSi5lr63-XR%VU[Y2JX[1pGEqL,N116q-#cqrC`%e8m)eBEa -Abc[ChR5VH`2hR!d56ZCYkZYAY$3e,HBHE-qceN#qAej'#pN-!"Gk,9qVeGBcqq (8BHA8rT52r-QJ[Rq`N+3!&CFc)J$ZZ9*YdG-RDBakkGUGlT%ZPZNZ$1)[2U"5V0 (aI6M4,Xp!d3[UYLpX050[PiCa+l*VXhd0P$2I"%XA94-'MQGIhN@ed&Bb9Vc$6p ,(@9PP-b6U9q+hU-e2cj5kkG(!YS9Fbp2[I6i[49V6pH21jPCG`FmEa3%-`iVr0a IXkp-rGlLQX1UVVq`([&55Y@E1Sm,MX#c,L**A56*Ff8D#MbdK6HG(-ZQ2)c-IA0 Y"N0I1jTCp00!N5i0XrlKYLT(#'1p1SL$0'b[Q#84Bp[4(jMf&"PN3rFYelX,VE# Y+2TTTc1VfkV&-iVGb`16VS+$M[)%)h%@#AdJ8MKVM$,r"U!)JQ2hmJ$FfKlf`0( AVhMFkSh2,YmNhN@FAEhf'8mh0FI6F!rm[(VSb&Nr!p3A@q'f4QZ*Nd3k1Ep`9#4 dK)pkDG0[6Rjq6jM%Xjj"kX['aqXaVf[YL2`m61+eQZ9GrE5bVQkAJI)VdU4AMpF )J2E@J+rI9qRYTqfJ@U#D+9XK#qR2X&HlS[j#'"GYQQid(@YAHh%&JklS&6%d)25 Qm`@5Q'MLj5B#@ZVAA+l*Zp&KI1LM0Q!U%LGj-*mNbi@4c16rJJkTL%frhh*YX', FX"!A*RhVbNT,kU3h&K9ZR%d$(T2aZ)MdJSXhTReeqMe*RY!#f6SC"p0-bpClheM 2V'jhr8I$Emclm`-d@#Die3jZV$3NB3cMDKab)K29f2c%2FXL3KQV,I)SQpCQYX4 priPCN!$B3TB)SjJCdHmrEC@Qb-`(Mf)cH-(XM-arQlNApmNpCRAFf4CQFZU[GP2 kc12S'BbV00H$MMQj-eRNKbECd(%6NQLc-[pYY&DCrcDc$G-qpeJa&m5Fb$(c5c+ 4SUlE+4U$-,2P-[pYjV'2pdkGdS`)-b[6Nb+JQHQ9q@mc+b[chfBf9FmfQ(M-%*h X[9@e-A1ETr5+fTLj4jRr0[1%-[pYC[0Q4)Kb-[qQCaiH,jdG$ARQrrHZe(`+maS -ca12HBa'%Q9fJRNAHIr*Y*l-IdFehb2che(m)kpiZ*MiLQVZCQjH6+Y'0CFdEr6 qYk&44p9cmlYCMSBIeBb8RU@)SIp'T3N[m+l[SZ0(TB2,r(G8@R4,FRH#*Kc9I%Q Vpq$Gc"0%0CHPjbfLc&QBpkkBrp(c(c(ePXarac3l*22I-Fhkb2ah6202-[mG8ce NrMXQh*!!qHqBjPGNrMZQ@4@Crii*)@6q1kEC(jRrMQX15ZDriqS*QIq1UbGNrMZ Z'XRmGeacA$,r(GGXPXarac9A*[2IFFf8bIahA$0K-[mGPriZmppaDHBbrahA()( -ImHPlF[mGe`p*22IFFhUb2ahA,-k-[mGemb0c(r(p3k&c(r(0EmNmpm*iCh-IbH %+6,rRG"FPXar*e4hQIp1+!HCrdjS0NlQ[a0#"CRr6QL'31Dr%jS$N!$jEr0HPma r*c6R)22I#G99jVm6QS'3!2R[K1D$C2ilS4NMQIp1D&C)jVm6Q['5qHq%CV9NrVY 1f#hchhAL%c,rADIj-TRrVP2rbrahRAT91('GHNRQ[qY84jRrVP21-[pG*hqCrkj 6l@AqZdic&$,rADFj#CRrVK0QbrahRAL'c(rAD@j$jVrVa$PNrVY1XeFbrefR'5Z Crkl6I*6-IpF*)fAqZdl[DmMmGe+cHc,rR46Xbrah8M0i-[qG&&E+r(G5f#6chdP KJFar*p8c-[qG9&ePrMZT'3kCrdjUrN6Q[j2#)CRr6SScbIah8MJNmpp*e8cQ[j1 UQFarQlI0C2ilTAP#QIp1UAGPrMXPh*Ijlj3`@ZDr8m)lQIp1U9pPrMZP[TAjlj6 k41Dr8kUTc(qRP)r-IkFdVb,chbR0kXMmGdSeP[R[P(T8jVp6QTH6qHq8CYjNrMZ Pq6DCrdjTpP$Q[e1D)j6jlhTa9*RrVKF2P2R[H[&GQIqZ&fq4qHpkm35CrkiA,X[ mGlf`6qDrki8e-[pYhQQ6qHq"BaIBF5'cUN*aNB6J#Ih$,l$lQ8Nqqb)RLaR@6,' U,fPQ2-Q1k%c'jLCQ"lHiF#GNh@`'*fAamGB5#!jXQ%mRI5Eh@GcAF9r2[B1lKhX RGbrh,ZiEZ(Gclq(Zilk4qbEZQiYhk1XCMka-Ma`mhUS3@Kfic1E9(cRTa36d+Ed &kV`+B9T4hUFjHRki"dBC'CeMShL*p5H)V9h!V#CEpN3AA!!c'e%EQ0+H1Bb$%[1 -dh(#T)-i--pGTq18`9blSq"F2B`$5lV(GP[S1&0VBCI'&qARAS[6qDpa8%bH2U` h5XMcKr9'DAR"-!l3r-*K("5D&`hM`",[(-C"fARa-!kUcdZ'F9#%6Krf$dcpVQ% Fe+2AkQhe!TB&IB[kp,cbYcMkZ+pAQ2qhhAmYkNf6[A#52ZlSJ1AY@"&@UYQRLhN "I)EE96ZGJj1#1BBL'F(4U0D!AQdp(d,A"#f%J++S&F6rEc&,Qa$&'T@`[QrRrKR ZklL[jpl"hF1pNlZAHaIh$GblZIG`ph(Ib(d6pmf+VkYQ1NPjKm2"cK%20DcC1m, mr(M[L)KqR*dM(NlJX2KTHY!2&V*NfmXaU+KEBp*dFhTABl)kHFKQBh,Rd$S#p0D 9kc[51+,Ih3qGq1IARMTedXDM,'hR@AVE+BX,,aFZk)NJH4lBdRCHTRHqXVM`@SF ,6bYIfCA-*R0!JFN(QNdEI(41kYB$"feb-R,T96`-Xp@p%,+0jiXBh5$ZKI@T5DN NIUK*,l1h!"VG)`3-GN894bICCI&ZAieAre,hV%)Z(&0&mRrQDVMBCAUp)"eVUU9 dRIeIErmll,r(rRIDIkrpll,r'qarYrh[XImqqlr4rQqbrjYADc(j-Tj#m'Y4Cf9 HEImAfrmDqepVrjIBrlV9A*+E9pkP)"26@$V#NY8)kJUHH*!!Ga[dqacD)f&40YT rXrf[Yrp9pMpY0B[iPG5XIAEj#iNXYIr(fRq(rAIDIhIaefE@G[YIl&f1j*FXY,U TL"H6T(V*l,%&lN!Yp-X#hbY%,A$"'JF-,LlShmN1&hMXa3B($MiZ0"JZp1RCS'A f6THp$5&mA+KEai8H[m30%l+iB+DY`!Ac2TReM6$iZ*!!HK)AE'q%`FH&HNfMmL$ X-ZpSN!!ZCca3UemA[6,YV$b1L#m[iQB((baPk1(Ve#Q(#qCTi)hpRPkEYVN4"Km ABJ8Z@0b3!#"cI&c3ceIjHZ3Y[&9VLp-AR$Ni6hG#4ELba)e*qVJ`aEhQicbaBQf $JmVKmC`HReIQl5iRiBfqp-acp,R$3dEK)id@K3EpRkcPF9NbX-0XY@c01bHX[Dc i+$(KH$bSIYrZT"phY%"+k4LGJ[F-pEZ*+)rI1c9ARjk)qfcdBBXpjL96mk+SpHe B#(EIrQ&i5pLjF9ppr38p5pZ*fTS1aJLcX,m"`M9jhKXI'eYLGrqfV-pU8,hG-AB XfpC[jpRB8QGjl1EUc@1GT*f0qEh3eXDaM"cp9RYqcc,VkR(A3,1i(+[Fbjq2(0k DeVph2,I@LBl$mNSA$q1`f0+DB4bQCYB1il!3dbA$1%aiVa['BC'QVQ%FTS$@$q1 `@0+'B4`iH[F`$Zp(AcU-`q[bQiGa@2KTbc!1bd"G2Sc$SP"2(-CK2RY6q8)FrEJ j#dJ0VM2M(5Y'(*E6fUeeGE4YleSl,&AfP1I@U0'RdEYimFU4N6MAj0VLRAGiSq% e*dE$9lIBKTDY2["[LSUG%XrG16,5R&)FlEpVeAr'!IC(2(Il0Zpe%mQ%iUZ49jq `9cM`Efi(1hIHYQYbrrl@lS1@heX8AjHj8A'FYph2h8RkjjMr4eIcipecpe82Fl6 r0dllAreEB@mqi8'j&5-MrNjARmGIL6pELbc'rff$I89N*a)rRf0'`qA(L,Iillp 28hc44iMh"Q+PTT2i`KBIX8DM93+JX2&HGrINSGRUPkF&qaI*c"bfC$*jb'*HJkH `IQBqMp9)U--#iSPZ"DJMKfh,p&#P"@"+NMb@0qqeaFQU4fmq5Q'(Bbb2-PZ3!1a )(UZAdVZUh)r8PC(5YA-e@r,Y5(pXQ$P`E[qR(qCK%1BUff0Y%''#j9X(MXRMDYZ PEH!8YLN0MiHFV2GiY,BQ$bB(M[DpC3$*Hek!Mh3p4MN+5p#1jf%&B"CEkUf0*Ej UI8EIE`PlYZ6HNAl9ib#bq0b2$VLi1dX[J0P%(TbfGX4fU8IUD[+icRq"RFSfJT( UmI!C($p8$fFZKIeh"fKPBrN%SecEQ,+e#kXRZi4`ZI*G8aY)0Ck(0B!*VYZplbX )R0QQZ(5kTSSe+5d!pE"8-004,!mh5Kl1Sd9V*9S"mKJTb!0j$!2j$r+S-B+$HHK ClTrf[Qe!56M5pbJfPJ%&B,3l-XY-$rA(,MBPYJ6NS4H`rA&rT1ZkGI&CC(`JMeh RfAZYVPiHpJ#&C%pJkeiHa6-VJ0*LRe!fc$DkSbHlLRITl'&pA6Y!(T`fQZ54ZVU lhV6pEj-B[F%S*'EVY(+3!%RP%`U*j846YJF`1+Z%pQTA32)$Cfa@I9ETKbCBfVR 592k`*PM0`fib(A*)JkYdad-Dh&JH%aVF@"i6'Ybq2!jUF,8ml"dDh%"GE3iDA,A 4$QY`Y6`Q0,L"0"l@i-Eb1+6"P41a%@K`)c'FIHchjm'kjl01DNF02A'ljC@MYlc qhP(XkVJfHAl#0Jpl0c[SalEHbEZ2-DfX2%2qqYAj69XqFBmQ6bd#c2fb@R1$,a, $8ld'HYEkS3P@J2%K6A#)%GN#0-'eccfrFeaYkU!Y3[fM!f1b6d`Tf31QLf`R8cJ l,M""[Cia%i"XVmmk0"9QDTqBjYN@P!!-V$Tj(%&J6`%B94+qA`rlc441hmE)r0M C(-EI[VebE-FYAb*1dlr+#(3L`aepL"'-j6("#-EbQ%$bIANF42*D([B!*,F[D)) $GE8jD),94M[-#'Tj6$##J63HCJ4MH4c5"-Z*H(Q-bN`k$ddF4QBAR$c-pSf93a, E-a-PpZCK"G$b1"D"ZE2L`Klqm4@E)F6AHI61f`VkjE0ZIQNM$hN&B%@Le5Q,&+l Kq6GDG"E9'!qqd6+Fai'TPjVUE#'BHMRkPSR(G!kqC6,F(rB!9Il"0cmUpAMScBr KZKj3V`rd2@ILVBlKHTJm$Vka-C,($hC(YTFGmrlRaV$EBlPr[AaUFlCi8krA[U' F$3TL*prq+bZJ%$[j%iqXmB2Bb6H[L!JfNf0@ZJk1(@DeQ5Zq[L+ja2qr&FNPrSp @*2IDQ+Qmr)QabC,eTEQM5)0QCAJE$040[kl@R*LmVR,Ga+lCAIafe@Zcej@V0!" [TNiUGPFr"[A-fIh@rJ)+eTKMaGX9H9TTh8l!hUk&eVQGJ0hGXZec1`&lZf9EjhB #RP*DYm[T9)F,cN+5(G9Y*@p-XRqhl$3Zf0fBC,KEYX-MpHbA$@k)`CpVQI4r#)D G`kfa@l9e&FUVYD8"l(0EY@Q#@&qXDY(Bl(rY+45faMAl,E#+9RaLkYC$lH@`ddU 6TEQCCpqRrYrMlY*pBAeUNS`ll,r6rMI%q8YZq(rHNq2HIFX6!Bm9YbdqG2J+[BH Qp+61Q4LH-pbhl#aqRc[FCfamIcJGChar1"eRI(mi(@GmIcJGChar1"eRI(mi(@G mIcJGChar1"eRI(mi(@GmIcJGChar1"eRI(mi(@GmIcJGChar1"f(IGm'pp),F-8 HXZrES`'X[H"i&-`+XrT@RAj-(b6+B*V"0R0ipUh(,h&jhYBj&VRe!9I&V2Lf)r, c-)P,hAB*e+YeR$b6GbU-(IA'@3)),0r6Z'A(FQ9LkYqRlle(ML-MEcVd5"P!5FM (-fiD16'bHG2G6dC3KCCU@2kBZ$4q(ZdP,"'S%G)1`hFXmZI4l`3IXXBZ#b8leYP D'X"C&ZUTBCl0YU0bZDfKmXF5--CSK4R6XqLG%`C3qHJa3E81erqb[4a$#6eH@,p [Gp+21k`)8BjQRL,K@6hpbMXEJhh[e&apHL,Z4b8!'d9B3`p[UTQ&!DITK8,cF[R fl21l4r%1j0Uj1pcMTBTRKba`Cqe-II,Pp4KaI'H3!&FQMr@L*2h23DT9l+p"@,h (aRE[[m*E`Xk0qqUcT@aYRcR4%4d4GQ!@pMG!Z#E2Hq0MBhS*ZbhVae8f`'lRBIC YrADHM5eePXGZVYimaN[XHmEmAMK@5Y)!eTMhS1hclpekCama5+l-cIJdUXUS!Xp i+3$cLT+pIQM##R"Nqp9*dmhTABh*kZ5K,iSMCZ9(ma+ZrT(rrZGhlEF2l0Y2(p4 1ZVFSP2IeBTSkrVLBTSk4rbQQ[HC4m)3hHKPGJ#$'GM(&"@2J%L'IX#FFYCUeAHl aFY['B5A[$[k0XXMbjkq3!%%VD4k3!,%ld6eBPekNJ5BjVq4qe9SNrG1jNJEEqlc kE"S-U0q,pE&VDGc(rCVe50BD*Q4T39,0rUB@l'p(Ib'-[l"HNS@5r6dD6ALUhFk SM*ih29-IM$[T@DGPYAk@*ph+rZ!04j1dNcd9i,bf9U66Lq$e,Clcl[CCK,Q[-K2 NH4J[R!Y`)CY40MEmAZpTpr2lBG6K5CQqP"AlmYiX)XrLJ5Z$q'RR&@'QGiakjV9 qC5Q#22TGmZe+Nk@JRCpV#V-pRlIAjB$rCMq0RkkUQ51lq#Qr93FUc9iHGKR%+@6 &Zdb0cAlHkjmVLA'Z&-aiApTibY&I9eUhm-iJHLU%V2KAVEB%U*DEap8VEBVc5*[ kEl1AI29+U!11JqhJ,!ml@(#p00a3YFfQJN2q,$pC+EDr'@A*ekfBr$F@k,JQc-l 880G["*J*8!9Q[)H"Q3"$`)al&CMaVJ#ckecYH$G#X8eFhe*MQkBB!ZDdIaQTM(m "Q2'V!M2H&@$fR#X&+`%cMU2!6)KKB2B$9-YG!@EAHD40"i(CpFd$XqFif!j9B-D l#Xail`9Qr#[!l$S2PM)!CXGj2a$AS(Jr')r"F3f3!%FKq3!SMm$b+$$[JqCpi&b &jaT!Mm2TIN$G$kQMS(S!9NH!G3KD4m'e"UmeJ"dP1M@U-d4fpS(h+(b2!2L$%-j !rhiB0f&'SGc%f!IR*N`0dNf3!&&B0c&'S0d,-BSkATa+'hN4DUe8JhSrbK#51P% ')GpiMm+qLA%!qNfJII!IK+N9ES3'H#%1018`(I!LP#P"fRfNCdHTJBNa5Jp-M$% J0e&'`0`,-9,drD!q3PM5)3kNSBP,jM@3!%(Q8)i5%SGbL"a[+%I*d)CbM*!!03b %F*DF0IdqN!#S@D0h+%$!1kS43S5VKT&HV`C`Hh5J#61FBfm3$lN(JML-Sq`F%Sj bL!"cKL+-P(-%FIST66P1MY%-4aPYLi$29#2XEhDIc93$3'D'[)Gl*k3bj4!KNbQ (b"+CFT!!J-G8)`aA1j6p(Cr'p8KjIP'1%[+,FSJF[bK(bI#,FSb3!&q83`6NS"S Ka)YU'1QJDS$4$XU3!)1p36`8(!MLN!#$XR0)$XSK!R)`&''NR#ij+([hNi0bR"` j')ibfKB"1DK'f0rX2MQS"S!F$(N2pdj)$XSK3R*3$T%P"q8J!6QS4KLZpMjbB," JM4m[p2f&i)Xa9J6crB@&)+di!M#)qpfYmfhKVJ8p8JmUGX'aGJ!1DSrKK-$YP9% b$lc8B"1[L9"HX6IdBb)0pS6T'ph!2AlF83m1ah%JGC3h8IRq'ZRYLSSDNHZAB@h LP1GTiTGPCZ+9i@,LP'rjR*rA(H)BdMAI*i2C[Q1Pe!&Imedmf(!l)X[*3VFdhA$ GK(HjRC!!aLVa+24ci*P'b-!VepH"Vd[5!TpF$I13!#Kq"3SQRL&4mRe+E9C'2Gm jffBH0`VXfG*Nq)miC4L2118iMVL&V-Ehk3GphlP5aB!"q5j"eI4+(bAia#m2RcJ 9i41rI[M%+`qI1"AK-r3,i"2(((bk2[QqGKe,(H%kqahKZZ3lSKmqdfiKI"Uh0(b D6JMK%imbI(UH)AakAJAip(apq24mFM8X`LGqCIM%-`HIVNqTc5V`k6TRfbb!6mq H,8dH2R(+`bG1"IM%,3HIVNm*2PhR5K@cm1Qk"&A6Zhf9i"1r2(cL9)42r2VK%km mI1*8K-r3,i"2((2`kIVNqpTe,(@%kqahK1Z5liKqq%blKI"Th0,`D6SKK%mmb[$ THBE`kAN9i02cpH(6mmR9X!LIq*AK%mmFI,SqT6DV`+IVR'fc!$ipHlBdHIM%+3q I1"AJ%lFFI,Sq*IKdR5Y9c-+Rkq*AMEI6L["Tr(,`DC`+m'Rmm["T[(,`DC`+m*R amq(61'EKdr2*pEAR@1`)ccRG%Cj,[L2bm1Ql"I$TZ(R`kA4#!*r'S`5IDFm!2Y0 HrI#CpNh$CpSR9m-#I"Ur%R`DcbamHMkP0KZ%6mmjffBqI+EYfG,Ni0-ijH$612A $Th(,`UIR8i42clP5a3amHLjqe4C4X8%)pAac-1Sj&U$8mmh$UHHCJe62X3#VrEi qY(V1@AJ0rA+p(cSA1bF-N!$ZRY#Ye%&jb-fk"V#EG[@J0pdj!IakAL8)cRJ(-*c al)ILM(mDMM0qa6SAB0Rc,8'cjjf&jp#[dUD$-"d'+,5T$pFCRd,CFV$Y1HDJfh2 XKfr203[KS9m4aX-!`jA1`(RS&[$iVZ*4dC+Q*+jj@8RmLXU5Z2D,5q+BejI%VbJ aj9`$P8PmFd+6ljBA3AcINS,JqrXLJZp9l*Tqh5Rd$+8Rec1Y2VRG%JT3iP6@S!, R8)B+(!Y+91$ZLe'"@k'm48P+A-ZUP$MRK#RIEE!Y+r+8lprIPS&)&EMdebX[9BP IAUd5[i*J*CijcFTh+mP@[[rH!QI&+pmVU#D!S0FN+D+eZ1E4@[b+D#fZr@JYMRQ d&VmL@ZGF!l3@haaDqfjj@2"p5ehMqrYGihX9ZkBIV822%+eGcc4DZpd5SV8iPG% kF!l41R!XS(AJlU0ei&BSEa'YaE@-eZ+F3f[IEE!Y+fMYqrHhCB$@J8Yr[I*S,Aj jY"Dr!PU,C`kYIEF5@[[qH`ZF4@[I+cHKY6(TTfdfQYNG"1Y8,1mR@jY@(3I'2Sa [FI6$1!k-IaMIdJL)m5b1J4M(`C'2M(0Q6X6i&NC#2,rL[),R2+MfH`%bLVrRPTe 9F$US0#ELZqC'44cAF&c%Z&4Q-SahB5l$mk[8HZpmKKHJ81[XR%EDTe$riVb'F3a ae5jq'YJaBP+aMF5aE"%dUGLib3D(#ZE`$MQ,8jVYNTbYL5eaam8&rAZ-`i9P,*p KJ`-((aHQ'5ld,HqSEKpI#1)J$G[PE3MKii+M,lLid11AZ'&#&KFQVq$#eUJ-MM$ iZ0$`*#lBhJL$M`Y6eRRN,4TEYX6K`P5(#miH6"h9E59[60,(KG4CA,#l-8NI&qT CZdH00fDQaVfM3EUFmF5RRXqq-Y@)YJabETaL8R)l5mJbqlLYXMI`1d&D8SBGrV` 6bl9TA(!'lfrXpC)d,h-6'(aFL"@iB(&$JXcaF3%HQCT1H09MliNe'Ud5J1PjR@e NG[,3E2A,Lq`lfccX$PLGQCFIHXmQcYkJ*SpE,q3KHd08%L%2jrd5jqQ"dMR4,89 kj$b&@lpiDJ&Bi*mmPMI[AAiZcYUjLJSl('0jP'AP!(QXANV[UR)r8YGMLPbA6j3 $p-H'Q31eFS!m$-*FYAJ"BI4baleJc%9"e2Y5$*2(eHhcHDcdZi&HeH#&pTZ#9*Z 'KXG$cQ[blSXJB[*J4HfMI@mC32+H&q!MABp4MU,I!MQBKa@!@@bTYcE@QUhe'Af r*HcYH6%2MYilR$8[Ih,!aGeCHJ(-*[,JY,8MAS`j8PH6ahAq#qc8["0!(VH&cq$ iSASidT[rHNrZ0*C2--UeMDRGcmA4SR*M[5XeNG)19,jVDJ1Ta[1`"M$"GE[hI3@ "ZqBfkY%eP6bePHCreF05`8a(X9`MR[0m9+8lh$aDYTB&j$&5N!!(mKJ'mKrN8@- %"r2BIZa#3IBIfi#5F+6[8@`X!`V!D(ISHXKq*p9'Fr,3VlTC![,BHVj$D[f4VZ[ @a@H4mB%mGTeRll@kHRRB!a552F5#H@3'8&[Z%XV&R-GVJLrTCZc(HZ5I[P`6 N`@QM54kTDpG+(NHEa1J0k4F'bd%QP8mS**B66GNH`1#X%YUVA3(*$a`(mIaA,R0 R9ZQ(*UK,1e$j`jTJ03qlbA6))3fZdKd2DA"MH8aSF'0j6'K`qr)iU-(9mV"hD(! $GE8jD($94MZX`GAbQ0$J"Y*i@)-Ebq13!!CA6X4'S-'0a(#H40kIKhkM+,,PT#E (cf$HU(AdPYII1iTG(Am0%Ck`cF2HcA[CXDehAXSSk+8icC!![hl,CY1@6pacq5! 2+`"c[kc@h1#,a2"8Vi'HYAjSJK9JI%J6('*%YJ"0F1dcNSDFifT6"fGHl#!BNhe L5XNH-&eN1jR#fA'"#HV(j*N!((bJh@0-pSPTRQe"#F$!UT2(%36f&)"4*H(lpE$ I61(dEBc-Mafpcd2RpXVUNJfj-rfVM%!R-Yc4KaM"@"i6M'!XM`NNhjI(355[j@% 23(,lJLBi8&HEJbCBEE6$M+#@a`3M'%MMB8B`PXFK6E#FL*I(U-bNmc#,J)cKd'i fkaJk*,%p-e&LEaj@!#f2Ba'B1p-2CHk0ibXf3iL[mqLGAhSfMhAc5aYjb#X!l+0 5TR!0clr4SV1SaRM`MCEK2!j-[G48C`["e-[4Yd`mTR2`,C2KrV!(U2)2[[P4UFG $Ehi-er@!HRfJlcN6Eh8-em2NFI#0MC%me2%$RVI$kfEjQDkGrKDHE2TCr,,3d[) 5clY%IM[2*0,-6c0qeclTed%H$CCIl'p2qjf0RmP$jaIia422ff6j"AkV0q(lf@j H61Aal*DE0m6QkIM48B(Ihr,6f-fc-r&d'PkGJ[`Zq5#qVGeHGXC[dcGkhX96hAc K6*h8(`NkGGl8fmq[lU1#RTimSSk"hq@(bHrFeK4l[8Iqi&%FCMQrDGUlSkfASTk Sr6q1EC(jkAMaHZ%AhI3HaC!!rS!2a9fmcrm$YRD,Yi5I*ZIhT9hBj)QkD3IjQH6 m2U9H1F[j(Ip,r0cPr,l`2GJHChe2h0A1lqZU)D-VqY6rrZNka6kLaK#rE`hUT'k r#!HQ@[5CUMbP6YYr$YYQjaHlMjq8Uq[p[i[YQHEh#RiDR0ql&&Z)EdcpkrKG%[` 0YPmc[pF0mV[N0d5NhQMeZ*1I-jhIIGq#l8d@laCqTMLr5I*lXrNp9rASJ@YPF#Z kPjqlZrlC+G$SAr&cDT&(`rh[`rCZjrFNDRc+0ZIhREYaS&rdHHP[J`R6#lmTelm ,KrFi[rXfHpk0$jNIIINAcLrj5@!MkI*iRAVT[Fl[TMqQ9SdZh[)(F(LImhX2q5@ ZG(jRAiE$qke1he%c1hjE`,E)(eUp*`h`S1'A[aRE"me[qU$2'Ylp8pM!0rcJB91 Gh`[8Zf#A2L[rQMV91ErRAih$KbdH1(@fbhZQHNAAcILpIT!!aj4VEX6f8HIh!I* 4(h4j[1Zc1(c-qGfQHLpem8bXMcZrfm(,K-12+F'RFIL%mp[i-(P)(j`KcH@6cZm 1HL,@FRil2Sl$T`a(&iLF1(Pr@rhkDHIh2,#`cX9Vq-!q($lMr1i%4f*AZ6aQI!L (ceTGhmV295lH-d3!2fIjR6$S[iC2UIqim30VRIkEFPKjIplk(KbArVYAZ%[[d$, R#%ZFH#Gp$0XAR0q(IT&kRqcL[9-ed[eSmJ!lhq$mhL(GK9S"FI5@Jpp6QQ"-42b )GYBB((9j6fPp')F[1Vm,IiHIfFk[8lA!&crL5PhIIKdf-"QrE`p`FFS9`Vi['8j -29hAqm8j[Zcm9QdIm)q'6li6fpml[flKPm-r'Kjk'lD[1,V9SjkqUjZGj9Y4m8k AjfPZkTj[A3Y14)`[qRiVVa'h%,lSqp9,*h$jA"$[ARj@'*m,iS&K6Ve69k'%U6F k[iq!TkIY,Ib5I6"$IErcqjTiT0-hb6q&!kTlR0phUC2`J162JlA+m5&e,6JP2#$ jCh!qjIL3!2T@HP&i3'SRFecU"jhIA2Sll[![Y38ZU0jXGB*$50lEIa5r1m`2pFl "S93&j9A"aidIBUE6VmQhJ+&+r)MqT[B1ILFr#Fp62qcbAXM8S[#!j(["3[9@LhI FJ!HN@Q#PqK(cJqXiHD5ZJ(-SpEMqE5'Hm)$8GM"E[GhjA3$(%Kk3!(`F,&68%,q ,RKM`J16lEm-"hUGrerlMJ!HN$X*6P6L,rPd(CJJ25$i"ae!rj[`f%&Yi31U@cq$ `8[26I5)m)(N#,&3RR0pPm!hK!DNEb%RGlqUkrZ)"$dJqJ1+La1@Tpj02ppq(e'F [YckMRjhq5ri3R&$pT-9$Kj(qfk1miFAkE2Le!3p)0DQG%JI8[keS!-)$NL'F9BQ lkA1VG!L("b52)qZTGeKqi)l$!e)AB9-rlI*SSlq&"k4Hb55(%ZlThb[&k4dHN!# m"qe6#D[a!rZGZUBmpH9Vc!rqiH"LmP'iXISCmd-[N!$meX&Ae-qD(j+M``05Yrd G$QJ&q-(9("k3!*T"X9B21Vr&b*A#Gq2[JX-Vaj[9Um"1eqqV`PIKcHXIiZIiER* @PeS[IjFhd,YblS'AHlc"peX[(Z,b"Yp[Jel[FAP$i(Fc2ki1P2C6ipY1eqR,F"T P22iLm5@REa+ld6L8ir(U9p(RK%mN)PjZ8)l(UpFKE`UI5,aAA-(KmHT4qPEi41* U--$S92VhFRLAm)P%$*G6MXHV1m%2i3f*"m9A("k[jY&pK'I%2dBYPI(iLcihk2[ iip4F'Bqr8(U+JfH*pk((+12aUm3$R,j2["01V)c(Vj)'ir#!421Em(0i[!UqGm! R%[F*9i6(Va+RG2K%r&2dLM)H[elDMj0(r2G1iZI`H(@A-0MK%r&2df2+H2`hK9X 16LHfSZFTir(VM`cUQVKc'MrKmH[&3jbkaRm6M8`CMem[[*DkRLfmG(Lm@T4HjZ" diMkd219i[!V&&4bF6Y`"4LV(ip@5Y"-(Ta2[KV-Tir%ET3di1"hrLqr'cq(aDZR p!jb1IaC1B(41H2rA9#HYDk)*Hrcir`%!!#%K!h"[G`#3(JQ'!DJ!``+#!PF!N!- "!*!$KJ#3"aB!N!1'!!!"$[q3"!2JY&mZ),5@8hX!N!8#"Li!N!Bl%Irarr`!!-0 !!!#HBhBZ!!!: fv5.5/tcltk/pow/pow.tcl0000644000220700000360000131551413224715130013764 0ustar birbylheaproc printStack {} { set level [info level] for {set i 1} {$i < $level} {incr i} { puts "Level $i: [info level $i]" } } proc powInitGlobals {} { #puts "powInitGlobals start" ############################## # This routine sets up various global variables which should be initialized # when POW is loaded... Some are used before the TCL routine powInit # is called... eg, in powSetupColormap. Putting it here instead of in # the C initialization routine, PowInit, makes it easily updated/modified # by developers (and us). PowInit must call this routine. ############################## global powMinColorcells global powPseudoImages global powbg global powFrameForTop global yellowLineWidth global powWCS global regionParam xRangeParam global powLutButton powROIButton global POWRC tcl_platform env global isMac global powIsDragging global powOrderedGraphList global localPowObject global searchPath global powOutputPaperSize global powConvertFunction global powSelectDirectory global powPrintFunction global powPaperSizeSelected global tixOption global g_titleFont global powRegionListGlobal global powNotifications global ghostScript global g_backupDir ############################## # Notifications sent by POW: # on graph creation/redraw: graphHasFinishedDrawing # on graph destruction: graphHasBeenDestroyed # on graph deselection: graphHasBeenUnselected # on graph selection: graphHasBeenSelected # on image selection: imageHasBeenSelected # on graph resize: graphHasResized # on graph moved: graphHasMoved dx dy if {($tcl_platform(platform) ne "windows") && ($tcl_platform(os) ne "Windows NT")} { package require Tix tix configure -fontset 14Point } set ghostScript "gs" if { $tcl_platform(platform)=="windows" } { set ghostScript "gswin32c" } set errorFlag [ catch { exec $ghostScript -help } result ] set searchPath [determineSearchPath $result] if { [string first "Available devices:" $result] < 0 } { set ghostScript "" } if ![info exists g_backupDir] { set g_backupDir $::env(HOME) } set powOutputPaperSize [list Letter 8.0i 10.5i 672.4 985.6 612 792 \ A4 7.76389i 11.1944i 652.6 1050.8 595 842 ] # A5 5.34722i 7.76389i 449.43 728.8 420 595 # Legal 8.0i 13.5i 672.4 1267.2 612 1008 # 11x17 10.5i 16.5i 882.53 1548.8 792 1224 # Ledger 16.5i 10.5i 1386.82 985.86 1224 792 set powConvertFunction [list {bmp bmp256 bmp "Windows Bitmap"} \ {jpeg jpeg jpg "JPEG File"} \ {postscript pswrite ps "Postscript Files"} \ {pbm pbm pbm "Portable Bitmap File"} \ {ppm ppm ppm "Portable Pixmap File"} \ {png png256 png "Portable Network Graphics"} \ {pnm pnm pnm "Portable any Map File"} \ {ppm ppm ppm "Portable Pix Map File"} \ {tiff tiff24nc tiff "Tagged Image File Format"}] set powSelectDirectory [pwd] set powPaperSizeSelected Letter set powRegionListGlobal {} set powPrintFunction "lpr" if { $tcl_platform(platform)=="windows" } { set powPrintFunction "winPrint" } set powNotifications [gNotifications] # ############################## # Identify if on a Mac if { $tcl_platform(platform)=="macintosh" } { set isMac 1 } else { set isMac 0 } # Try to grab 128 colorcells to hold POW's colormaps set powMinColorcells 128 # Use pseudocolor images by default set powPseudoImages 1 # Also need this so powToplevel can get going in safe mode if { $isMac } { # Set default background to a more "Platinum" appearance set powbg "#eeeeee" } else { set powbg "#cccccc" } # By default, assume we're not running safe (need to make a powSafeInit # entry point to do this eventually set powFrameForTop 0 # How wide should the yellow line around the selected graph be? set yellowLineWidth 3 # Initialize a couple of region handling globals set regionParam(nItems) 0 set regionParam(gn) "" set xRangeParam(nItems) 0 set xRangeParam(gn) "" # These two variables are here so developers can easily override them... # The first determines which mouse button "diddles" the image colortable, # the second drags out a Region Of Interest set powLutButton 3 set powROIButton 1 trace variable powWCS w powWCSCallback # Define location of the POW resource file switch $tcl_platform(platform) { "unix" { set POWRC "~/.powrc" } "windows" { set POWRC [file join $env(POW_LIBRARY) "pow.ini"] } "macintosh" { set POWRC [file join $env(PREF_FOLDER) "pow Preferences"] } } # Comment out powXPA init until future need for XPA powXPA::init set localPowObject [gPowCmdsClass] # This is just a state variable set powIsDragging 0 # This lists the graphs created, in order set powOrderedGraphList {} } ######################################################################## proc powSetGlobal_bg { val } { #puts "powSetGlobal_bg start" global powbg if { $val == "" } return set powbg $val powChangeBg } proc powSetGlobal_cursor { val } { #puts "powSetGlobal_cursor start" global powcursor global powGraphCoordsTracker set powcursor $val .pow configure -cursor $val .pow.pow configure -cursor $val .pow.scope configure -cursor $val } proc powSetGlobal_ResizeMain { val } { #puts "powSetGlobal_ResizeMain start" global powResizeMain set powResizeMain $val } proc powSetGlobal_GUIposition { val } { #puts "powSetGlobal_GUIposition start" global powGUIposition set powGUIposition $val powLayoutGUI powUpdateGeometry } proc powSetGlobal_ScopeSize { val } { #puts "proc powSetGlobal_ScopeSize start" eval powCmds::scope $val } ######################################################################## proc powGetVersion { } { #puts "powGetVersion start" set revisionString {$Revision$} regexp {Revision: ([0-9.]+)} $revisionString blob powVersion set powVersion "(Build $powVersion)" return $powVersion } proc powWCSCallback {array element op} { global powWCS if {$powWCS($element) == ""} return if {![catch {image type $element}]} { eval [concat powWCSInitImage $element $powWCS($element)]; } elseif { [lsearch -exact [powListCurves] $element]!=-1 } { eval [concat powWCSInitCurve $element $powWCS($element)]; } } proc powInit { {powXColormapWindow none} {powContainerPath none} {powgui 1}} { #puts "powInit start" #This procedure creates the .pow window and sets up all the bindings # powXColormapWindow - a Tk path specifying a window to use to find the # X colormap to use. # powContainer - what window to "use" to put POW in # powgui - Do you want the POW user GUI header (usually yes, unless you're embedding POW in some other application) global currgn currimg mag powLargeFont Private_Colormap env global cmap cmap_inv powResizeMain powcursor global powImageParam powCurveParam powMenuOption global powbg powScopeWidth powScopeHeight powPlotParam powFontParam global powMinHeight powMinWidth powMaxHeight powMaxWidth global powFirstTimeThroughFlag global powShowHandlesFlag global powTrackText global powGraphCoordsTracker powImagePixelTracker powImageValueTracker powPhysicalPixelTracker global powHelpTopics curr_img powFirstPixel global powSqueeze powSlide powPseudoImages powMinColorcells global Pow_Allocated powGUIposition global powScopeMargin powScopeSize powGridLines powShowScope powScopeGn global powGUI showlinks powContainer powFrameForTop powDWP global powLutButton powROIButton POWRC global tcl_platform global menuBarDeleteFlag global g_titleFont g_backupDir global g_magnification global prev_magnification global g_multiplier global g_showpow_flag global powFitsHeader powFitsHeaderCnt set powGUI $powgui set powContainer $powContainerPath if {($powXColormapWindow == "safe" || $powFrameForTop == 1) && \ $powContainer == "none"} { set powContainer "." } event add <> set powFirstTimeThroughFlag 1 set powShowHandlesFlag 1 # trace variable powPlotParam w debug_trace #set defaults for options if {$powXColormapWindow == "safe"} { #don't set up a colormap if we're running in a tclet set powFrameForTop 1 if {[winfo visual $powContainer] == "pseudocolor"} { # set powPseudoImages 1 # This seems to break the plugin, so for now set powPseudoImages 0 } else { set powPseudoImages 0 } powToplevel .pow safe } else { if {$powXColormapWindow == "none" || $powXColormapWindow == "NULL"} { if {$powContainer != "none" && $powContainer != "NULL"} { powSetupColormap .pow 0 [list -use [winfo id $powContainer]] } else { powSetupColormap .pow 0 } set powXColormapWindow .pow } else { set visual [winfo visual $powXColormapWindow] set depth [winfo depth $powXColormapWindow] if {![regexp -nocase "pseudocolor" $visual] || $depth != 8} { # This doesn't seem so bad # puts stderr "Visual of window $powXColormapWindow is $visual $depth." set powPseudoImages 0 } if {$powContainer != "none" && $powContainer != "NULL"} { powToplevel .pow $powXColormapWindow [list -use [winfo id $powContainer]] } else { powToplevel .pow $powXColormapWindow } } #Check that there's still enough colors for POW to function i.e. they haven't #filled up the Colormap since we set it up, this should only happen if #they're using the default colormap. if {$powPseudoImages} { set free_colors [powTestColormap $powXColormapWindow] if {(($Pow_Allocated != 0) && ($free_colors < 10)) || \ ($Pow_Allocated == 0) && ($free_colors < 60) } { puts stderr "Colormap full"; set powPseudoImages 0; } } } #Since a master window must be the parent of a slave window or the descendant #of the slaves parent, we can't use .pow.whatever for "popup" dialogs #DWP stands for DialogWindowPrefix if $powFrameForTop { set powDWP ".pow" } else { set powDWP ".pow." } if { [info exists g_showpow_flag] && $g_showpow_flag == "noshow" } { wm withdraw .pow } #powPseudoImages is set by powSetupColormap if {!$powPseudoImages} { # puts stderr "Pseudocolor images disabled; using Truecolor images." powSetupPhotoImages } # Huge lists of fonts can't be listed on screen, so just grab # some common ones. set allFonts [lsort [font families]] set powFontParam(allFonts,powDef) {} foreach fnt [list \ {[Aa]rial} \ {[Cc]ourier} \ {[Hh]elvet} \ {[Pp]alat} \ {[Tt]imes} \ {[Ss]ymbol} \ ] { set i [lsearch -regexp $allFonts "^${fnt}.*"] if { $i >= 0 } { lappend powFontParam(allFonts,powDef) [lindex $allFonts $i] } } set fnt {[Cc]ourier} set i [lsearch -regexp $powFontParam(allFonts,powDef) "^${fnt}.*"] if { $i < 0 } {set i 0} set fnt [lindex $powFontParam(allFonts,powDef) $i] set powFontParam(allTypes,powDef) [list title axis tick note] set powFontParam(allOpts,powDef) [list Font Size Weight Slant Color] foreach lbl $powFontParam(allTypes,powDef) { set powFontParam(${lbl}Font,powDef) $fnt set powFontParam(${lbl}Size,powDef) 12 set powFontParam(${lbl}Weight,powDef) normal set powFontParam(${lbl}Slant,powDef) roman set powFontParam(${lbl}Color,powDef) "#000000" } set powFontParam(titleSize,powDef) 16 set powImageParam(allOpts,powDef) [list colormap invert scale] set powImageParam(colormap,powDef) gray set powImageParam(invert,powDef) No set powImageParam(scale,powDef) log set powImageParam(allMaps,powDef) [list \ [list Continuous gray blkbdy hot cold spectrum inv_spec \ color1 color2 color3] \ [list Ramps gray-ramp2 gray-ramp4 bgr-ramp bgr-ramp2 \ rygcbm-ramp bowlerhat] \ [list Steps gray-step4 gray-step8 bgr-step bgr-step2 \ rygcbm-step tophat] \ ] set currgn "powDef" set powScopeGn "-" set powCurveParam(allOpts,powDef) \ [list pDisp pShape pSizeErr pSize pFill pColor \ lDisp lStyle lWidth lStep lBoxFill lColor \ logX logY LOD] foreach opt $powCurveParam(allOpts,powDef) \ val [list Yes Cross No 4 No #000000 \ No " " 1 No No #000000 \ No No 0] { set powCurveParam($opt,powDef) $val } set powCurveParam(allColors,powDef) \ [list Black #000000 Red #FF0000 Blue #0000FF Green #00FF00 \ Yellow #FFFF00 White #FFFFFF Purple #9900FF Orange #FF9900 \ Aqua #00FFFF Grey #999999 Fuchsia #FF00FF ] set screenHeight [winfo screenheight .] set powScopeWidth 150 set powScopeHeight 150 set powMinHeight 350 set powMinWidth 350 set powGUIposition top set powShowScope 1 set powcursor crosshair set powResizeMain 0 set showlinks 0 set powFirstPixel 1 set powPlotParam(allOpts,powDef) [list \ tickLabels xTickScal yTickScal xNumTicks yNumTicks \ xTickLength yTickLength xLabelTicks yLabelTicks \ tickFormatCmdX tickFormatCmdY \ GridLines GridColor GridDash \ xdimdisp ydimdisp ] set powPlotParam(wcsName,powDef) "WCS" set powPlotParam(tickLabels,powDef) "degrees" set powPlotParam(tickFormatCmdX,powDef) "format %.6lg" set powPlotParam(tickFormatCmdY,powDef) "format %.6lg" set powPlotParam(xTickScal,powDef) "linear" set powPlotParam(yTickScal,powDef) "linear" set powPlotParam(xNumTicks,powDef) 3 set powPlotParam(yNumTicks,powDef) 3 set powPlotParam(GridLines,powDef) No set powPlotParam(GridColor,powDef) "#FFFFFF" set powPlotParam(GridDash,powDef) " " set powPlotParam(xdimdisp,powDef) 350 set powPlotParam(ydimdisp,powDef) 350 # order is [lft rgt top bot] set powPlotParam(xTickLength,powDef) [list 10 10 10 10] set powPlotParam(yTickLength,powDef) [list 10 10 10 10] set powPlotParam(xLabelTicks,powDef) [list Yes No No Yes] set powPlotParam(yLabelTicks,powDef) [list Yes No No Yes] # Initialize other powDef variables to simplify creating new graphs set powPlotParam(curves,powDef) NULL set powPlotParam(images,powDef) NULL set powPlotParam(xunits,powDef) NULL set powPlotParam(yunits,powDef) NULL set powPlotParam(xlabel,powDef) X set powPlotParam(ylabel,powDef) Y set powPlotParam(xBot,powDef) NULL set powPlotParam(yBot,powDef) NULL set powPlotParam(xTop,powDef) NULL set powPlotParam(yTop,powDef) NULL set powPlotParam(flipD,powDef) "U" set g_magnification 1.0 set prev_magnification 1.0 set g_multiplier 4.0 #read user's option file if present catch {if [file readable $POWRC] { source $POWRC } } # test for obsolete variable powCurvetype if { [info exists powCurvetype] } { if { [string first Points $powCurvetype]==-1 } { set powCurveParam(pDisp,powDef) No } else { set powCurveParam(pDisp,powDef) Yes } if { [string first Line $powCurvetype]==-1 } { set powCurveParam(lDisp,powDef) No } else { set powCurveParam(lDisp,powDef) Yes } unset powCurvetype } # Convert old 1/0 booleans to Yes/No strings foreach opt [list pDisp pSizeErr pFill lDisp lStep] { if { $powCurveParam($opt,powDef) } { set powCurveParam($opt,powDef) Yes } else { set powCurveParam($opt,powDef) No } } set powSqueeze 0.0 set powSlide 0.0 # Convert old powNumTicks to powX/YNumTicks if { [info exists powNumTicks] } { set powPlotParam(xNumTicks,powDef) $powNumTicks set powPlotParam(yNumTicks,powDef) $powNumTicks } # Convert old pow* options to powPlotParam(...) if { [info exists powGrid] } { if { $powGrid } { set powPlotParam(GridLines,powDef) Yes } else { set powPlotParam(GridLines,powDef) No } set powGridLines $powPlotParam(GridLines,powDef) } if { [info exists powGridColor] } { set powPlotParam(GridColor,powDef) $powGridColor } if { [info exists powGridDash] } { set powPlotParam(GridDash,powDef) $powGridDash } if { [info exists powSixties] } { if { $powSixties } { set powPlotParam(tickLabels,powDef) "degrees" } else { set powPlotParam(tickLabels,powDef) "decimal" } } set powMenuOption(tickScal) \ "$powPlotParam(xTickScal,powDef)-$powPlotParam(yTickScal,powDef)" # Convert text colors to hex... if { [info exists powCurveParam(Color,powDef)] } { set powCurveParam(lColor,powDef) $powCurveParam(Color,powDef) set powCurveParam(pColor,powDef) $powCurveParam(Color,powDef) unset powCurveParam(Color,powDef) } set powCurveParam(lColor,powDef) \ [powColorToHex $powCurveParam(lColor,powDef)] set powCurveParam(pColor,powDef) \ [powColorToHex $powCurveParam(pColor,powDef)] set powPlotParam(GridColor,powDef) \ [powColorToHex $powPlotParam(GridColor,powDef)] # Calculate Scopebox margin/size from current Width/Height values set powScopeSize [list $powScopeWidth $powScopeHeight] if { !($powScopeWidth && $powScopeHeight) } { set powScopeWidth 10 set powScopeHeight 10 set powShowScope 0 } else { set powShowScope 1 } set powScopeMargin [expr ($powScopeWidth+$powScopeHeight)/20] set Private_Colormap 4 if {!$powPseudoImages} { # powSetColorTable } .pow configure -bg $powbg catch {wm title .pow "POW [powGetVersion]"} catch {wm geometry .pow +0+240} if $powGUI { ############################################################## # Start Menus ############################################################## global isMac event add <> event add <> event add <> event add <> event add <> bind .pow <> "powEvents::postMenus %W" bind .pow <> "powSave" bind .pow <> "powPrintBox" bind .pow <> "powScopeZoom in yes 2.0" bind .pow <> "powScopeZoom out yes 2.0" bind .pow <> "powScopeZoom reset yes" .pow config -menu .pow.mbar menu .pow.mbar -postcommand "powEvents::generate <>" -bg $powbg -font g_titleFont if { $isMac } { set cmdkey "Cmd" set bdVal 0 .pow.mbar add cascade -menu .pow.mbar.apple .pow.mbar add cascade -menu .pow.mbar.file -label "File" -font g_titleFont .pow.mbar add cascade -menu .pow.mbar.edit -label "Edit" -font g_titleFont .pow.mbar add cascade -menu .pow.mbar.colors -label "Colors" -font g_titleFont .pow.mbar add cascade -menu .pow.mbar.tools -label "Tools" -font g_titleFont .pow.mbar add cascade -menu .pow.mbar.zoom -label "Zoom" -font g_titleFont .pow.mbar add cascade -menu .pow.mbar.help -label "Help" -font g_titleFont menu .pow.mbar.apple -tearoff False .pow.mbar.apple add command -label "About POW" \ -command {powHelp About.html} -font g_titleFont } else { set cmdkey "Alt" set bdVal 2 .pow.mbar add cascade -menu .pow.mbar.file -label "File" -font g_titleFont .pow.mbar add cascade -menu .pow.mbar.edit -label "Edit" -font g_titleFont .pow.mbar add cascade -menu .pow.mbar.colors -label "Colors" -font g_titleFont .pow.mbar add cascade -menu .pow.mbar.tools -label "Tools" -font g_titleFont .pow.mbar add cascade -menu .pow.mbar.zoom -label "Zoom" -font g_titleFont } # # FILE # set ::env(PSTMPDIR) $g_backupDir menu .pow.mbar.file -bg $powbg -bd $bdVal \ -postcommand "powEvents::generate <>" -font g_titleFont # .pow.mbar.file add command -label "Page Setup..." \ -command {powSetupPage} -font g_titleFont .pow.mbar.file add command -label "Print..." \ -command {powPrintPreview} -font g_titleFont # .pow.mbar.file add command -label "Print..." \ -command "powPrintBox" \ -accelerator "$cmdkey+P" -font g_titleFont .pow.mbar.file add separator .pow.mbar.file add command -label "Close" \ -command "::powEvents::ExitPOW" \ -accelerator "$cmdkey+W" -font g_titleFont # # COLORS # menu .pow.mbar.colors -bg $powbg -bd $bdVal \ -postcommand "powEvents::generate <>" -font g_titleFont foreach colorGrp $powImageParam(allMaps,powDef) { set cName [lindex $colorGrp 0] menu .pow.mbar.colors.c$cName -bg $powbg -bd $bdVal .pow.mbar.colors add cascade -menu .pow.mbar.colors.c$cName \ -label "$cName" -font g_titleFont foreach color [lrange $colorGrp 1 end] { .pow.mbar.colors.c$cName add radiobutton -label $color \ -value $color \ -variable powImageParam(colormap,powDef) \ -command "powCmds::colormap $color" -font g_titleFont } } .pow.mbar.colors add separator .pow.mbar.colors add checkbutton -label "Invert Colortable" \ -variable powImageParam(invert,powDef) \ -onvalue Yes -offvalue No \ -command {powCmds::colormap invert $powImageParam(invert${currimg},$currgn)} -font g_titleFont .pow.mbar.colors add separator .pow.mbar.colors add radiobutton -label "linear" -value linear \ -variable powImageParam(scale,powDef) \ -command "powCmds::colormap scale linear" -font g_titleFont .pow.mbar.colors add radiobutton -label "square root" -value sqrt \ -variable powImageParam(scale,powDef) \ -command "powCmds::colormap scale sqrt" -font g_titleFont .pow.mbar.colors add radiobutton -label "logarithmic" -value log \ -variable powImageParam(scale,powDef) \ -command "powCmds::colormap scale log" -font g_titleFont .pow.mbar.colors add radiobutton -label "Histo Equalize" -value histo \ -variable powImageParam(scale,powDef) \ -command "powCmds::colormap scale histo" -font g_titleFont .pow.mbar.colors add command -label "Rescale Image..." \ -command {powRescaleBox} -font g_titleFont .pow.mbar.colors add separator .pow.mbar.colors add command -label "Create Colorbar" \ -command {powColorbar} -font g_titleFont # # EDIT # menu .pow.mbar.edit -bg $powbg -bd $bdVal \ -postcommand "powEvents::generate <>" -font g_titleFont if { $isMac } { .pow.mbar.edit add command -label "Can't Undo" -state disabled -font g_titleFont .pow.mbar.edit add separator } .pow.mbar.edit add command -label "Edit Graph..." \ -command {powEditGraphDlg $currgn} -font g_titleFont .pow.mbar.edit add command -label "Add Text Label..." \ -command {powEditNoteDlg $currgn -1} -font g_titleFont .pow.mbar.edit add command -label "Choose Graph Size..." \ -command powSetGraphSize -font g_titleFont .pow.mbar.edit add separator .pow.mbar.edit add command -label "Duplicate Graph" \ -command {powEditCreateNewGraph $currgn} -font g_titleFont .pow.mbar.edit add command -label "Delete Graph" \ -command {powDeleteGraph $currgn} -font g_titleFont menu .pow.mbar.edit.merge -bg $powbg -bd $bdVal \ -postcommand {powGenerateMergeCascade} -font g_titleFont .pow.mbar.edit add cascade -label "Merge Graphs" \ -menu .pow.mbar.edit.merge -font g_titleFont menu .pow.mbar.edit.unmap -bg $powbg -bd $bdVal \ -postcommand {powGenerateUnmapCascade} -font g_titleFont .pow.mbar.edit add cascade -label "Hide Graph" \ -menu .pow.mbar.edit.unmap -font g_titleFont menu .pow.mbar.edit.replot -bg $powbg -bd $bdVal \ -postcommand {powGenerateReplotCascade} -font g_titleFont .pow.mbar.edit add cascade -label "Replot Graph" \ -menu .pow.mbar.edit.replot -font g_titleFont .pow.mbar.edit add separator menu .pow.mbar.edit.log -bg $powbg -bd $bdVal .pow.mbar.edit add cascade -label "Axes Transforms" \ -menu .pow.mbar.edit.log -font g_titleFont .pow.mbar.edit.log add radiobutton -label "Linear-Linear" \ -variable powMenuOption(tickScal) -value "linear-linear" \ -command { powCmds::axes linear linear } -font g_titleFont .pow.mbar.edit.log add radiobutton -label "Linear-Log" \ -variable powMenuOption(tickScal) -value "linear-log" \ -command { powCmds::axes linear log } -font g_titleFont .pow.mbar.edit.log add radiobutton -label "Log-Linear" \ -variable powMenuOption(tickScal) -value "log-linear" \ -command { powCmds::axes log linear } -font g_titleFont .pow.mbar.edit.log add radiobutton -label "Log-Log" \ -variable powMenuOption(tickScal) -value "log-log" \ -command { powCmds::axes log log } -font g_titleFont # Tick Label format menu .pow.mbar.edit.tlabels -bg $powbg -bd $bdVal .pow.mbar.edit add cascade -label "Tick Labels" \ -menu .pow.mbar.edit.tlabels -font g_titleFont .pow.mbar.edit.tlabels add radiobutton -label "Decimal" \ -variable powPlotParam(tickLabels,$currgn) -value "decimal" \ -command { powAdornGraph $currgn .pow.pow; powRedrawGraphHandles $currgn } -font g_titleFont .pow.mbar.edit.tlabels add radiobutton -label "Base 60 (deg)" \ -variable powPlotParam(tickLabels,$currgn) -value "degrees" \ -command { powAdornGraph $currgn .pow.pow powRedrawGraphHandles $currgn } -font g_titleFont # Grid Line Options menu .pow.mbar.edit.grid -bg $powbg -bd $bdVal .pow.mbar.edit add cascade -label "Grid Line Options" \ -menu .pow.mbar.edit.grid -font g_titleFont .pow.mbar.edit.grid add checkbutton -label "Show Grid Lines" \ -variable powPlotParam(GridLines,$currgn) \ -onvalue Yes -offvalue No \ -command {powChangeGrid 1} -font g_titleFont .pow.mbar.edit.grid add separator foreach {clr hex} [list White #FFFFFF Black #000000 \ Blue #0000FF Red #FF0000] { .pow.mbar.edit.grid add radiobutton -label $clr \ -variable powPlotParam(GridColor,$currgn) -value $hex \ -command {powChangeGrid 0} -font g_titleFont } .pow.mbar.edit.grid add separator foreach [list opt val] \ [list Solid " " "Small Dash" 10 "Large Dash" 20] { .pow.mbar.edit.grid add radiobutton -label $opt \ -variable powPlotParam(GridDash,$currgn) -value $val \ -command {powChangeGrid 0} -font g_titleFont } .pow.mbar.edit.grid add separator .pow.mbar.edit.grid add command -label "Fewer Lines" \ -command { if {$powPlotParam(xNumTicks,$currgn)>0} { incr powPlotParam(xNumTicks,$currgn) -1 } if {$powPlotParam(yNumTicks,$currgn)>0} { incr powPlotParam(yNumTicks,$currgn) -1 } powChangeGrid 1 } -font g_titleFont .pow.mbar.edit.grid add command -label "More Lines" \ -command { incr powPlotParam(xNumTicks,$currgn) incr powPlotParam(yNumTicks,$currgn) powChangeGrid 1 } -font g_titleFont menu .pow.mbar.edit.wcs -bg $powbg -bd $bdVal .pow.mbar.edit add cascade -label "WCS" \ -menu .pow.mbar.edit.wcs -font g_titleFont .pow.mbar.edit.wcs add radiobutton -label "WCS" \ -variable powPlotParam(wcsName,$currgn) -value WCS \ -command {powSwitch2NewWCSHeader} -font g_titleFont .pow.mbar.edit.wcs add separator set idx 3 foreach wcsName [list a b c d e f g h i j k l m n o p q r s t u v w x y z] { .pow.mbar.edit.wcs add radiobutton -label "WCS $wcsName" \ -variable powPlotParam(wcsName,$currgn) -value WCS$wcsName \ -command {powSwitch2NewWCSHeader} -font g_titleFont .pow.mbar.edit.wcs entryconfigure $idx -state disable incr idx } .pow.mbar.edit add separator .pow.mbar.edit add command -label "Preferences..." \ -command {powDefaultOptions} -font g_titleFont # Eliminate in favor of Preferences box with "Get Current" button # .pow.mbar.edit add separator # .pow.mbar.edit add command -label "Save Current Settings" \ # -command {powGetCurrVariables; powSaveConfig} # # TOOLS # menu .pow.mbar.tools -bg $powbg -bd $bdVal \ -postcommand "powEvents::generate <>" -font g_titleFont .pow.mbar.tools add command -label "Blink Graphs..." \ -command {powBlinkGraphDlg} -font g_titleFont .pow.mbar.tools add command -label "Blink Images..." \ -command {powMovie} -font g_titleFont .pow.mbar.tools add command -label "Region Files..." \ -command {powRegion} -font g_titleFont .pow.mbar.tools add command -label "Make Contour Map..." \ -command {powContour} -font g_titleFont .pow.mbar.tools add command -label "Draw Profile..." \ -command {ProfileDlg} -font g_titleFont .pow.mbar.tools add command -label "Ruler..." \ -command {OpenRuler} -font g_titleFont .pow.mbar.tools add command -label "Image Probe" \ -command {imgProbeDialog} -font g_titleFont .pow.mbar.tools add command -label "Select X Range.." \ -command {powXRange} -font g_titleFont # # ZOOM Functions # menu .pow.mbar.zoom -bg $powbg -bd $bdVal \ -postcommand "powEvents::generate <>" -font g_titleFont .pow.mbar.zoom add command -label "Zoom In (2x)" \ -command "powScopeZoom in yes 2.0" -font g_titleFont -accelerator "Ctrl+I" .pow.mbar.zoom add command -label "Zoom Out (2x)" \ -command "powScopeZoom out yes 2.0" -font g_titleFont -accelerator "Ctrl+O" .pow.mbar.zoom add command -label "Zoom Reset" \ -command "powScopeZoom reset yes" -font g_titleFont -accelerator "Ctrl+R" .pow.mbar.zoom add separator foreach { maglabel mag } [list "zoom in at 1x" 1.0 "zoom in at 2x" 2.0 "zoom in at 4x" 4.0 \ "zoom in at 8x" 8.0 "zoom in at 16x" 16.0 "zoom in at 32x" 32.0] { .pow.mbar.zoom add radiobutton -label $maglabel \ -variable g_magnification -value $mag \ -font g_titleFont -command "powSetMagnification ; powScopeZoom in yes" } .pow.mbar.zoom add separator .pow.mbar.zoom add command -label "Invert X Axis" \ -command "powFlipImage X" -font g_titleFont .pow.mbar.zoom add command -label "Invert Y Axis" \ -command "powFlipImage Y" -font g_titleFont .pow.mbar.zoom add command -label "Invert Both" \ -command "powFlipImage B" -font g_titleFont .pow.mbar.zoom add command -label "Undo Invert" \ -command "powFlipImage U" -font g_titleFont .pow.mbar add command -label "Replot" \ -command "powReplotReset" -font g_titleFont if { !$isMac } { .pow.mbar add cascade -menu .pow.mbar.help -label "Help" -font g_titleFont } set menuBarDeleteFlag "false" # # HELP # menu .pow.mbar.help -bg $powbg -bd $bdVal \ -postcommand "powEvents::generate <>" -font g_titleFont if { $isMac } { .pow.mbar.help config -tearoff False } set powHelpTopics(About.html) About set powHelpTopics(Overview.html) Overview set powHelpTopics(Blinking.html) "Blinking" set powHelpTopics(Color.html) "Colors" set powHelpTopics(Contours.html) "Contours" set powHelpTopics(Profile.html) "Drawing Profile" set powHelpTopics(Edit.html) "Edit Menu" set powHelpTopics(EditGraphs.html) "Editting Graphs" set powHelpTopics(EditObjects.html) "Editting Objects" set powHelpTopics(File.html) "File Menu" set powHelpTopics(Probe.html) "Image Probe" set powHelpTopics(Ruler.html) "Measure" set powHelpTopics(Moving_Graphs.html) "Moving Graphs" set powHelpTopics(ROI.html) "Panning/Zooming" set powHelpTopics(PrintControl.html) "Printing" set powHelpTopics(DefaultOptions.html) "Preferences" set powHelpTopics(Regions.html) "Region Files" set powHelpTopics(Scripting.html) "Scripting" set powHelpTopics(Tools.html) "Tool Menu" foreach topic [lsort [array names powHelpTopics]] { .pow.mbar.help add command -label $powHelpTopics($topic) \ -command "powHelp $topic" \ } ############################################################## # Build Scope Objects ############################################################## # frame .pow.scopebuttons -bg $powbg # button .pow.scopein -bg $powbg -text "Zoom In" \ # -command "powScopeZoom in" # button .pow.scopezoom1 -bg $powbg -text "Replot" \ # -command "powEndROI 1" # button .pow.scopeout -bg $powbg -text "Zoom Out" \ # -command "powScopeZoom out" frame .pow.scopeframe -bg $powbg canvas .pow.scope -bg $powbg -cursor $powcursor \ -width $powScopeWidth -height $powScopeHeight label .pow.currgn -textvariable powScopeGn -background yellow \ -relief sunken -foreground black -font g_titleFont -bd 1 ############################################################## # Build Tracker Objects ############################################################## set powTrackText(gn) "NULL" set powTrackText(img) "NULL" set powTrackText(rx) "X" set powTrackText(ry) "X" set powTrackText(imgx) "X" set powTrackText(imgy) "X" set powTrackText(imgz) "X" set powTrackText(zunits) " " powUpdateTrackVars set powTrackerWidth 30 frame .pow.trackers -bg $powbg -width $powTrackerWidth label .pow.graphtrack -textvariable powGraphCoordsTracker \ -background $powbg -relief sunken -anchor w -justify left \ -width $powTrackerWidth -font g_titleFont -bd 1 label .pow.ppixeltrack -textvariable powPhysicalPixelTracker \ -background $powbg -relief sunken -anchor w -justify left \ -width $powTrackerWidth -font g_titleFont -bd 1 label .pow.pixeltrack -textvariable powImagePixelTracker \ -background $powbg -relief sunken -anchor w -justify left \ -width $powTrackerWidth -font g_titleFont -bd 1 label .pow.pixvaltrack -textvariable powImageValueTracker \ -background $powbg -relief sunken -anchor w -justify left \ -width $powTrackerWidth -font g_titleFont -bd 1 frame .pow.gui -bg $powbg powLayoutGUI } #end powGUI if block frame .pow.bottom -bg $powbg canvas .pow.pow -bg $powbg -cursor $powcursor\ -xscrollcommand ".pow.scrollx set" \ -yscrollcommand ".pow.scrolly set" \ -scrollregion [list 0 0 50 50] scrollbar .pow.scrolly -command "powScrollMainCanvas Y" -orient vertical\ -bg $powbg scrollbar .pow.scrollx -command "powScrollMainCanvas X" -orient horizontal\ -bg $powbg grid configure .pow.bottom -row 1 -column 1 -sticky "n s e w" grid rowconfigure .pow 1 -weight 1 grid columnconfigure .pow 1 -weight 1 grid configure .pow.pow -sticky "n s e w" -row 0 -column 0 \ -in .pow.bottom grid configure .pow.scrolly -sticky "n s e" -row 0 -column 1 \ -in .pow.bottom grid configure .pow.scrollx -sticky "n e w" -row 1 -column 0 \ -in .pow.bottom grid rowconfigure .pow.bottom 0 -weight 1 grid columnconfigure .pow.bottom 0 -weight 1 #put .pow.top above .pow.pow in the stacking order, #This should prevent window items on the #.pow.pow canvas from "bleeding" off the edges of the .pow.pow canvas lower .pow.bottom powSetGeometry if $powGUI { if { ! $powShowScope } { grid remove .pow.scopeframe grid remove .pow.trackers grid remove .pow.gui powDeleteMenuBarItem } bind .pow.pow {set_tracker_info %x %y .pow.pow} bind .pow.scope {set_tracker_info %x %y .pow.scope} # The 'powProcessClick' is required here since both BtnPress # and ROI is bound to canvas, but only 1 can be executed #puts "calling powBindBtn" powBindBtn <> "bind .pow.pow" \ {powBeginROI %x %y .pow.pow} \ {powDragROI %x %y .pow.pow; set_tracker_info %x %y .pow.pow} \ {powEndROI 0 .pow.pow} powBindBtn <> "bind .pow.scope" \ {powBeginROI %x %y .pow.scope} \ {powDragROI %x %y .pow.scope; set_tracker_info %x %y .pow.scope} \ {powEndROI 0 .pow.scope} powBindBtn <> "bind .pow.scope" \ {catch {powPanROI %x %y .pow.scope}} \ {catch {powPanROI %x %y .pow.scope}} \ {catch {powEndROI 0 .pow.scope}} bind .pow.pow <> \ { set x [.pow.pow canvasx %x] set y [.pow.pow canvasy %y] powDrawOriginal $x $y } bind .pow.scope <> \ { set x [.pow.scope canvasx %x] set y [.pow.scope canvasy %y] powDrawOriginal $x $y } bind .pow.scope <> {powProcessClick %x %y B%bD} } bind .pow <> {powExit} bind .pow.pow <> {+powProcessClick %x %y B%b} bind .pow.pow <> {powProcessClick %x %y B%b} bind .pow.pow <> {powProcessClick %x %y B%bD} bind .pow {event generate .pow -warp yes -x %x \ -y [expr %y+1]} bind .pow {event generate .pow -warp yes -x %x \ -y [expr %y-1]} bind .pow {event generate .pow -warp yes -x [expr %x - 1] \ -y %y} bind .pow {event generate .pow -warp yes \ -x [expr %x + 1] -y %y} .pow.pow bind graphDragable { if { !$powIsDragging } { .pow.pow configure -cursor fleur } } .pow.pow bind graphDragable { if { !$powIsDragging } { .pow.pow configure -cursor $powcursor } } powBindBtn <> ".pow.pow bind graphDragable" \ {powDragGraph start %X %Y} \ {powDragGraph drag %X %Y} \ {powDragGraph end %X %Y} #### # Create the virtual events and default bindings #### event add <> event add <> if { $powLutButton != 0 && $powLutButton != "NULL" } { event add <> if { $powLutButton == 3 && $tcl_platform(platform) == "macintosh" } { event add <> } } if { $powROIButton != 0 && $powROIButton != "NULL" } { # Must delete BtnPress sequence to prevent it from hiding the ROI event event delete <> event add <> event add <> # we are dedicate the back to original to 3 event add <> if { $powROIButton == 3 && $tcl_platform(platform) == "macintosh" } { event add <> event add <> } } if { $tcl_platform(platform) != "macintosh" } { event add <> } else { event add <> } event add <> event add <> event add <> if { $tcl_platform(platform) != "macintosh" } { event add <> } else { event add <> } event add <> event add <> update idletasks } # The next two functions prevent multiple bindings from being executed # for Btn events. Only the first set of events will be accepted. proc powBindBtn { event bindCmd beginCmd dragCmd endCmd } { #puts "powBindBtn start\n event: $event\n bindCmd: $bindCmd\n beginCmd: $beginCmd\n dragCmd: $dragCmd\n endCmd: $endCmd" regsub -all % $dragCmd %% dragCmd regsub -all % $endCmd %% endCmd set c1 [concat powBtn Begin $event [list $beginCmd] ] set c2 [concat $bindCmd \{ \ [list powBtn Drag $event $dragCmd] \ \}] set c3 [concat $bindCmd \{ \ [concat $bindCmd \{\}] \; \ [concat $bindCmd \{\}] \; \ [list powBtn End $event $endCmd] \; \ \}] eval $bindCmd $event {"$c3; $c2; $c1"} } proc powBtn { evt cntxt cmd } { #puts "powBtn start" global powBtnState powBtnContext if { ![info exists powBtnState] } { set powBtnState none set powBtnContext none } # If this is a different event from last time, execute command and remember # context... otherwise execute only if same context if { $evt != $powBtnState || $cntxt==$powBtnContext } { #puts "powBtn 1" set powBtnState $evt set powBtnContext $cntxt uplevel #0 $cmd #puts "powBtn 1 end" } } proc powLayoutGUI { } { global powGUIposition powShowScope #puts "powLayoutGUI start" # Build Tracker Box grid configure .pow.graphtrack -row 0 -column 0 -sticky ew \ -in .pow.trackers grid configure .pow.ppixeltrack -row 1 -column 0 -sticky ew \ -in .pow.trackers grid configure .pow.pixeltrack -row 2 -column 0 -sticky ew \ -in .pow.trackers grid configure .pow.pixvaltrack -row 3 -column 0 -sticky ew \ -in .pow.trackers # Build ScopeWindow grid configure .pow.currgn -row 0 -column 0 -sticky s \ -in .pow.scopeframe grid configure .pow.scope -row 1 -column 0 -sticky n \ -in .pow.scopeframe if { $powGUIposition == "top" || $powGUIposition=="bottom" } { # Build ScopeButtons # grid configure .pow.scopein -row 0 -column 1 -sticky ew \ # -in .pow.scopebuttons # grid configure .pow.scopezoom1 -row 1 -column 1 -sticky ew \ # -in .pow.scopebuttons # grid configure .pow.scopeout -row 2 -column 1 -sticky ew \ # -in .pow.scopebuttons grid configure .pow.trackers -in .pow.gui -row 1 -column 0 \ -sticky w -padx 3 -pady 3 if { $powShowScope } { grid configure .pow.scopeframe -in .pow.gui -row 1 -column 1 \ -sticky e } # grid configure .pow.scopebuttons -in .pow.gui -row 1 -column 2 \ # -sticky e grid columnconfigure .pow.gui 1 -weight 1 grid rowconfigure .pow.gui 0 -weight 0 grid rowconfigure .pow.gui 1 -weight 1 } else { # Build ScopeButtons # grid configure .pow.scopein -row 1 -column 0 -sticky ew \ # -in .pow.scopebuttons # grid configure .pow.scopezoom1 -row 1 -column 1 -sticky ew \ # -in .pow.scopebuttons # grid configure .pow.scopeout -row 1 -column 2 -sticky ew \ # -in .pow.scopebuttons grid configure .pow.trackers -in .pow.gui -row 2 -column 1 \ -sticky n -padx 5 -pady 5 if { $powShowScope } { grid configure .pow.scopeframe -in .pow.gui -row 0 -column 1 \ -sticky n } # grid configure .pow.scopebuttons -in .pow.gui -row 1 -column 1 \ # -sticky n grid columnconfigure .pow.gui 1 -weight 1 grid rowconfigure .pow.gui 0 -weight 1 grid rowconfigure .pow.gui 1 -weight 0 } switch $powGUIposition { "top" { grid configure .pow.gui -in .pow -row 0 -column 1 \ -sticky news } "bottom" { grid configure .pow.gui -in .pow -row 2 -column 1 \ -sticky news } "left" { grid configure .pow.gui -in .pow -row 1 -column 0 \ -sticky n } "right" { grid configure .pow.gui -in .pow -row 1 -column 2 \ -sticky n } default { grid remove .pow.gui } } lower .pow.gui } proc powScrollMainCanvas {x_or_y args} { #puts "powScrollMainCanvas start" global powPreScrollCallback powPostScrollCallback if [info exists powPreScrollCallback] { eval $powPreScrollCallback $x_or_y $args } if {$x_or_y == "X"} { eval .pow.pow xview $args } else { eval .pow.pow yview $args } if [info exists powPostScrollCallback] { eval $powPostScrollCallback $x_or_y $args } } proc powSetGeometry { } { #puts "powSetGeometry start" global powHeaderHeight powHeaderWidth powGUIposition global powMaxWidth powMaxHeight powMinWidth powMinHeight global powRealMinWidth powRealMinHeight global powGUI powScopeSize powContainer tcl_platform update idletasks if $powGUI { if { $powGUIposition=="top" || $powGUIposition=="bottom" } { set powHeaderHeight [lindex [lsort -integer -decreasing [list \ [expr 3*[winfo height .pow.graphtrack]] \ [expr [winfo height .pow.scope]+[winfo height .pow.currgn]] \ ] ] 0] if { $tcl_platform(platform) != "macintosh" } { # Add in the menubar incr powHeaderHeight 32 } set powHeaderWidth 0 set minGuiWidth [expr [winfo width .pow.graphtrack] \ + [winfo width .pow.scope] \ + 15] if { $minGuiWidth > $powMinWidth } { set powRealMinWidth $minGuiWidth } else { set powRealMinWidth $powMinWidth } set powRealMinHeight [expr $powMinHeight + $powHeaderHeight] } elseif { $powGUIposition=="left" || $powGUIposition=="right" } { set powHeaderWidth [lindex [lsort -integer -decreasing [list \ [winfo width .pow.graphtrack] \ [winfo width .pow.scope] \ ] ] 0] set powHeaderHeight 0 set minGuiHeight [expr 3* [winfo height .pow.graphtrack] \ + [winfo height .pow.scope] \ + [winfo height .pow.currgn] \ + 10] if { $minGuiHeight > $powMinHeight } { set powRealMinHeight $minGuiHeight } else { set powRealMinHeight $powMinHeight } if { $tcl_platform(platform) != "macintosh" } { # Add in the menubar incr powRealMinHeight 32 set powHeaderHeight 32 } set powRealMinWidth [expr $powMinWidth + $powHeaderWidth] } else { set powHeaderHeight 0 set powHeaderWidth 0 set powRealMinWidth $powMinWidth set powRealMinHeight $powMinHeight } } else { set powHeaderHeight 0 set powHeaderWidth 0 set powRealMinWidth 0 set powRealMinHeight 0 } set powMaxHeight [expr [winfo screenheight .pow] - $powHeaderHeight] set powMaxWidth [expr [winfo screenwidth .pow] - $powHeaderWidth] if {$powContainer == "none" || $powContainer == "NULL" } { catch { wm minsize .pow $powRealMinWidth $powRealMinHeight } catch { wm maxsize .pow [expr $powMaxWidth + $powHeaderWidth] \ [expr $powMaxHeight + $powHeaderHeight] } } else { catch {wm geometry .pow "[winfo geometry $powContainer]"} } } proc powGetGraphOptions {gn} { #puts "powGetGraphOptions start" #returns list of extra graph options global powPlotParam #test for requested graph if { ![powListGraphs $gn] } { error "Graph $gn does not exist" return } lappend optlist "bgcolor" $powPlotParam(bgcolor,$gn) lappend optlist "xmargin" $powPlotParam(xmargin,$gn) lappend optlist "ymargin" $powPlotParam(ymargin,$gn) return $optlist } proc powGraphOptions {gn args} { #puts "powGraphOptions start" #add extra graph options here. Arguments are "option value" pairs. global powPlotParam currgn set argc [llength $args] if { $argc == 1 } { if { [info exists powPlotParam($args,$gn)] } { return $powPlotParam($args,$gn) } else { return "" } } elseif { [expr $argc %2] != 0 } { error "Arguments must be in 'option value' pairs" } foreach [list option value] $args { switch $option { bgcolor { set powPlotParam(bgcolor,$gn) $value if [winfo exists .pow.pow] { set cleanName [powCleanName $gn]handle .pow.pow itemconfigure ${gn}bkg -fill $value -outline $value if [winfo exists .pow.s$cleanName] { .pow.s$cleanName configure -bg $value } if [winfo exists .pow.ms$cleanName] { .pow.ms$cleanName configure -bg $value } .pow.pow lower ${gn}bkg } } xdimdisp - ydimdisp - xmargin - ymargin - zoomed - FixedAspect { set powPlotParam($option,$gn) $value } titleString - titleAnchor - titlePosition - xNumTicks - yNumTicks - flipD - xlabel - ylabel - xunits - yunits { set powPlotParam($option,$gn) $value set doAction(adornGraph) 1 } xTickLength - yTickLength - xLabelTicks - yLabelTicks - tickLabels - tickFormatCmdX - tickFormatCmdY - xTickScal - yTickScal { set powPlotParam($option,$gn) $value set doAction(adornGraph) 1 set doAction(redrawGraphHandles) 1 } wcsName { set powPlotParam(wcsName,$gn) $value } # Grid and GridLines are same option. Grid is archaic. Grid - GridLines { set powPlotParam(GridLines,$gn) $value set doAction(adornGraph) 1 } GridColor { set clr [powColorToHex $value] set powPlotParam(GridColor,$gn) $clr if [winfo exists .pow.pow] { .pow.pow itemconfig ${gn}grid -fill $clr } } GridDash { set powPlotParam(GridDash,$gn) $value if [winfo exists .pow.pow] { .pow.pow itemconfig ${gn}grid -dash $value } } default { error "Unknown option $option" } } } # Perform delayed actions if graph (and window) already exists if { [powListGraphs $gn] && [winfo exists .pow.pow] \ && [.pow.pow find withtag ${gn}box]!="" } { if { [info exists doAction(adornGraph)] } { powAdornGraph $gn .pow.pow } if { [info exists doAction(redrawGraphHandles)] } { powRedrawGraphHandles $gn } if { $gn == $currgn } { powUpdateGraphMenuOptions } } } proc powColorToHex { color } { #puts "powColorToHex start" global powCurveParam if { [string index $color 0]!="#" } { set idx [lsearch $powCurveParam(allColors,powDef) $color] if { $idx>-1 } { incr idx set color [lindex $powCurveParam(allColors,powDef) $idx] } } return $color } proc powToplevel {topwin refwin {options ""}} { #this implements what *should* be default behavior for X colormap handling. #Apparently the evil of Xlib colormap handling is contagious. #if we're running in the plugin or in single window mode, this creates #a frame instead of a toplevel. global powFrameForTop powbg powContainer #puts "powToplevel start" if {!$powFrameForTop} { #puts "powToplevel 1" #puts "refwin: $refwin" #puts "options: $options" catch { eval {toplevel $topwin -colormap $refwin \ -visual [list [winfo visual $refwin] [winfo depth $refwin]]} \ $options } err #puts "err: $err" focus $topwin } else { #in a tclet just use frames frame $topwin -bg $powbg if [info exists powContainer] { grid $topwin -sticky news -in $powContainer } else { grid $topwin -sticky news } } } proc powReditherImage {gn img {canvas .pow.pow} } { #This recalculates the colors/intensities in the base Photo image. #The call to powMagImage is necessary to make them appear. global powPseudoImages powImageParam #puts "powReditherImage start" #We could redither pseudocolors, but it isn't necessary if { ! $powPseudoImages } { powReditherPhotoBlock $img \ $powImageParam(RBmin${img},$gn) $powImageParam(RBmax${img},$gn) } if { [$canvas find withtag ${img}disp${gn}]!="" } { powMagImage $gn $img $canvas } } proc powReditherImages {gn img} { #puts "powReditherImages start" #This checks whether we need to redither both a color bar and an image #It also redithers the scope box if it is the current graph global powPseudoImages powPlotParam powImageParam currgn powGUI #We could redither pseudocolors, but it isn't necessary # if $powPseudoImages return # Redither this image powReditherImage $gn $img # Redither Scope if { $powGUI && $currgn == $gn && \ [.pow.scope find withtag ${img}disp${gn}scope]!="" } { powReditherImage ${gn}scope $img .pow.scope } # Redither original image or colorbar if other exists foreach {gn2 img2} [powGetColorbarLink $gn $img] {} if { $gn2 != "" } { powReditherImage $gn2 $img2 } } proc powCmapInvert { } { #puts "powCmapInvert start" global powPseudoImages curr_img if $powPseudoImages { $curr_img colormap invert } else { powPhotoColorTable invert } } proc powSetRanges { gn img min max } { #puts "powSetRanges start" global powGUI currgn powPlotParam powImageParam powSetRange $gn $img $min $max # Set Scope if { $powGUI && $currgn == $gn } { powSetRange ${gn}scope $img $min $max } # Set original image or colorbar if other exists foreach {gn2 img2} [powGetColorbarLink $gn $img] {} if { $gn2 != "" } { powSetRange $gn2 $img2 $min $max # Also need to update RB for undisplayed scope so must break modularity! if { $powGUI } { set powImageParam(RBmin${img2},${gn2}scope) $min set powImageParam(RBmax${img2},${gn2}scope) $max } } } proc powSetRange { gn img min max } { #puts "powSetRange start" global powPseudoImages powImageParam powGUI set powImageParam(RBmin${img},$gn) $min set powImageParam(RBmax${img},$gn) $max if {$powPseudoImages} { ${img}disp${gn} range $min $max } else { if { $powGUI && [regexp scope$ $gn] } { powReditherImage $gn $img .pow.scope } else { powReditherImage $gn $img .pow.pow } } } proc powSetColorTable { gn img } { #puts "powSetColorTable start" global powPseudoImages currimg currgn powImageParam powSetLut $gn $img $powImageParam(scale${img},$gn) if {$powPseudoImages} { ${img}disp${gn} colormap $powImageParam(colormap${img},$gn) } else { powPhotoColorTable $powImageParam(colormap${img},$gn) } invert_cmap_if_flag_set $gn $img } proc powGenerateReplotCascade { } { #puts "powGenerateReplotCascade start" global powPlotParam powOrderedGraphList set idx 0 .pow.mbar.edit.replot delete 0 end foreach gn $powOrderedGraphList { incr idx if { $gn=="" } continue if { [.pow.pow find withtag ${gn}box]=="" } { set state normal } else { set state disabled } set title $powPlotParam(titleString,$gn) if { $title=="" } { set title "Untitled $idx" } .pow.mbar.edit.replot add command -label $title \ -command "powMapGraph $gn" -state $state } } proc powGenerateUnmapCascade { } { #puts "powGenerateUnmapCascade start" global powPlotParam powOrderedGraphList set idx 0 .pow.mbar.edit.unmap delete 0 end foreach gn $powOrderedGraphList { incr idx if { $gn=="" } continue if { [.pow.pow find withtag ${gn}box]=="" } { set state disabled } else { set state normal } set title $powPlotParam(titleString,$gn) if { $title=="" } { set title "Untitled $idx" } .pow.mbar.edit.unmap add command -label $title \ -command "powUnmapGraph $gn" -state $state } } proc powGenerateMergeCascade { } { #puts "powGenerateMergeCascade start" global currgn powPlotParam powOrderedGraphList set idx 0 .pow.mbar.edit.merge delete 0 end foreach gn $powOrderedGraphList { incr idx if { $gn=="" } continue if { $gn==$currgn } { set state disabled } else { set state normal } set title $powPlotParam(titleString,$gn) if { $title=="" } { set title "Untitled $idx" } .pow.mbar.edit.merge add command -label $title \ -command "powMergeGraphs $gn" -state $state } } proc powProcessClick { x y binding} { #puts "powProcessClick start binding: $binding" global powClickCallback set gn [powWhereAmI [.pow.pow canvasx $x] [.pow.pow canvasy $y]] if {$gn != "NULL"} { # powSelectGraph $gn if [info exists powClickCallback] { set gcoords [powCanvasToGraph $gn [.pow.pow canvasx $x] [.pow.pow canvasy $y]] set rx [lindex $gcoords 0] set ry [lindex $gcoords 1] $powClickCallback $gn $rx $ry $binding } } #puts "powProcessClick end" } proc determineSearchPath { data } { global tcl_platform global env set searchPath "" set findFlag false set delimiter ":" if { $tcl_platform(platform)=="windows" } { return "$env(FITSVIEWER_LIBRARY)/../../gs6.52/bin;$env(FITSVIEWER_LIBRARY)/../../gs6.52/fonts" } set tokens [split $data "\n"] for {set i 0} {$i < [llength $tokens]} {incr i} { if { $findFlag == "true" } { if { [string first "For more" [lindex $tokens $i]] >= 0 } { break } set pathToken [split [lindex $tokens $i] $delimiter] foreach path $pathToken { set path [string trim $path] if { $path == "" } continue set lastpath $path set searchPath [format "%s%s%s" $searchPath $delimiter $path] } set searchPath [format "%s%s%s" $searchPath $delimiter [file dirname $lastpath]/fonts] break } if { [string first "Search path" [lindex $tokens $i]] >= 0 } { set findFlag true continue } } return $searchPath } proc powRescaleBox { } { global powbg curr_img currimg currgn powRBmin powRBmax powbg powDWP global powImageParam powHisto if { [winfo exists ${powDWP}powRB] } { destroy ${powDWP}powRB } if {![info exists curr_img]} { error "You must first select an image" return } powToplevel ${powDWP}powRB .pow "-bg $powbg -class \"POW Rescale\"" bind ${powDWP}powRB <> "destroy ${powDWP}" bind ${powDWP}powRB "+powUpdateHisto ?" bind ${powDWP}powRB "+powUpdateHisto ?" label ${powDWP}powRB.min -text "Image min: $powRBmin($currimg)" -bg $powbg label ${powDWP}powRB.max -text "Image max: $powRBmax($currimg)" -bg $powbg label ${powDWP}powRB.cmin -text "Current min:" -bg $powbg entry ${powDWP}powRB.ecmin -relief sunken -bg $powbg \ -textvariable powImageParam(RBmin${currimg},$currgn) -bd 1 label ${powDWP}powRB.cmax -text "Current max:" -bg $powbg entry ${powDWP}powRB.ecmax -relief sunken -bg $powbg \ -textvariable powImageParam(RBmax${currimg},$currgn) -bd 1 frame ${powDWP}powRB.buttonFrame -bg $powbg button ${powDWP}powRB.apply -text Apply -command { powUpdateHisto 0 # powSetRanges $currgn $currimg powCmds::colormap scale $powImageParam(scale${currimg},$currgn) \ $powImageParam(RBmin${currimg},$currgn) \ $powImageParam(RBmax${currimg},$currgn) foreach {gn2 img2} [powGetColorbarLink $currgn $currimg] {} if { $gn2 != "" || $img2 != "" } { powDeleteImage $gn2 $img2 powColorbar } } -bg $powbg button ${powDWP}powRB.reset -text Reset -command { # powSetRanges $currgn $currimg powCmds::colormap scale $powImageParam(scale${currimg},$currgn) \ $powRBmin($currimg) $powRBmax($currimg) powUpdateHisto ? foreach {gn2 img2} [powGetColorbarLink $currgn $currimg] {} if { $gn2 != "" || $img2 != "" } { powDeleteImage $gn2 $img2 powColorbar } } -bg $powbg button ${powDWP}powRB.exit -text Exit -command {destroy ${powDWP}powRB} \ -bg $powbg grid configure ${powDWP}powRB.min -row 0 -column 0 -columnspan 2 -sticky w grid configure ${powDWP}powRB.max -row 0 -column 2 -columnspan 2 -sticky w grid configure ${powDWP}powRB.cmin -row 1 -column 0 -sticky w grid configure ${powDWP}powRB.ecmin -row 1 -column 1 -sticky w grid configure ${powDWP}powRB.cmax -row 1 -column 2 -sticky w grid configure ${powDWP}powRB.ecmax -row 1 -column 3 -sticky w grid configure ${powDWP}powRB.buttonFrame -row 4 -column 0 -columnspan 4 -sticky ew grid configure ${powDWP}powRB.apply -row 0 -column 0 -in ${powDWP}powRB.buttonFrame -sticky w grid configure ${powDWP}powRB.reset -row 0 -column 1 -in ${powDWP}powRB.buttonFrame grid configure ${powDWP}powRB.exit -row 0 -column 2 -in ${powDWP}powRB.buttonFrame -sticky e frame ${powDWP}powRB.histo -bg $powbg grid ${powDWP}powRB.histo -row 2 -column 0 -columnspan 4 \ -padx 3 -pady 5 -sticky news canvas ${powDWP}powRB.histo.grph -relief sunken -width 256 -height 150 \ -bg $powbg -bd 3 grid ${powDWP}powRB.histo.grph -row 1 -column 2 -rowspan 3 powBindBtn <> "bind ${powDWP}powRB.histo.grph " \ { powDragHistoBounds b1 %x; powDragHistoBounds b2 %x } \ { powDragHistoBounds b1 %x } \ { powUpdateHisto ? } frame ${powDWP}powRB.histo.scale -bg $powbg grid ${powDWP}powRB.histo.scale -row 1 -column 0 -rowspan 3 radiobutton ${powDWP}powRB.histo.scale.linear \ -text "Linear" -bg $powbg -variable powHisto(scale) \ -value linear -highlightthickness 0 -command { set powHisto(scale) linear ; powUpdateHisto 1 } radiobutton ${powDWP}powRB.histo.scale.logY \ -text "LogY" -bg $powbg -variable powHisto(scale) \ -value log -highlightthickness 0 -command { set powHisto(scale) log; powUpdateHisto 1 } grid ${powDWP}powRB.histo.scale.linear -row 0 -column 0 -sticky nsw grid ${powDWP}powRB.histo.scale.logY -row 2 -column 0 -sticky nsw canvas ${powDWP}powRB.histo.scale.list -width 50 -height 150 \ -bg $powbg -bd 0 -highlightthickness 0 grid ${powDWP}powRB.histo.scale.list -row 0 -column 1 -rowspan 3 -sticky ns canvas ${powDWP}powRB.histo.bnds -relief flat -width 266 -height 6 \ -bg $powbg -bd 0 -highlightthickness 0 grid ${powDWP}powRB.histo.bnds -row 0 -column 2 frame ${powDWP}powRB.histo.histbutt -bg $powbg grid ${powDWP}powRB.histo.histbutt -row 4 -column 2 radiobutton ${powDWP}powRB.histo.histbutt.fullrange \ -text "Full Range" -bg $powbg -variable powHisto(range) \ -value full -highlightthickness 0 -command { after idle { powUpdateHisto 1 } } radiobutton ${powDWP}powRB.histo.histbutt.currrange \ -text "Current Range" -bg $powbg -variable powHisto(range) \ -value curr -highlightthickness 0 -command { after idle { powUpdateHisto 1 } } grid ${powDWP}powRB.histo.histbutt.fullrange -row 1 -column 1 grid ${powDWP}powRB.histo.histbutt.currrange -row 1 -column 2 set powHisto(image) $currimg set powHisto(graph) $currgn set powHisto(min) $powRBmin($currimg) set powHisto(max) $powRBmax($currimg) set powHisto(range) full set powHisto(scale) linear powUpdateHisto 1 } proc powUpdateHisto { new {scale linear} } { #puts "powUpdateHisto start" global powDWP powRBmin powRBmax global powImageParam powHisto if { ![winfo exists ${powDWP}powRB] } { return } set img $powHisto(image) set gn $powHisto(graph) if { $new=="?" } { if { $powHisto(range)!="full" } { set new 1 } else { set new 0 } } if { $new } { if { $powHisto(range)=="full" } { set powHisto(min) $powRBmin($img) set powHisto(max) $powRBmax($img) } else { set powHisto(min) $powImageParam(RBmin${img},$gn) set powHisto(max) $powImageParam(RBmax${img},$gn) } } set min $powImageParam(RBmin${img},$gn) set max $powImageParam(RBmax${img},$gn) if { $min > $max } { set tmp $min set min $max set max $tmp set powImageParam(RBmin${img},$gn) $min set powImageParam(RBmax${img},$gn) $max } set scale [expr $powHisto(max) - $powHisto(min) ] if { $scale != 0.0 } { set scale [expr 255.0 / $scale] set minBounds [expr round($scale * ($min - $powHisto(min)))] set maxBounds [expr round($scale * ($max - $powHisto(min)))] } else { set minBounds 0 set maxBounds 255 } if { $new } { set powHisto(b1) $min set powHisto(b2) $max ${powDWP}powRB.histo.bnds delete all ${powDWP}powRB.histo.bnds create polygon \ [expr $minBounds+0] 0 \ [expr $minBounds+10] 0 \ [expr $minBounds+5] 5 \ -fill black -tags b1 ${powDWP}powRB.histo.bnds create polygon \ [expr $maxBounds+0] 0 \ [expr $maxBounds+10] 0 \ [expr $maxBounds+5] 5 \ -fill black -tags b2 powBindBtn "${powDWP}powRB.histo.bnds bind b1" \ { powDragHistoBounds b1 %x } \ { powDragHistoBounds b1 %x } \ { powUpdateHisto ? } powBindBtn "${powDWP}powRB.histo.bnds bind b2" \ { powDragHistoBounds b2 %x } \ { powDragHistoBounds b2 %x } \ { powUpdateHisto ? } ${powDWP}powRB.histo.bnds bind b1 \ { ${powDWP}powRB.histo.bnds itemconfig b1 -fill red } ${powDWP}powRB.histo.bnds bind b1 \ { ${powDWP}powRB.histo.bnds itemconfig b1 -fill black } ${powDWP}powRB.histo.bnds bind b2 \ { ${powDWP}powRB.histo.bnds itemconfig b2 -fill red } ${powDWP}powRB.histo.bnds bind b2 \ { ${powDWP}powRB.histo.bnds itemconfig b2 -fill black } } else { if { $powHisto(b1) < $powHisto(b2) } { set minTag b1 set maxTag b2 } else { set minTag b2 set maxTag b1 } set powHisto($minTag) $min set powHisto($maxTag) $max ${powDWP}powRB.histo.bnds coords $minTag \ [expr $minBounds+0] 0 \ [expr $minBounds+10] 0 \ [expr $minBounds+5] 5 ${powDWP}powRB.histo.bnds coords $maxTag \ [expr $maxBounds+0] 0 \ [expr $maxBounds+10] 0 \ [expr $maxBounds+5] 5 } if { $new } { ${powDWP}powRB.histo.scale.list delete scale_0_Text scale_0_Line \ scale_H_Text scale_H_line \ scale_T_Text scale_T_line set histo [powGetHisto $img $powHisto(min) $powHisto(max)] set pixmax 0 set pixmin 9999999999 foreach val [lrange $histo 1 254] { if { $val>$pixmax } { set pixmax $val } if { $val > 0 && $val < $pixmin } { set pixmin $val } } if { $pixmax==0 } { set pixmax 1 } ${powDWP}powRB.histo.grph delete all set i 4 set sList {} foreach val $histo { set scaledVal [expr $val * 149 / $pixmax] if { $powHisto(scale) == "log" } { if { $val > 0 } { set scaledVal [expr log10($val) * 149.0 / log10($pixmax)] } else { set scaledVal 0 } } lappend sList $scaledVal if { $scaledVal > 153 } { set scaledVal 153 } ${powDWP}powRB.histo.grph create line $i 153 $i [expr 153-$scaledVal] -fill blue incr i } ${powDWP}powRB.histo.scale.list create text 20 145 -fill red \ -text "0" -tag scale_0_Text ${powDWP}powRB.histo.scale.list create line 45 149 50 149 -fill red \ -tag scale_0_Line if { $powHisto(scale) == "log" } { ${powDWP}powRB.histo.scale.list create text 20 5 -fill red \ -text [format "%5.3f" [expr log10($pixmax)]] -tag scale_T_Text ${powDWP}powRB.histo.scale.list create text 20 75 -fill red \ -text [format "%5.3f" [expr log10($pixmax/2.0)]] -tag scale_H_Text } else { ${powDWP}powRB.histo.scale.list create text 20 5 -fill red \ -text $pixmax -tag scale_T_Text ${powDWP}powRB.histo.scale.list create text 20 75 -fill red \ -text [expr $pixmax/2] -tag scale_H_Text } ${powDWP}powRB.histo.scale.list create line 45 0 50 0 -fill red \ -tag scale_T_Line ${powDWP}powRB.histo.scale.list create line 45 75 50 75 -fill red \ -tag scale_H_Line } ${powDWP}powRB.histo.grph addtag blackLines enclosed \ 0 0 [expr $minBounds+3.5] 160 ${powDWP}powRB.histo.grph addtag greyLines enclosed \ [expr $minBounds+3.5] 0 [expr $maxBounds+4.5] 160 ${powDWP}powRB.histo.grph addtag whiteLines enclosed \ [expr $maxBounds+4.5] 0 270 160 ${powDWP}powRB.histo.grph itemconfig blackLines -fill black ${powDWP}powRB.histo.grph itemconfig greyLines -fill blue ${powDWP}powRB.histo.grph itemconfig whiteLines -fill white ${powDWP}powRB.histo.grph dtag blackLines ${powDWP}powRB.histo.grph dtag greyLines ${powDWP}powRB.histo.grph dtag whiteLines } proc powDragHistoBounds { tag x } { #puts "powDragHistoBounds start" global powHisto powImageParam set img $powHisto(image) set gn $powHisto(graph) set scale [expr $powHisto(max) - $powHisto(min) ] if { $scale == 0.0 } { return } set scale [expr 255.0 / $scale] set val [expr ($x-5)/$scale + $powHisto(min)] set powHisto($tag) $val if { $powHisto(b1) < $powHisto(b2) } { set powImageParam(RBmin${img},$gn) $powHisto(b1) set powImageParam(RBmax${img},$gn) $powHisto(b2) } else { set powImageParam(RBmin${img},$gn) $powHisto(b2) set powImageParam(RBmax${img},$gn) $powHisto(b1) } powUpdateHisto 0 } proc powSetMagstepBox { } { #puts "powSetMagstepBox start" global powPlotParam currgn powbg powDWP global powXMagstep powYMagstep powSaveXMagstep powSaveYMagstep if { $currgn=="powDef" } { error "You must first select a graph" return } if { [winfo exists ${powDWP}magstep] } { raise ${powDWP}magstep return } powToplevel ${powDWP}magstep .pow "-bg $powbg -class \"POW Magstep\"" bind ${powDWP}magstep <> "destroy ${powDWP}" set powXMagstep $powPlotParam(xmagstep,$currgn) set powYMagstep $powPlotParam(ymagstep,$currgn) set powSaveXMagstep $powXMagstep set powSaveYMagstep $powYMagstep label ${powDWP}magstep.label -text "Current magstep:" -bg $powbg label ${powDWP}magstep.xlabel -text "X " -bg $powbg label ${powDWP}magstep.ylabel -text "Y " -bg $powbg entry ${powDWP}magstep.xmagstep -textvariable powXMagstep \ -relief sunken -bg $powbg -bd 1 entry ${powDWP}magstep.ymagstep -textvariable powYMagstep \ -relief sunken -bg $powbg -bd 1 frame ${powDWP}magstep.buttonFrame -bg $powbg button ${powDWP}magstep.apply -text Apply -command \ {powMagGraph $currgn $powXMagstep $powYMagstep; \ set powXMagstep $powPlotParam(xmagstep,$currgn); \ set powYMagstep $powPlotParam(ymagstep,$currgn)} -bg $powbg button ${powDWP}magstep.reset -text Reset -command \ {set powXMagstep $powSaveXMagstep; \ set powYMagstep $powSaveYMagstep; \ powMagGraph $currgn $powXMagstep $powYMagstep} -bg $powbg button ${powDWP}magstep.exit -text Exit -command {destroy ${powDWP}magstep} -bg $powbg grid configure ${powDWP}magstep.label -row 0 -column 0 -sticky w grid configure ${powDWP}magstep.xlabel -row 0 -column 1 grid configure ${powDWP}magstep.ylabel -row 1 -column 1 grid configure ${powDWP}magstep.xmagstep -row 0 -column 2 -sticky w grid configure ${powDWP}magstep.ymagstep -row 1 -column 2 -sticky w grid configure ${powDWP}magstep.buttonFrame -row 2 -column 0 -columnspan 3 -sticky ew grid configure ${powDWP}magstep.apply -row 0 -column 0 -in ${powDWP}magstep.buttonFrame -sticky w grid configure ${powDWP}magstep.reset -row 0 -column 1 -in ${powDWP}magstep.buttonFrame grid configure ${powDWP}magstep.exit -row 0 -column 2 -in ${powDWP}magstep.buttonFrame -sticky e } proc powSetGraphSize { } { #puts "powSetGraphSize start" global powPlotParam currgn powbg powFrameForTop global powXDim powYDim powSaveXDim powSaveYDim powDWP g_titleFont if { $currgn=="powDef" } { error "You must first select a graph" return } if { [winfo exists ${powDWP}dim] } { raise ${powDWP}dim return } powToplevel ${powDWP}dim .pow "-bg $powbg -class \"POW Dim\"" bind ${powDWP}dim <> "destroy ${powDWP}" if {!$powFrameForTop} { wm title ${powDWP}dim "Set Graph Dimensions" } set powXDim [tagXdim .pow.pow ${currgn}box] set powYDim [tagYdim .pow.pow ${currgn}box] set powSaveXDim $powXDim set powSaveYDim $powYDim label ${powDWP}dim.label -text "Current Dim:" -bg $powbg -font g_titleFont label ${powDWP}dim.xlabel -text "X " -bg $powbg -font g_titleFont label ${powDWP}dim.ylabel -text "Y " -bg $powbg -font g_titleFont entry ${powDWP}dim.xDim -textvariable powXDim \ -relief sunken -bg $powbg -width 10 -font g_titleFont -bd 1 entry ${powDWP}dim.yDim -textvariable powYDim \ -relief sunken -bg $powbg -width 10 -font g_titleFont -bd 1 frame ${powDWP}dim.buttonFrame -bg $powbg button ${powDWP}dim.apply -text Apply -command \ {powStretchGraphToSize $currgn $powXDim $powYDim} -bg $powbg -font g_titleFont button ${powDWP}dim.reset -text Reset -command \ {set powXDim $powSaveXDim; \ set powYDim $powSaveYDim; \ powStretchGraphToSize $currgn $powXDim $powYDim} -bg $powbg -font g_titleFont button ${powDWP}dim.exit -text Exit -command {destroy ${powDWP}dim} -bg $powbg -font g_titleFont grid configure ${powDWP}dim.label -row 0 -column 0 -sticky w grid configure ${powDWP}dim.xlabel -row 0 -column 1 grid configure ${powDWP}dim.ylabel -row 1 -column 1 grid configure ${powDWP}dim.xDim -row 0 -column 2 -sticky w grid configure ${powDWP}dim.yDim -row 1 -column 2 -sticky w grid configure ${powDWP}dim.buttonFrame -row 2 -column 0 -columnspan 3 -sticky ew grid configure ${powDWP}dim.apply -row 0 -column 0 -in ${powDWP}dim.buttonFrame -sticky w grid configure ${powDWP}dim.reset -row 0 -column 1 -in ${powDWP}dim.buttonFrame grid configure ${powDWP}dim.exit -row 0 -column 2 -in ${powDWP}dim.buttonFrame -sticky e } proc powSave { {inputFile {}} } { global powSelectDirectory global powGraphSelection global powbg powOutputFileName global powStretch powOutputPaperSize global powConvertFormat powConvertFunction global powHandles powDWP g_titleFont global powPaperDefXsizeInch powPaperDefYsizeInch global powPaperDefXsizePixel powPaperDefYsizePixel global powOutputPaperXsizeInch powOutputPaperYsizeInch global powOutputPaperXsizePixel powOutputPaperYsizePixel global powPlacement powPostOrient global powPaperSizeSelected powPixelToInchRatio global ghostScript global powOutputFileType global tcl_platform global searchPath global tcl_platform set fileNameList {} if { [llength $inputFile] == 0 } { set fileNameList [powAssemblePSfile] } else { lappend fileNameList $inputFile } if ![info exists powOutputFileName] { powSelectConvertFormat "postscript - Postscript Files" } set idx 0 foreach fileName $fileNameList { # Save to any graph format set outputName $powOutputFileName if { [llength $fileNameList] > 1 } { set token [split $powOutputFileName "."] set outputName [format "%s_%s.%s" [lindex $token 0] $idx [lindex $powOutputFileType 2]] } set realDirectory $powSelectDirectory if { $tcl_platform(platform) == "windows" } { set powSelectDirectory [string trim $powSelectDirectory "{}/"] set realDirectory [_changeWinDirectoryToUnixFormat $powSelectDirectory] } if { [lindex $powOutputFileType 2] != "ps" } { set errorFlag [ catch { exec $ghostScript -sDEVICE=[lindex $powOutputFileType 1] \ -dNOPAUSE -dBATCH -dQUIET \ -sPAPERSIZE=[string tolower $powPaperSizeSelected] \ -I$searchPath \ -sOutputFile=$realDirectory/$outputName $fileName } err ] #puts "err: <$err>" } else { set errorFlag [ catch { file copy -force $fileName $realDirectory/$outputName } err ] } incr idx if { $idx >= [llength $fileNameList] } { # tk_messageBox -icon info -parent .pow -type ok -message "Successful save graphs to $powSelectDirectory." } } } proc powSaveAs {} { global powDWP powbg global g_titleFont global powConvertFunction powOutputFileName global powOutputFileType powSelectDirectory global currentPreviewGraph global powGraphCoordList powGraphSelection if [winfo exists ${powDWP}saveAsSetup] { wm deiconify ${powDWP}saveAsSetup ${powDWP}saveAsSetup.directory.saveInEntry delete 0 end if { [${powDWP}print.option.direntry get] != "" } { ${powDWP}saveAsSetup.directory.saveInEntry insert end [${powDWP}print.option.direntry get] } else { ${powDWP}saveAsSetup.directory.saveInEntry insert end [pwd] } ${powDWP}saveAsSetup.file.fileNameEntry delete 0 end ${powDWP}saveAsSetup.file.fileNameEntry insert end $powOutputFileName set token [split $powOutputFileName "."] set powOutputFileType {postscript pswrite ps "Postscript Files"} foreach cvf $powConvertFunction { if { [lindex $cvf 2] == [lindex $token 1] } { set powOutputFileType $cvf tixSetSilent ${powDWP}saveAsSetup.file.convertType "[lindex $cvf 0] - [lindex $cvf 3]" break } } [${powDWP}saveAsSetup.directory.directoryTree subwidget hlist] delete all destroy ${powDWP}saveAsSetup.directory.directoryTree tixDirTree ${powDWP}saveAsSetup.directory.directoryTree \ -value [${powDWP}saveAsSetup.directory.saveInEntry get] \ -browsecmd {powSelectDir} -command {powSelectDir} \ -options { \ hlist.foreground black \ hlist.background white \ hlist.font g_titleFont \ hlist.width 40 \ } grid ${powDWP}saveAsSetup.directory.directoryTree -row 3 -column 0 -columnspan 5 -rowspan 10 -sticky news return } powToplevel ${powDWP}saveAsSetup .pow "-bg $powbg -class \"POW Print\"" bind ${powDWP}saveAsSetup <> "destroy ${powDWP}" wm title ${powDWP}saveAsSetup "Save POW Image/Plot As" grid rowconfigure ${powDWP}saveAsSetup 2 -weight 1 grid columnconfigure ${powDWP}saveAsSetup 0 -weight 1 grid columnconfigure ${powDWP}saveAsSetup 1 -weight 1 frame ${powDWP}saveAsSetup.directory -bg $powbg -bd 2 -relief ridge label ${powDWP}saveAsSetup.directory.dirLabel -text "Directory: " -bg $powbg -font g_titleFont entry ${powDWP}saveAsSetup.directory.saveInEntry -width 35 -bg white -font g_titleFont ${powDWP}saveAsSetup.directory.saveInEntry delete 0 end if { [${powDWP}print.option.direntry get] != "" } { ${powDWP}saveAsSetup.directory.saveInEntry insert end [${powDWP}print.option.direntry get] set directoryValue [${powDWP}print.option.direntry get] } else { ${powDWP}saveAsSetup.directory.saveInEntry insert end [pwd] set directoryValue [pwd] } tixDirTree ${powDWP}saveAsSetup.directory.directoryTree -value $directoryValue \ -browsecmd {powSelectDir} -command {powSelectDir} \ -options { \ hlist.foreground black \ hlist.background white \ hlist.font g_titleFont \ hlist.width 40 \ } set powSelectDirectory $directoryValue grid ${powDWP}saveAsSetup.directory -row 2 -column 0 -sticky news -columnspan 5 -rowspan 10 grid ${powDWP}saveAsSetup.directory.dirLabel -row 2 -column 0 -sticky nw grid ${powDWP}saveAsSetup.directory.saveInEntry -row 2 -column 1 -sticky new grid ${powDWP}saveAsSetup.directory.directoryTree -row 3 -column 0 -columnspan 5 -rowspan 10 -sticky news grid columnconfigure ${powDWP}saveAsSetup.directory 1 -weight 1 grid rowconfigure ${powDWP}saveAsSetup.directory 3 -weight 1 bind ${powDWP}saveAsSetup.directory.saveInEntry { [${powDWP}saveAsSetup.directory.directoryTree subwidget hlist] delete all destroy ${powDWP}saveAsSetup.directory.directoryTree tixDirTree ${powDWP}saveAsSetup.directory.directoryTree \ -value [${powDWP}saveAsSetup.directory.saveInEntry get] \ -browsecmd {powSelectDir} -command {powSelectDir} \ -options { \ hlist.foreground black \ hlist.background white \ hlist.font g_titleFont \ hlist.width 40 \ } grid ${powDWP}saveAsSetup.directory.directoryTree -row 3 -column 0 -columnspan 5 -rowspan 10 -sticky news } frame ${powDWP}saveAsSetup.file -bg $powbg label ${powDWP}saveAsSetup.file.fileNameLbl -text "File name:" -bg $powbg -font g_titleFont entry ${powDWP}saveAsSetup.file.fileNameEntry -width 35 -bg white -font g_titleFont tixComboBox ${powDWP}saveAsSetup.file.convertType -editable true \ -label "Save as type:" \ -options { \ listbox.height 4 \ label.font g_titleFont \ listbox.font g_titleFont \ entry.font g_titleFont \ entry.background white \ entry.width 30 \ entry.ipady 5 \ } \ -command powSelectConvertFormat foreach functionList $powConvertFunction { set formatStr [format "%s - %s" [lindex $functionList 0] [lindex $functionList 3]] ${powDWP}saveAsSetup.file.convertType insert end $formatStr } ${powDWP}saveAsSetup.file.fileNameEntry insert end $powOutputFileName set token [split $powOutputFileName "."] set powOutputFileType {postscript pswrite ps "Postscript Files"} foreach cvf $powConvertFunction { if { [lindex $cvf 2] == [lindex $token 1] } { set powOutputFileType $cvf tixSetSilent ${powDWP}saveAsSetup.file.convertType "[lindex $cvf 0] - [lindex $cvf 3]" break } } grid ${powDWP}saveAsSetup.file -row 13 -column 0 -sticky news -columnspan 5 -rowspan 2 grid ${powDWP}saveAsSetup.file.fileNameLbl -row 0 -column 0 -sticky nw grid ${powDWP}saveAsSetup.file.fileNameEntry -row 0 -column 1 -sticky new grid ${powDWP}saveAsSetup.file.convertType -row 1 -column 0 -sticky nw -columnspan 5 grid columnconfigure ${powDWP}saveAsSetup.file 1 -weight 1 frame ${powDWP}saveAsSetup.action -bg $powbg button ${powDWP}saveAsSetup.action.ok -text "OK" -bg $powbg -font g_titleFont \ -command { \ if ![info exists currentPreviewGraph] { \ set currentPreviewGraph "" ; \ if { $powGraphSelection == "one" } { \ foreach fileCoordList $powGraphCoordList { \ if { [lindex $fileCoordList 5] == $currgn } { \ set currentPreviewGraph [lindex $fileCoordList 0] ; \ break ; \ } ; \ } ; \ } ; \ } ; \ set powOutputFileName [${powDWP}saveAsSetup.file.fileNameEntry get] ; \ set powSelectDirectory [${powDWP}saveAsSetup.directory.saveInEntry get] ; \ ${powDWP}print.option.direntry delete 0 end ; \ ${powDWP}print.option.direntry insert 0 $powSelectDirectory ; \ ${powDWP}print.option.fileentry delete 0 end ; \ ${powDWP}print.option.fileentry insert 0 $powOutputFileName ; \ wm deiconify ${powDWP}print ; \ wm withdraw ${powDWP}saveAsSetup } label ${powDWP}saveAsSetup.action.blanklabel -text " " -bg $powbg -font g_titleFont button ${powDWP}saveAsSetup.action.cancel -text "Cancel" -bg $powbg -font g_titleFont \ -command { wm deiconify ${powDWP}print ; \ wm withdraw ${powDWP}saveAsSetup } grid ${powDWP}saveAsSetup.action -row 18 -column 0 -columnspan 6 -sticky news grid ${powDWP}saveAsSetup.action.ok -row 0 -column 1 -sticky w grid ${powDWP}saveAsSetup.action.blanklabel -row 0 -column 2 -columnspan 2 -sticky news grid ${powDWP}saveAsSetup.action.cancel -row 0 -column 4 -sticky e } proc powSelectConvertFormat { item } { global powOutputFileType powDWP global powOutputFileName powConvertFunction regsub -all " " $item "" result set token [split $result "-"] if { ![winfo exists ${powDWP}saveAsSetup.file.fileNameEntry] && \ ![winfo exists ${powDWP}print.option.fileentry] } { set fileName "powGraph" } else { if { [winfo exists ${powDWP}print.option.fileentry] && [winfo ismapped ${powDWP}print.option.fileentry] } { set fileName [lindex [split [${powDWP}print.option.fileentry get] "."] 0] } if { [winfo exists ${powDWP}saveAsSetup.file.fileNameEntry] && [winfo ismapped ${powDWP}saveAsSetup.file.fileNameEntry] } { set fileName [lindex [split [${powDWP}saveAsSetup.file.fileNameEntry get] "."] 0] } } foreach functionList $powConvertFunction { if { [lindex $token 0] == [lindex $functionList 0] } { set powOutputFileType $functionList set powOutputFileName [format "%s.%s" $fileName [lindex $functionList 2]] break } } if [winfo exists ${powDWP}saveAsSetup.file.fileNameEntry] { ${powDWP}saveAsSetup.file.fileNameEntry delete 0 end ${powDWP}saveAsSetup.file.fileNameEntry insert end $powOutputFileName } if [winfo exists ${powDWP}print.option.fileentry] { ${powDWP}print.option.fileentry delete 0 end ${powDWP}print.option.fileentry insert end $powOutputFileName } } proc powSetupPage {} { global powDWP powbg global powOutputPaperSize g_titleFont powStretch global powPaperSizeSelected powHandles powPostOrient powPlacement global old_powPaperSizeSelected old_powPostOrient old_powPlacement global powGraphSelection if [winfo exists ${powDWP}printPageSetup] { destroy ${powDWP}printPageSetup } powToplevel ${powDWP}printPageSetup .pow "-bg $powbg -class \"POW Print\"" bind ${powDWP}printPageSetup <> "destroy ${powDWP}" wm title ${powDWP}printPageSetup "Page Setup" tixComboBox ${powDWP}printPageSetup.papersize -editable true \ -label "Paper Size:" \ -options { \ listbox.height 4 \ label.font g_titleFont \ listbox.font g_titleFont \ entry.font g_titleFont \ entry.background white \ entry.ipady 5 \ } \ -command powPaperSizeSelection foreach [list name xSizeInch ySizeInch xSizePixel ySizePixel xPt yPt ] $powOutputPaperSize { ${powDWP}printPageSetup.papersize insert end $name } set old_powPaperSizeSelected Letter if [info exists powPaperSizeSelected] { set old_powPaperSizeSelected $powPaperSizeSelected tixSetSilent ${powDWP}printPageSetup.papersize $powPaperSizeSelected } else { tixSetSilent ${powDWP}printPageSetup.papersize Letter set powPaperSizeSelected Letter } grid ${powDWP}printPageSetup.papersize -row 1 -column 0 -sticky w -columnspan 6 image create bitmap landscapeIcon -data { #define landscape_width 41 #define landscape_height 36 static char landscape_bits[] = { 0x00,0x00,0x00,0x00,0x00,0xfe,0x00,0x00,0x00,0x00,0x00,0xfe,0x00,0x00,0x00, 0x00,0x00,0xfe,0x00,0x00,0x00,0x00,0x00,0xfe,0x00,0x00,0x00,0x00,0x00,0xfe, 0x00,0x00,0x00,0x00,0x00,0xfe,0x00,0x00,0x00,0x00,0x00,0xfe,0xf0,0xff,0xff, 0x1f,0x00,0xfe,0x10,0x00,0x00,0x30,0x00,0xfe,0x10,0x00,0x00,0x50,0x00,0xfe, 0x10,0x00,0x06,0x90,0x00,0xfe,0x10,0x00,0x06,0x10,0x01,0xfe,0x10,0x00,0x0f, 0x10,0x02,0xfe,0x10,0x00,0x0f,0xf0,0x07,0xfe,0x10,0x80,0x1d,0x00,0x0c,0xfe, 0x10,0x80,0x1c,0x00,0x04,0xfe,0x10,0xc0,0x3c,0x00,0x0c,0xfe,0x10,0x40,0x38, 0x00,0x04,0xfe,0x10,0x60,0x78,0x00,0x0c,0xfe,0x10,0x20,0x70,0x00,0x04,0xfe, 0x10,0xf0,0xff,0x00,0x0c,0xfe,0x10,0x10,0xe0,0x00,0x04,0xfe,0x10,0x18,0xe0, 0x01,0x0c,0xfe,0x10,0x08,0xc0,0x01,0x04,0xfe,0x10,0x0c,0xc0,0x03,0x0c,0xfe, 0x10,0x3f,0xf0,0x0f,0x04,0xfe,0x10,0x00,0x00,0x00,0x0c,0xfe,0x10,0x00,0x00, 0x00,0x04,0xfe,0x10,0x00,0x00,0x00,0x0c,0xfe,0x10,0x00,0x00,0x00,0x04,0xfe, 0xf0,0xff,0xff,0xff,0x0f,0xfe,0x50,0x55,0x55,0x55,0x05,0xfe,0x00,0x00,0x00, 0x00,0x00,0xfe,0x00,0x00,0x00,0x00,0x00,0xfe,0x00,0x00,0x00,0x00,0x00,0xfe, 0x00,0x00,0x00,0x00,0x00,0xfe}; } image create bitmap portraitIcon -data { #define portrait_width 40 #define portrait_height 37 static char portrait_bits[] = { 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, 0x00,0x00,0x00,0x00,0x00,0x80,0xff,0xff,0x03,0x00,0x80,0x00,0x00,0x06,0x00, 0x80,0x00,0x00,0x0a,0x00,0x80,0x00,0x00,0x12,0x00,0x80,0x00,0x00,0x22,0x00, 0x80,0x00,0x00,0x42,0x00,0x80,0x00,0x00,0xfe,0x00,0x80,0x00,0x18,0x80,0x01, 0x80,0x00,0x18,0x80,0x00,0x80,0x00,0x3c,0x80,0x01,0x80,0x00,0x3c,0x80,0x00, 0x80,0x00,0x76,0x80,0x01,0x80,0x00,0x72,0x80,0x00,0x80,0x00,0xf3,0x80,0x01, 0x80,0x00,0xe1,0x80,0x00,0x80,0x80,0xe1,0x81,0x01,0x80,0x80,0xc0,0x81,0x00, 0x80,0xc0,0xff,0x83,0x01,0x80,0x40,0x80,0x83,0x00,0x80,0x60,0x80,0x87,0x01, 0x80,0x20,0x00,0x87,0x00,0x80,0x30,0x00,0x8f,0x01,0x80,0xfc,0xe0,0xbf,0x00, 0x80,0x00,0x00,0x80,0x01,0x80,0x00,0x00,0x80,0x00,0x80,0x00,0x00,0x80,0x01, 0x80,0x00,0x00,0x80,0x00,0x80,0x00,0x00,0x80,0x01,0x80,0x00,0x00,0x80,0x00, 0x80,0x00,0x00,0x80,0x01,0x80,0xff,0xff,0xff,0x00,0x00,0x55,0x55,0x55,0x01, 0x00,0x00,0x00,0x00,0x00}; } frame ${powDWP}printPageSetup.orientation -bg $powbg -bd 2 label ${powDWP}printPageSetup.orientationframelabel -text Orientation -bg $powbg -font g_titleFont label ${powDWP}printPageSetup.orientation.blanklabel -text " " -bg $powbg -font g_titleFont label ${powDWP}printPageSetup.orientation.blankcolumn -text " " -bg $powbg -font g_titleFont label ${powDWP}printPageSetup.orientation.iconlabel -image portraitIcon label ${powDWP}printPageSetup.orientation.blanklbl2 -text " " -bg $powbg -font g_titleFont label ${powDWP}printPageSetup.orientation.blanklbl1 -text " " -bg $powbg -font g_titleFont radiobutton ${powDWP}printPageSetup.orientation.portrait -text Portrait -value 0 \ -variable powPostOrient -font g_titleFont \ -command { \ ${powDWP}printPageSetup.orientation.iconlabel configure -image portraitIcon ; \ } radiobutton ${powDWP}printPageSetup.orientation.landscape -text Landscape -value 1 \ -variable powPostOrient -font g_titleFont \ -command { \ ${powDWP}printPageSetup.orientation.iconlabel configure -image landscapeIcon ; \ } grid ${powDWP}printPageSetup.orientation.blanklbl1 -row 1 -column 0 -sticky sw grid ${powDWP}printPageSetup.orientation -row 2 -column 0 -columnspan 2 -sticky news -rowspan 4 grid ${powDWP}printPageSetup.orientationframelabel -row 2 -column 0 -sticky nw grid ${powDWP}printPageSetup.orientation.iconlabel -row 2 -column 0 -sticky news -rowspan 2 grid ${powDWP}printPageSetup.orientation.blankcolumn -row 2 -column 1 -sticky news -rowspan 2 grid ${powDWP}printPageSetup.orientation.portrait -row 2 -column 2 -sticky w -columnspan 2 grid ${powDWP}printPageSetup.orientation.landscape -row 3 -column 2 -sticky w -columnspan 2 grid ${powDWP}printPageSetup.orientation.blanklbl2 -row 4 -column 0 -sticky sw set old_powPostOrient 0 if [info exists powPostOrient] { if { $powPostOrient == "" } { set powPostOrient 0 } else { set old_powPostOrient $powPostOrient } } else { ${powDWP}printPageSetup.orientation.portrait select } frame ${powDWP}printPageSetup.placement -bg $powbg -bd 2 label ${powDWP}printPageSetup.placementlabel -text "Placement" -bg $powbg -font g_titleFont label ${powDWP}printPageSetup.placement.blanklabel -text " " -bg $powbg -font g_titleFont radiobutton ${powDWP}printPageSetup.placement.placementFOOP -text "Fit on one page" \ -value "FOOP" -variable powPlacement -font g_titleFont radiobutton ${powDWP}printPageSetup.placement.placementBFMP -text "Best Fit on multiple pages" \ -value "BFMP" -variable powPlacement -font g_titleFont radiobutton ${powDWP}printPageSetup.placement.placementOGPP -text "One graph per page" \ -value "OGPP" -variable powPlacement -font g_titleFont grid ${powDWP}printPageSetup.placement -row 6 -column 0 -columnspan 4 -sticky news \ -rowspan 6 grid ${powDWP}printPageSetup.placementlabel -row 6 -column 0 -sticky nw grid ${powDWP}printPageSetup.placement.blanklabel -row 1 -column 0 -sticky nw grid ${powDWP}printPageSetup.placement.placementFOOP -row 2 -column 0 -sticky nw grid ${powDWP}printPageSetup.placement.placementBFMP -row 3 -column 0 -sticky nw grid ${powDWP}printPageSetup.placement.placementOGPP -row 4 -column 0 -sticky nw set old_powPlacement "FOOP" if [info exists powPlacement] { if { $powPlacement == "" } { set powPlacement "FOOP" } else { set old_powPlacement $powPlacement } } else { ${powDWP}printPageSetup.placement.placementFOOP select } # set powGraphSelection all set pwoStretch "no" frame ${powDWP}printPageSetup.action -bg $powbg button ${powDWP}printPageSetup.action.ok -text "OK" -bg $powbg -font g_titleFont \ -command { \ if [winfo exists ${powDWP}printPreview] { \ powPrintPreview ; \ } else { \ set resp [tk_messageBox -icon info \ -type yesno \ -message "Would you like to preview images?" \ -title "Ask"] ; \ if { $resp=="yes" } { \ powPrintPreview \ } ; \ } ; \ destroy ${powDWP}printPageSetup } label ${powDWP}printPageSetup.action.blanklabel -text " " -bg $powbg -font g_titleFont button ${powDWP}printPageSetup.action.cancel -text "Cancel" -bg $powbg -font g_titleFont \ -command { \ set powPaperSizeSelected $old_powPaperSizeSelected ; \ set powPostOrient $old_powPostOrient ; \ set powPlacement $old_powPlacement ; \ destroy ${powDWP}printPageSetup } grid ${powDWP}printPageSetup.action -row 13 -column 0 -columnspan 6 -sticky news grid ${powDWP}printPageSetup.action.ok -row 0 -column 1 -sticky w grid ${powDWP}printPageSetup.action.blanklabel -row 0 -column 2 -columnspan 2 -sticky news grid ${powDWP}printPageSetup.action.cancel -row 0 -column 4 -sticky e } proc toggleFitToPageButton {} { global powDWP global currentPreviewState set currentPreviewState [${powDWP}printPreview.action.imageSize cget -text] if { $currentPreviewState == "Original Size" } { ${powDWP}printPreview.action.imageSize configure -text "Fit to Page" powFitToPage [${powDWP}printPreview.action.page.pageNumber get] no } else { ${powDWP}printPreview.action.imageSize configure -text "Original Size" powFitToPage [${powDWP}printPreview.action.page.pageNumber get] yes } } proc powPrintPreview {} { global powDWP powbg global ghostScript searchPath global previewNameList global g_titleFont global currentPreviewGraph global powPaperSizeSelected global powPaperSizeList global powOutputPaperSize global powStretch global powPostOrient global currentPreviewGraph global powGraphSelection global currentPreviewState if [winfo exists ${powDWP}printPreview] { destroy ${powDWP}printPreview } powShowHandles 0 powToplevel ${powDWP}printPreview .pow "-bg $powbg -class \"POW Print\"" bind ${powDWP}printPreview <> "destroy ${powDWP}" wm title ${powDWP}printPreview "Print Preview" wm geometry ${powDWP}printPreview +150+0 bind ${powDWP}printPreview { global previewNameList foreach nameList $previewNameList { catch { file delete -force [lindex $nameList 0] } catch { file delete -force [lindex $nameList 1] } } } frame ${powDWP}printPreview.action button ${powDWP}printPreview.action.imageSize -text "Fit to Page" -bg $powbg -font g_titleFont \ -command toggleFitToPageButton button ${powDWP}printPreview.action.print -text "Print" -bg $powbg -font g_titleFont \ -command { powPrintBox preview } button ${powDWP}printPreview.action.setup -text "Page Setup" -bg $powbg -font g_titleFont \ -command { powSetupPage } image create bitmap pointLeftIcon -data { #define pointLeft_width 24 #define pointLeft_height 20 static char pointLeft_bits[] = { 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x08,0x00,0x00,0x0c,0x00,0x00,0x0a,0x00, 0x00,0x09,0x00,0x80,0xf8,0x0f,0x40,0x00,0x08,0x60,0x00,0x08,0x70,0x00,0x08, 0xf0,0x01,0x08,0xc0,0x02,0x08,0xc0,0xff,0x0f,0x00,0x5b,0x05,0x00,0x0f,0x00, 0x00,0x0c,0x00,0x00,0x0c,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00 }; } image create bitmap pointRightIcon -data { #define pointRight_width 24 #define pointRight_height 20 static char pointRight_bits[] = { 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x10,0x00,0x00,0x30,0x00,0x00,0x50,0x00, 0x00,0x90,0x00,0xf0,0x1f,0x01,0x10,0x00,0x02,0x10,0x00,0x06,0x10,0x00,0x0e, 0x10,0x80,0x0f,0x10,0x40,0x03,0xf0,0xff,0x03,0xa0,0xda,0x00,0x00,0xf0,0x00, 0x00,0x30,0x00,0x00,0x30,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00 }; } frame ${powDWP}printPreview.action.page -bg $powbg button ${powDWP}printPreview.action.page.previous -image pointLeftIcon \ -command { \ ${powDWP}printPreview.action.page.next configure -state normal ; \ set idx [${powDWP}printPreview.action.page.pageNumber get] ; \ incr idx -1 ; \ if { $idx <= 1 } { \ set idx 1 ; \ ${powDWP}printPreview.action.page.previous configure -state disable ; \ } ; \ ${powDWP}printPreview.action.page.pageNumber delete 0 end ; \ ${powDWP}printPreview.action.page.pageNumber insert end $idx ; \ powShowPreviewGraph [expr $idx - 1] } label ${powDWP}printPreview.action.page.pageNumberLbl1 -text "Page: " -bg $powbg -font g_titleFont entry ${powDWP}printPreview.action.page.pageNumber -width 2 -bg white -font g_titleFont -fg blue label ${powDWP}printPreview.action.page.pageNumberLbl2 -text "" -bg $powbg -font g_titleFont button ${powDWP}printPreview.action.page.next -image pointRightIcon \ -command { \ ${powDWP}printPreview.action.page.previous configure -state normal ; \ set idx [${powDWP}printPreview.action.page.pageNumber get] ; \ incr idx ; \ if { $idx >= [llength $previewNameList] } { \ ${powDWP}printPreview.action.page.next configure -state disable ; \ set idx [llength $previewNameList] ; \ } ; \ ${powDWP}printPreview.action.page.pageNumber delete 0 end ; \ ${powDWP}printPreview.action.page.pageNumber insert end $idx ; \ powShowPreviewGraph [expr $idx - 1] } grid ${powDWP}printPreview.action.page.previous -row 0 -column 0 -sticky w grid ${powDWP}printPreview.action.page.pageNumberLbl1 -row 0 -column 1 -sticky w grid ${powDWP}printPreview.action.page.pageNumber -row 0 -column 2 -sticky w grid ${powDWP}printPreview.action.page.pageNumberLbl2 -row 0 -column 3 -sticky w grid ${powDWP}printPreview.action.page.next -row 0 -column 4 -sticky w button ${powDWP}printPreview.action.cancel -text "Close" -bg $powbg -font g_titleFont \ -command { set currentPreviewGraph "" ; \ set powStretch no ; \ destroy ${powDWP}printPreview } grid ${powDWP}printPreview.action -row 0 -column 0 -columnspan 20 -sticky news grid ${powDWP}printPreview.action.print -row 0 -column 0 -sticky w -padx 5 -columnspan 2 grid ${powDWP}printPreview.action.imageSize -row 0 -column 2 -sticky w -padx 5 -columnspan 2 grid ${powDWP}printPreview.action.setup -row 0 -column 6 -sticky w -padx 5 -columnspan 2 grid ${powDWP}printPreview.action.page -row 0 -column 8 -sticky ew -padx 5 -columnspan 5 grid ${powDWP}printPreview.action.cancel -row 0 -column 13 -sticky e -padx 5 -columnspan 2 canvas ${powDWP}printPreview.preview \ -xscrollcommand [list ${powDWP}printPreview.xscroll set] \ -yscrollcommand [list ${powDWP}printPreview.yscroll set] \ -background white \ -highlightthickness 0 \ -borderwidth 0 \ -scrollregion { 0 0 1024 768 } scrollbar ${powDWP}printPreview.xscroll -orient horizontal \ -command [list ${powDWP}printPreview.preview xview] scrollbar ${powDWP}printPreview.yscroll -orient vertical \ -command [list ${powDWP}printPreview.preview yview] grid ${powDWP}printPreview.preview -row 1 -column 0 -rowspan 10 -columnspan 15 -sticky news grid ${powDWP}printPreview.yscroll -row 1 -column 13 -rowspan 11 -sticky ns grid ${powDWP}printPreview.xscroll -row 11 -column 0 -sticky ew grid rowconfigure ${powDWP}printPreview 1 -weight 1 grid columnconfigure ${powDWP}printPreview 0 -weight 1 ${powDWP}printPreview.preview create text 225 100 \ -anchor center -tags deleteMe -text "Building graph... Please wait..." \ -font [list Helvetica 12 bold] -fill red ${powDWP}printPreview configure -cursor watch update idletask foreach [list name xIn yIn xPix yPix xPt yPt] $powOutputPaperSize { if { $powPaperSizeSelected == $name } { break } } set powPaperSizeList [list $name $xIn $yIn $xPix $yPix] set powGraphSelection "all" set fileNameList [powAssemblePSfile] set idx -1 set previewNameList {} #puts "paper size selected: $powPaperSizeSelected" foreach fileName $fileNameList { set previewName "[expr [pid] + $idx]preview.ppm" set errorFlag [ catch { exec $ghostScript -sDEVICE=ppmraw \ -dNOPAUSE -dBATCH -dQUIET \ -sPAPERSIZE=[string tolower $powPaperSizeSelected] \ -I$searchPath \ -sOutputFile=$::env(PSTMPDIR)/$previewName $fileName } result ] if { !$errorFlag } { lappend previewNameList [list $::env(PSTMPDIR)/$previewName $fileName] } incr idx } set currentPreviewGraph [lindex [lindex $previewNameList 0] 1] # show the first page, sequential pages will be toggle by GUI powShowPreviewGraph 0 ${powDWP}printPreview.action.page.pageNumber delete 0 end ${powDWP}printPreview.action.page.pageNumber insert end 1 ${powDWP}printPreview.action.page.previous configure -state disable ${powDWP}printPreview.action.page.pageNumberLbl2 configure -text "of [llength $previewNameList]" if { [llength $previewNameList] == 1 } { ${powDWP}printPreview.action.page.next configure -state disable } if [info exists currentPreviewState] { if { $currentPreviewState == "Original Size" } { ${powDWP}printPreview.action.imageSize configure -text "Fit to Page" powFitToPage 1 no } else { ${powDWP}printPreview.action.imageSize configure -text "Original Size" powFitToPage 1 yes } } ${powDWP}printPreview configure -cursor {} powShowHandles 1 } proc powFitToPage { page stretch } { global powStretch global previewNameList global powDWP global powGraphCoordList global powOutputPaperSize global currentPreviewGraph global powPaperSizeSelected global powPaperSizeList global ghostScript global searchPath global currentPreviewState global powOutputPaperXsizePoint powOutputPaperYsizePoint ${powDWP}printPreview.preview delete deleteMe ${powDWP}printPreview.preview create text 300 300 \ -anchor center -tags deleteMe -text "Rebuilding graph... Please wait..." \ -font [list Helvetica 12 bold] -fill red ${powDWP}printPreview configure -cursor watch update idletask powShowHandles 0 foreach nameList $previewNameList { catch { file delete -force [lindex $nameList 0] } catch { file delete -force [lindex $nameList 1] } } set powStretch $stretch set fileNameList [powAssemblePSfile] set idx -1 set previewNameList {} foreach fileName $fileNameList { set previewName "[expr [pid] + $idx]preview.ppm" set errorFlag [ catch { exec $ghostScript -sDEVICE=ppmraw \ -dNOPAUSE -dBATCH -dQUIET \ -dDEVICEWIDTHPOINTS=$powOutputPaperXsizePoint \ -dDEVICEHEIGHTPOINTS=$powOutputPaperYsizePoint \ -I$searchPath \ -sOutputFile=$::env(PSTMPDIR)/$previewName $fileName } result ] if { !$errorFlag } { lappend previewNameList [list $::env(PSTMPDIR)/$previewName $fileName] } incr idx } #puts "powFitToPage, previewNameList: $previewNameList" #puts "powFitToPage, page: $page" set currentPreviewGraph [lindex [lindex $previewNameList [expr $page - 1]] 1] # show the current page, sequential pages will be toggle by GUI powShowPreviewGraph [expr $page - 1] ${powDWP}printPreview.action.page.pageNumber delete 0 end ${powDWP}printPreview.action.page.pageNumber insert end $page if { $page <= 1 } { ${powDWP}printPreview.action.page.previous configure -state disable } ${powDWP}printPreview.action.page.pageNumberLbl2 configure -text "of [llength $previewNameList]" if { [llength $previewNameList] == 1 } { ${powDWP}printPreview.action.page.next configure -state disable } if { $stretch == "yes" } { set currentPreviewState "Fit to Page" ${powDWP}printPreview.action.imageSize configure -text "Original Size" } else { set currentPreviewState "Original Size" ${powDWP}printPreview.action.imageSize configure -text "Fit to Page" } ${powDWP}printPreview configure -cursor {} powShowHandles 1 } proc powShowPreviewGraph { page } { global previewNameList global powDWP global powGraphCoordList global currentPreviewGraph global powPaperSizeList global powPostOrient global powCurrentPreviewPage set powCurrentPreviewPage $page set param [lindex $powGraphCoordList $page] set fileName [lindex $param 0] set width [lindex $param 1] set height [lindex $param 2] set xCoord [lindex $param 3] set yCoord [lindex $param 4] set orgFileName [lindex $param 5] #puts "page: $page" #puts "previewNameList: $previewNameList" set currentPreviewGraph [lindex [lindex $previewNameList $page] 1] set errorFlag [ catch { set im [ image create photo -file [lindex [lindex $previewNameList $page] 0]] } err ] if { $errorFlag } { tk_messageBox -icon warning -type ok -message "Bummper!!!" return } set imWidth [image width $im] set displayWidth $imWidth #puts "imWidth: $imWidth" #puts "screenwidth: [winfo screenwidth .]" if { [expr [winfo screenwidth .] - 10 ] < $displayWidth } { set displayWidth [expr [winfo screenwidth .] - 10 ] } set imHeight [image height $im] set displayHeight $imHeight if { [expr [winfo screenheight .] - 60 ] < $displayHeight } { set displayHeight [expr [winfo screenheight .] - 60 ] } ${powDWP}printPreview.preview delete deleteMe ${powDWP}printPreview.preview create image 0 0 -image $im -anchor nw -tags deleteMe set regionList [list 0 0 $imWidth $imHeight] #grid ${powDWP}printPreview.yscroll -row 0 -column 12 -rowspan 10 -sticky ns #grid ${powDWP}printPreview.xscroll -row 10 -column 0 -columnspan 12 -sticky ew ${powDWP}printPreview.preview configure -scrollregion $regionList \ -width $displayWidth \ -height $displayHeight if { $imWidth == $displayWidth } { grid forget ${powDWP}printPreview.xscroll } if { $imHeight == $displayHeight } { grid forget ${powDWP}printPreview.yscroll } } proc powPaperSizeSelection { item } { global powPaperSizeSelected set powPaperSizeSelected $item } proc powSelectDir { dir } { global powSelectDirectory powDWP set powSelectDirectory $dir ${powDWP}saveAsSetup.directory.saveInEntry delete 0 end ${powDWP}saveAsSetup.directory.saveInEntry insert end $powSelectDirectory } proc powExtractGraph { {graph ""} } { global currgn powGraphSelection if ![info exists powGraphSelection] { set powGraphSelection "all" } if { $powGraphSelection == "all" } { set selection all } if { $graph == "" } { if { $powGraphSelection != "all" } { set selection $currgn } } else { set selection $graph } set bbox [.pow.pow bbox $selection] if { [llength $bbox] <= 0 } { return [list 0 0 0 0] } set width [expr [lindex $bbox 2]-[lindex $bbox 0]] set height [expr [lindex $bbox 3]-[lindex $bbox 1]] #puts " width : $width" #puts " height : $height" #puts " bbox : $bbox" #puts " xCoord : [lindex $bbox 0]" #puts " yCoord : [lindex $bbox 1]" return [list $width $height [lindex $bbox 0] [lindex $bbox 1]] } proc powSelectPaper { {orient 0} } { global powPaperSizeSelected powOutputPaperSize global powPaperDefXsizeInch powPaperDefYsizeInch global powPaperDefXsizePixel powPaperDefYsizePixel global powPaperDefXsizePoint powPaperDefYsizePoint global powOutputPaperXsizeInch powOutputPaperYsizeInch global powOutputPaperXsizePixel powOutputPaperYsizePixel global powOutputPaperXsizePoint powOutputPaperYsizePoint foreach [list name powPaperDefXsizeInch powPaperDefYsizeInch \ powPaperDefXsizePixel powPaperDefYsizePixel \ powPaperDefXsizePoint powPaperDefYsizePoint ] $powOutputPaperSize { if { $name == $powPaperSizeSelected } { set powOutputPaperXsizeInch $powPaperDefXsizeInch set powOutputPaperYsizeInch $powPaperDefYsizeInch set powOutputPaperXsizePixel $powPaperDefXsizePixel set powOutputPaperYsizePixel $powPaperDefYsizePixel set powOutputPaperXsizePoint $powPaperDefXsizePoint set powOutputPaperYsizePoint $powPaperDefYsizePoint break } } } proc powDetermineGraphDirection { dataList { directionOnly "no"} } { global powPaperDefXsizePixel powPaperDefYsizePixel global powStretch set direction "Y" set pfileName "none" set pwidth "none" set pheight "none" set pxCoord "none" set pyCoord "none" set porgFileName "none" foreach param $dataList { set fileName [lindex $param 0] set width [lindex $param 1] set height [lindex $param 2] set xCoord [lindex $param 3] set yCoord [lindex $param 4] set orgFileName [lindex $param 5] if { $pfileName == "none" } { set pfileName [lindex $param 0] set pwidth [lindex $param 1] set pheight [lindex $param 2] set pxCoord [lindex $param 3] set pyCoord [lindex $param 4] set porgFileName [lindex $param 5] } else { if { [expr $pxCoord + $pwidth] <= $xCoord } { set direction "X" } break } } if { $direction == "Y" } { set dataList [lsort -real -increasing -index 4 $dataList ] } #puts "direction: $direction" #puts "$dataList" if { $directionOnly == "yes" } { return $direction } set start_xCoord 0.0 set start_yCoord 0.0 # start breaking the graphList set resultList {} set idx 0 set subListFile "psTemp" set subListFormat "ps" # first ps file name set subListFileName [format "%s/%s_%s.%s" $::env(PSTMPDIR) $subListFile $idx $subListFormat] set resultSubList {} foreach param $dataList { set fileName [lindex $param 0] set width [lindex $param 1] set height [lindex $param 2] set xCoord [lindex $param 3] set yCoord [lindex $param 4] set orgFileName [lindex $param 5] #puts "s fileName: $fileName" #puts "s width: $width" #puts "s height: $height" #puts "s xCoord: $xCoord" #puts "s yCoord: $yCoord" #puts "s powPaperDefXsizePixel: $powPaperDefXsizePixel" #puts "s powPaperDefYsizePixel: $powPaperDefYsizePixel" if { $start_xCoord == 0.0 } { set start_xCoord $xCoord set start_yCoord $yCoord set max_width $width set max_height $height } set testResult "false" #puts "powPaperDefXsizePixel: $powPaperDefXsizePixel" #puts "powPaperDefYsizePixel: $powPaperDefYsizePixel" if { $direction == "X" } { #puts "X: $xCoord + $width - $start_xCoord: [expr $xCoord + $width - $start_xCoord]" if { [expr $xCoord + $width - $start_xCoord] < $powPaperDefXsizePixel} { set resultSubList {} lappend resultSubList $subListFileName lappend resultSubList [expr $xCoord + $width - $start_xCoord] if { $height > $max_height } { set max_height $height } } else { lappend resultSubList $max_height lappend resultSubList $start_xCoord lappend resultSubList $start_yCoord incr idx #puts "X resultSubList: $resultSubList" lappend resultList $resultSubList set resultSubList {} set subListFileName [format "%s/%s_%s.%s" $::env(PSTMPDIR) $subListFile $idx $subListFormat] lappend resultSubList $subListFileName lappend resultSubList $width set start_xCoord $xCoord set start_yCoord $yCoord set max_width $width set max_height $height } } else { #puts "Y: $yCoord + $height - $start_yCoord: [expr $yCoord + $height - $start_yCoord]" if { [expr $yCoord + $height - $start_yCoord] < $powPaperDefYsizePixel} { set resultSubList {} lappend resultSubList $subListFileName if { $width > $max_width } { set max_width $width } lappend resultSubList $max_width lappend resultSubList [expr $yCoord + $height - $start_yCoord] } else { lappend resultSubList $start_xCoord lappend resultSubList $start_yCoord incr idx #puts "Y resultSubList: $resultSubList" lappend resultList $resultSubList set resultSubList {} set subListFileName [format "%s/%s_%s.%s" $::env(PSTMPDIR) $subListFile $idx $subListFormat] lappend resultSubList $subListFileName lappend resultSubList $width lappend resultSubList $height set start_xCoord $xCoord set start_yCoord $yCoord set max_width $width set max_height $height } } } if { [llength $resultSubList] != 5 } { # make sure the incomplete list finished. if { $direction == "X" } { lappend resultSubList $max_height } lappend resultSubList $start_xCoord lappend resultSubList $start_yCoord lappend resultList $resultSubList } #puts $resultList return $resultList } proc powCombineGraph { master } { } proc powAssemblePSfile {{graph {}}} { global powSelectDirectory global powGraphSelection global powbg pcom_fname global powStretch powOutputPaperSize global powConvertFormat powConvertFunction global powHandles powDWP g_titleFont global powPaperDefXsizeInch powPaperDefYsizeInch global powPaperDefXsizePixel powPaperDefYsizePixel global powOutputPaperXsizeInch powOutputPaperYsizeInch global powOutputPaperXsizePixel powOutputPaperYsizePixel global powPlacement powPostOrient global powPaperSizeSelected powPixelToInchRatio global powGraphCoordList global ghostScript global powOutputFileType global tcl_platform global searchPath set tempList [powListGraphs] set px 99999999 set py 99999999 # reverse the order so the graphList has the order of graph been created set graphList {} if { [llength $graph] == 0 } { foreach graph $tempList { if { [string first "scope" $graph] >= 0 } continue set bboxToken [.pow.pow bbox $graph] if { [llength $bboxToken] <= 0 } continue foreach [list x1 y1 x2 y2] [.pow.pow bbox $graph] {} if { $x1 < $px } { set graphList [linsert $graphList 0 $graph] set px $x1 set py $y1 } else { if { $y1 < $py } { set graphList [linsert $graphList 0 $graph] set px $x1 set py $y1 } else { lappend graphList $graph } } } } else { set graphList $graph } set idx -1 set psNameList {} set allCoordList {} #################################################### # selectedGraphCoord is either all or selected graph #################################################### set selectedGraphCoord [powExtractGraph] #################################################### # allCoordList contains all graph's coordination #################################################### if ![info exists powPostOrient] { set powPostOrient 0 } if ![info exists powPlacement] { set powPlacement FOOP } if ![info exists powStretch] { set powStretch "no" } if ![info exists powPaperSizeSelected] { set powPaperSizeSelected "Letter" } #puts "powPostOrient: $powPostOrient" #puts "powStretch : $powStretch" #puts "powPlacement : $powPlacement" powSelectPaper $powPostOrient switch -exact $powPlacement { "FOOP" { # fit on one page set tname "[pid]FOOPextract.ps" set width [lindex $selectedGraphCoord 0] set height [lindex $selectedGraphCoord 1] set xCoord [lindex $selectedGraphCoord 2] set yCoord [lindex $selectedGraphCoord 3] lappend psNameList [list $::env(PSTMPDIR)/$tname $width $height $xCoord $yCoord all] } "BFMP" { # best fit on mulitple pages set findColorBar false foreach graph $graphList { if { [string first "scope" $graph] >= 0 } continue if { [string first "colorbar" $graph] >= 0 } { set findColorBar true continue } set resultGraphCoord [powExtractGraph $graph] set tname "[expr [pid] + $idx]BFMPextract.ps" set width [lindex $resultGraphCoord 0] set height [lindex $resultGraphCoord 1] set xCoord [lindex $resultGraphCoord 2] set yCoord [lindex $resultGraphCoord 3] lappend psNameList [list $::env(PSTMPDIR)/$tname $width $height $xCoord $yCoord $graph] incr idx } if { $findColorBar == "true" } { foreach graph $graphList { set idx [string first "colorbar" $graph] if { [string first "colorbar" $graph] >= 0 } { set masterKey [string range $graph 0 [expr $idx - 2]] set resultGraphCoord [powExtractGraph $graph] set width [lindex $resultGraphCoord 0] set height [lindex $resultGraphCoord 1] set xCoord [lindex $resultGraphCoord 2] set yCoord [lindex $resultGraphCoord 3] set x1Coord [expr $xCoord + $width] set y1Coord [expr $yCoord + $height] set idx 0 foreach token $psNameList { set name [lindex $token 0] set w [lindex $token 1] set h [lindex $token 2] set x [lindex $token 3] set y [lindex $token 4] set g [lindex $token 5] if { $g == $masterKey } { set x1 [expr $x + $w] set y1 [expr $y + $h] if { $x1Coord > $x1 && $xCoord < $x } { # colorbar is larger than the graph set x $xCoord set w $width } elseif { $x1Coord > $x1 && $xCoord > $x } { set w [expr $x1Coord - $x] } elseif { $x1Coord < $x1 && $xCoord > $x } { # don't do anything } else { # x1Coord < x1 && xCoord < $x set w [expr $x1 - $xCoord] } if { $y1Coord > $y1 && $yCoord < $y } { # colorbar is larger than the graph set y $yCoord set h $height } elseif { $y1Coord > $y1 && $yCoord > $y } { set h [expr $y1Coord - $y] } elseif { $y1Coord < $y1 && $yCoord > $y } { # don't do anything } else { # y1Coord < y1 && yCoord < $y set h [expr $y1 - $yCoord] } set newList [list $name $w $h $x $y $g] set psNameList [lreplace $psNameList $idx $idx $newList] break } incr idx } } } } if { $idx > 0 } { # more than one graph on the canvas # sort against X direction first set psNameList [lsort -real -increasing -index 3 $psNameList ] set psNameList [powDetermineGraphDirection $psNameList] } } "OGPP" { # one graph per page set findColorBar false foreach graph $graphList { if { [string first "scope" $graph] >= 0 } continue if { [string first "colorbar" $graph] >= 0 } { set findColorBar true continue } set resultGraphCoord [powExtractGraph $graph] set tname "[expr [pid] + $idx]OGPPextract.ps" set width [lindex $resultGraphCoord 0] set height [lindex $resultGraphCoord 1] set xCoord [lindex $resultGraphCoord 2] set yCoord [lindex $resultGraphCoord 3] lappend psNameList [list $::env(PSTMPDIR)/$tname $width $height $xCoord $yCoord $graph] incr idx } if { $findColorBar == "true" } { foreach graph $graphList { set idx [string first "colorbar" $graph] if { [string first "colorbar" $graph] >= 0 } { set masterKey [string range $graph 0 [expr $idx - 2]] set resultGraphCoord [powExtractGraph $graph] set width [lindex $resultGraphCoord 0] set height [lindex $resultGraphCoord 1] set xCoord [lindex $resultGraphCoord 2] set yCoord [lindex $resultGraphCoord 3] set x1Coord [expr $xCoord + $width] set y1Coord [expr $yCoord + $height] set idx 0 foreach token $psNameList { set name [lindex $token 0] set w [lindex $token 1] set h [lindex $token 2] set x [lindex $token 3] set y [lindex $token 4] set g [lindex $token 5] if { $g == $masterKey } { set x1 [expr $x + $w] set y1 [expr $y + $h] if { $x1Coord > $x1 && $xCoord < $x } { # colorbar is larger than the graph set x $xCoord set w $width } elseif { $x1Coord > $x1 && $xCoord > $x } { set w [expr $x1Coord - $x] } elseif { $x1Coord < $x1 && $xCoord > $x } { # don't do anything } else { # x1Coord < x1 && xCoord < $x set w [expr $x1 - $xCoord] } if { $y1Coord > $y1 && $yCoord < $y } { # colorbar is larger than the graph set y $yCoord set h $height } elseif { $y1Coord > $y1 && $yCoord > $y } { set h [expr $y1Coord - $y] } elseif { $y1Coord < $y1 && $yCoord > $y } { # don't do anything } else { # y1Coord < y1 && yCoord < $y set h [expr $y1 - $yCoord] } set newList [list $name $w $h $x $y $g] set psNameList [lreplace $psNameList $idx $idx $newList] break } incr idx } } } } if { $idx > 1 } { # more than one graph on the canvas set psNameList [lsort -real -increasing -index 3 $psNameList ] set direction [powDetermineGraphDirection $psNameList yes] if { $direction == "Y" } { set psNameList [lsort -real -increasing -index 4 $psNameList ] } } } } set powGraphCoordList $psNameList set fileNameList {} foreach param $psNameList { set fileName [lindex $param 0] set width [lindex $param 1] set height [lindex $param 2] set xCoord [lindex $param 3] set yCoord [lindex $param 4] #puts " fileName $fileName" #puts " width $width" #puts " height $height" #puts " xCoord $xCoord" #puts " yCoord $yCoord" #puts " powPostOrient $powPostOrient" set pageWidthPixel $powOutputPaperXsizePixel set pageHeightPixel $powOutputPaperYsizePixel set pageWidth $powOutputPaperXsizeInch set pageHeight $powOutputPaperYsizeInch #puts "powOutputPaperXsizeInch: $powOutputPaperXsizeInch" #puts "powOutputPaperXsizePixel: $powOutputPaperXsizePixel" #puts "powOutputPaperYsizeInch: $powOutputPaperYsizeInch" #puts "powOutputPaperYsizePixel: $powOutputPaperYsizePixel" #puts "OX1 pageWidth: $pageWidth" #puts "OX1 pageheight: $pageHeight" set canvasHeight $height set canvasWidth $width if { $width <= $powOutputPaperXsizePixel && $height <= $powOutputPaperYsizePixel } { # whole canvas or individual image is smaller than the output page size in Pixel if { $powStretch == "no" } { # no stretch to fit the page # Don't specify pageheight or pagewidth in canvas postscript command set pageWidth 0.0 set pageHeight 0.0 } else { # strectch the image to fit the page # adjust pageWidth and pageHeight and select the samller of two adjust size # # 1. calculate the factor from original image width to max width allows # calculate the factor from original image height to max height allows set widthFactor [expr $powOutputPaperXsizePixel / $width] set heightFactor [expr $powOutputPaperYsizePixel / $height] set imageWidthInch [format "%si" [expr [string range $powOutputPaperXsizeInch 0 [expr [string length $powOutputPaperXsizeInch] - 2]] / $widthFactor]] set imageHeightInch [format "%si" [expr [string range $powOutputPaperYsizeInch 0 [expr [string length $powOutputPaperYsizeInch] - 2]] / $heightFactor]] #puts "imageWidthInch : $imageWidthInch" #puts "imageHeightInch: $imageHeightInch" # 2. use the height factor * current width and get new width # use the width factor * current height and get new height set newWidthPixel [expr $heightFactor * $width] set newHeightPixel [expr $widthFactor * $height] #puts "newWidthPixel : $newWidthPixel" #puts "newHeightPixel: $newHeightPixel" set zoomFactor 1.0 set operator "/" if { $newWidthPixel > $powOutputPaperXsizePixel } { # width can't zoom in or out with heightFactor set zoomFactor $widthFactor if { $width < $powOutputPaperXsizePixel } { set operator "*" } set pageWidth [format "%si" [expr [string range $imageWidthInch 0 [expr [string length $pageWidth] - 2]] $operator $zoomFactor]] set pageHeight 0.0 } if { $newHeightPixel > $powOutputPaperYsizePixel } { # height can't zoom in or out with widthFactor set zoomFactor $heightFactor if { $height < $powOutputPaperYsizePixel } { set operator "*" } set pageHeight [format "%si" [expr [string range $imageHeightInch 0 [expr [string length $pageHeight] - 2]] $operator $zoomFactor]] set pageWidth 0.0 } if { $pageHeight == 0.0 && $pageWidth == 0.0 } { if { $powOutputPaperXsizePixel > $powOutputPaperYsizePixel } { # width larger than height, use powOutputPaperYsizeInch set pageHeight $powOutputPaperYsizeInch } else { set pageWidth $powOutputPaperXsizeInch } } } #puts "pageWidth: $pageWidth" #puts "pageHeight: $pageHeight" } elseif { $width > $powOutputPaperXsizePixel && $height <= $powOutputPaperYsizePixel } { # the width of whole canvas or individual image is larger than output page width in pixel # but height of whole canvas or individual image is smaller than output page height in pixel if { $powStretch == "no" } { # want width of the image to reduce by canvas postscript command to fit the page # set pageHeight to 0.0 and se the pagewidth = powOutputPagerXsizePixel to reduce # the width of image set pageHeight 0.0 } else { # strectch the image to fit the page if { $powOutputPaperXsizePixel > $powOutputPaperYsizePixel } { # using the smaller of paper width and height to be the final size. set pageWidth 0.0 set pageHeight $powOutputPaperYsizeInch } else { set pageHeight 0.0 set pageWidth $powOutputPaperXsizeInch } } } elseif { $width <= $powOutputPaperXsizePixel && $height > $powOutputPaperYsizePixel } { # the width of whole canvas or individual image is smaller than output page width in pixel # but height of whole canvas or individual image is larger than output page height in pixel if { $powStretch == "no" } { # want height of the image to reduce by canvas postscript command to fit the page # set pageWidth to 0.0 and se the pageHeight = powOutputPagerYsizePixel to reduce # the height of image set pageWidth 0.0 } else { # strectch the image to fit the page if { $powOutputPaperXsizePixel > $powOutputPaperYsizePixel } { # using the smaller of paper width and height to be the final size. set pageWidth 0.0 set pageHeight $powOutputPaperYsizeInch } else { set pageHeight 0.0 set pageWidth $powOutputPaperXsizeInch } } } elseif { $width > $powOutputPaperXsizePixel && $height > $powOutputPaperYsizePixel } { # the width and the height of whole canvas or individual image is larger than output page # width and height in pixel if { $width > $height } { if { $powStretch == "no" } { # width is larger than height, so reduce width will indicate that reduced height # will also fit the page. # set pageHeigth to 0.0 and se the pageWidth = powOutputPagerXsizePixel to reduce # the width of image set pageHeight 0.0 set pageWidth $powOutputPaperXsizeInch } else { # same idea, since now we need to reduce the image to fit the page, reduce the # width will reduce the height to fit the page also # set pageHeigth to 0.0 and se the pageWidth = powOutputPagerXsizePixel to reduce # the width of image if { $powPostOrient == 0 } { set pageHeight 0.0 set pageWidth $powOutputPaperXsizeInch } else { # rotate 90 degree and stretch. Even though width is larger than height, # the new width is now smaller than new height. Need pageHeight = powOutputPagerYsizePixel # to reduce the new height (previously the width of image) to fit the page. set pageWidth 0.0 set pageHeight $powOutputPaperYsizeInch } } } else { if { $powStretch == "no" } { # height is larger than width, so reduce height will indicate that reduced width # will also fit the page. # set pageWidth to 0.0 and se the pageHeight = powOutputPagerYsizePixel to reduce # the height of image set pageWidth 0.0 set pageHeight $powOutputPaperYsizeInch } else { # same idea, since now we need to reduce the image to fit the page, reduce the # height will reduce the width to fit the page also. # set pageWidth to 0.0 and se the pageHeight = powOutputPagerYsizePixel to reduce # the height of image if { $powPostOrient == 0 } { set pageWidth 0.0 set pageHeight $powOutputPaperYsizeInch } else { # rotate 90 degree and stretch. Even though height is larger than width, # the new height is now smaller than new width. Need pagewidth = powOutputPagerXsizePixel # to reduce the new width (previously the height of image) to fit the page. set pageHeight 0.0 set pageWidth $powOutputPaperXsizeInch } } } } #puts "pageWidth: $pageWidth" #puts "pageheight: $pageHeight" if { $pageWidth != 0.0 } { if { $powPostOrient == 1 } { # this is a hack until I could find a better way to stretch plot/image slice # to fit the page while rotate 90 degree set pageWidth [format "%si" [expr [string range $pageWidth 0 [expr [string length $pageWidth] - 2]] - 0.4]] } catch { .pow.pow postscript -colormode color -rotate $powPostOrient -file $fileName \ -width $canvasWidth -height $canvasHeight \ -pagewidth $pageWidth \ -x $xCoord -y $yCoord } err } elseif { $pageHeight != 0.0 } { if { $powPostOrient == 1 } { # this is a hack until I could find a better way to stretch plot/image slice # to fit the page while rotate 90 degree set pageHeight [format "%si" [expr [string range $pageHeight 0 [expr [string length $pageHeight] - 2]] - 0.4]] } catch { .pow.pow postscript -colormode color -rotate $powPostOrient -file $fileName \ -width $canvasWidth -height $canvasHeight \ -pageheight $pageHeight \ -x $xCoord -y $yCoord } err } else { catch { .pow.pow postscript -colormode color -rotate $powPostOrient -file $fileName \ -width $canvasWidth -height $canvasHeight \ -x $xCoord -y $yCoord } err } lappend fileNameList $fileName } return $fileNameList } proc powParseGraphRange { range } { global powPlacement set oldPowPlacement "" if [info exists powPlacement] { set oldPowPlacement $powPlacement } set powPlacement OGPP regsub -all " " $range "" result set tokenList [split $result ","] set indxList {} set returnList {} foreach token $tokenList { set subToken [split $token "-"] if { [llength $subToken] > 1 } { # it is range set start [expr [lindex $subToken 0] - 1] set end [expr [lindex $subToken 1] - 1] } else { set start [expr [lindex $subToken 0] - 1] set end [expr [lindex $subToken 0] - 1] } set value 1 if { $start > $end } { set value -1 } for { set i $start } {$i <= $end} { incr i $value } { if { [lsearch $indxList $i] < 0 } { lappend indxList $i } } } # delete from back of list set indxList [lsort -integer -increasing $indxList] set returnList [powAssemblePSfile] set finalList {} for {set i 0} {$i < [llength $indxList]} {incr i} { lappend finalList [lindex $returnList [lindex $indxList $i]] } set powPlacement $oldPowPlacement return $finalList } proc powPrintBox { {fromWhere "pow"} } { global powGraphSelection global powSelectDirectory global powConvertFunction global powDWP g_titleFont powbg global powGraphSelection global currentPreviewGraph global powPrintType global powPrintFunction global currgn global previewNameList global powCurrentPreviewPage global powOutputFileName global callingRoutine set callingRoutine $fromWhere if [winfo exists ${powDWP}print] { destroy ${powDWP}print } powToplevel ${powDWP}print .pow "-bg $powbg -class \"POW Print\"" bind ${powDWP}print <> "destroy ${powDWP}" wm title ${powDWP}print "Print" set rowIdx 0 frame ${powDWP}print.choice -bg $powbg -bd 2 radiobutton ${powDWP}print.choice.printer -text "Printer" -bg $powbg -font g_titleFont \ -variable powPrintType -value "Printer" \ -command { \ ${powDWP}print.option.filelbl configure -state disable ; \ ${powDWP}print.option.fileentry configure -state disable ; \ ${powDWP}print.option.dirlbl configure -state disable ; \ ${powDWP}print.option.direntry configure -state disable ; \ ${powDWP}print.option.filebutton configure -state disable; \ ${powDWP}print.option.convertType configure -state disable; \ ${powDWP}print.option.printerlbl configure -state normal ; \ ${powDWP}print.option.printerentry configure -state normal; \ } radiobutton ${powDWP}print.choice.file -text "File" -bg $powbg -font g_titleFont \ -variable powPrintType -value "File" \ -command { \ ${powDWP}print.option.filelbl configure -state normal; \ ${powDWP}print.option.convertType configure -state normal; \ ${powDWP}print.option.fileentry configure -state normal; \ ${powDWP}print.option.dirlbl configure -state normal ; \ ${powDWP}print.option.direntry configure -state normal ; \ ${powDWP}print.option.filebutton configure -state normal; \ ${powDWP}print.option.printerlbl configure -state disable ; \ ${powDWP}print.option.printerentry configure -state disable ; \ } label ${powDWP}print.choice.blanklabel -text " " -bg $powbg -font g_titleFont -width 10 grid ${powDWP}print.choice -row $rowIdx -column 0 -sticky ew -rowspan 2 grid ${powDWP}print.choice.printer -row 1 -column 0 -sticky nw grid ${powDWP}print.choice.blanklabel -row 1 -column 1 -sticky news -columnspan 3 grid ${powDWP}print.choice.file -row 1 -column 8 -sticky ne grid rowconfigure ${powDWP}print 0 -weight 1 grid columnconfigure ${powDWP}print 8 -weight 1 incr rowIdx 2 frame ${powDWP}print.option -bg $powbg -bd 2 label ${powDWP}print.option.printerlbl -text "Printer Command:" -bg $powbg -font g_titleFont entry ${powDWP}print.option.printerentry -bg white -font g_titleFont label ${powDWP}print.option.filelbl -text "File Name:" -bg $powbg -font g_titleFont entry ${powDWP}print.option.fileentry -bg white -font g_titleFont tixComboBox ${powDWP}print.option.convertType -editable true \ -label "format:" \ -options { \ listbox.height 4 \ label.font g_titleFont \ listbox.font g_titleFont \ entry.font g_titleFont \ entry.background white \ entry.width 30 \ entry.ipady 5 \ } \ -command powSelectConvertFormat foreach functionList $powConvertFunction { set formatStr [format "%s - %s" [lindex $functionList 0] [lindex $functionList 3]] ${powDWP}print.option.convertType insert end $formatStr } label ${powDWP}print.option.dirlbl -text "Directory:" -bg $powbg -font g_titleFont entry ${powDWP}print.option.direntry -bg white -font g_titleFont button ${powDWP}print.option.filebutton -text "Browse" -font g_titleFont -bg $powbg \ -command { set powOutputFileName [${powDWP}print.option.fileentry get] ; \ set powSelectDirectory [${powDWP}print.option.direntry get] ; \ wm withdraw ${powDWP}print; powSaveAs } grid ${powDWP}print.option -row $rowIdx -column 0 -columnspan 10 -sticky news -rowspan 2 grid ${powDWP}print.option.printerlbl -row 1 -column 0 -sticky nw -columnspan 2 grid ${powDWP}print.option.printerentry -row 1 -column 2 -sticky nw -columnspan 7 grid ${powDWP}print.option.filelbl -row 2 -column 0 -sticky nw -columnspan 2 grid ${powDWP}print.option.fileentry -row 2 -column 2 -sticky new -columnspan 4 grid ${powDWP}print.option.convertType -row 3 -column 2 -sticky new -columnspan 4 grid ${powDWP}print.option.dirlbl -row 4 -column 0 -sticky nw -columnspan 2 grid ${powDWP}print.option.direntry -row 4 -column 2 -sticky new -columnspan 4 grid ${powDWP}print.option.filebutton -row 4 -column 6 -sticky nw grid rowconfigure ${powDWP}print $rowIdx -weight 1 grid rowconfigure ${powDWP}print.option 1 -weight 1 grid rowconfigure ${powDWP}print.option 2 -weight 1 grid rowconfigure ${powDWP}print.option 3 -weight 1 grid columnconfigure ${powDWP}print.option 2 -weight 1 incr rowIdx 4 frame ${powDWP}print.selection -bg $powbg -bd 2 -relief ridge label ${powDWP}print.selectionframelabel -text "Print/Save Range" -bg $powbg -font g_titleFont label ${powDWP}print.selection.blanklabel -text " " -bg $powbg -font g_titleFont radiobutton ${powDWP}print.selection.allgraph -text "All Graphs" -value "all" \ -bg $powbg \ -variable powGraphSelection -font g_titleFont radiobutton ${powDWP}print.selection.selectedgraph -text "Selected Graph" -value "one" \ -bg $powbg \ -variable powGraphSelection -font g_titleFont \ -command { \ if ![info exists currentPreviewGraph] { \ set currentPreviewGraph "" ; \ if { $powGraphSelection == "one" } { \ set currentPreviewGraph [lindex [powAssemblePSfile $currgn] 0] ; \ } ; \ } ; \ } radiobutton ${powDWP}print.selection.range -text "Graphs No." -value "range" \ -bg $powbg \ -variable powGraphSelection -font g_titleFont entry ${powDWP}print.selection.entry -bg white -width 25 -font g_titleFont label ${powDWP}print.selection.label1 -text "Enter graph numbers and/or graph ranges separated by" \ -bg $powbg \ -font [list Helvetica 10 italic] -fg blue label ${powDWP}print.selection.label2 -text "commas, i.e. 1,3,5,5-12 (1 being leftmost/topmost graph)" \ -bg $powbg \ -font [list Helvetica 10 italic] -fg blue if { $fromWhere == "preview" } { ${powDWP}print.selection.allgraph configure -text "All Pages" ${powDWP}print.selection.selectedgraph configure -text "Current Page" ${powDWP}print.selection.range configure -text "Page No." ${powDWP}print.selection.label1 configure -text "Enter page numbers and/or page ranges separated by" ${powDWP}print.selection.label2 configure -text "commas, i.e. 1,3,5,5-12" } grid ${powDWP}print.selection -row $rowIdx -column 0 -columnspan 10 -sticky news -rowspan 7 grid ${powDWP}print.selectionframelabel -row $rowIdx -column 0 -sticky nw grid ${powDWP}print.selection.blanklabel -row 1 -column 0 -sticky nw grid ${powDWP}print.selection.allgraph -row 2 -column 1 -sticky nw -columnspan 2 grid ${powDWP}print.selection.selectedgraph -row 3 -column 1 -sticky nw -columnspan 2 grid ${powDWP}print.selection.range -row 4 -column 1 -sticky nw -columnspan 2 grid ${powDWP}print.selection.entry -row 4 -column 3 -sticky nw -columnspan 5 grid ${powDWP}print.selection.label1 -row 5 -column 1 -sticky nw -columnspan 6 grid ${powDWP}print.selection.label2 -row 6 -column 1 -sticky nw -columnspan 6 grid rowconfigure ${powDWP}print $rowIdx -weight 1 grid rowconfigure ${powDWP}print.selection 1 -weight 1 grid rowconfigure ${powDWP}print.selection 2 -weight 1 grid rowconfigure ${powDWP}print.selection 3 -weight 1 grid rowconfigure ${powDWP}print.selection 4 -weight 1 grid rowconfigure ${powDWP}print.selection 5 -weight 1 grid rowconfigure ${powDWP}print.selection 6 -weight 1 grid rowconfigure ${powDWP}print.selection 7 -weight 1 grid columnconfigure ${powDWP}print.selection 3 -weight 1 incr rowIdx 7 frame ${powDWP}print.action -bg $powbg button ${powDWP}print.action.ok -text "OK" -bg $powbg -font g_titleFont \ -command { \ if ![info exists currentPreviewGraph] { \ set currentPreviewGraph "" ; \ if { $powGraphSelection == "one" } { \ set currentPreviewGraph [lindex [powAssemblePSfile $currgn] 0] ; \ } ; \ } ; \ if { $powPrintType == "Printer" } { \ set powPrintFunction [${powDWP}print.option.printerentry get] if { $powGraphSelection == "all" } { \ powShowHandles 0 ; \ powPrint ; \ powShowHandles 1 ; \ } elseif { $powGraphSelection == "one" } { \ powShowHandles 0 ; \ powPrint $currentPreviewGraph ; \ powShowHandles 1 ; \ } elseif { $powGraphSelection == "range" } { \ powShowHandles 0 ; \ powPrint [powParseGraphRange \ [${powDWP}print.selection.entry get]] ;\ powShowHandles 1 ; \ } ; \ } else { set powOutputFileName [${powDWP}print.option.fileentry get] ; \ set powSelectDirectory [${powDWP}print.option.direntry get] ; \ set token [split $powOutputFileName "."] ; \ set powOutputFileType {} ; \ foreach cvf $powConvertFunction { if { [lindex $cvf 2] == [lindex $token 1] } {\ set powOutputFileType $cvf ; \ break; } \ } ; \ if { [llength $powOutputFileType] == 0 } { tk_messageBox -icon warning -parent .pow -type ok \ -message "Can't save to [lindex $token 1] format." } else { if { $powGraphSelection == "range" } { \ powShowHandles 0 ; \ powSave [powParseGraphRange \ [${powDWP}print.selection.entry get]] ; \ powShowHandles 1 ; \ } elseif { $powGraphSelection == "one" } { \ powShowHandles 0 ; \ if { $callingRoutine == "pow" } { \ powSave [lindex [powAssemblePSfile $currgn] 0] ; \ } else { \ powSave [lindex [lindex $previewNameList $powCurrentPreviewPage] 1] } ; \ powShowHandles 1 ; \ } else { \ powShowHandles 0 ; \ powSave ; \ powShowHandles 1 ; \ } ; \ } ; \ }; \ destroy ${powDWP}print } label ${powDWP}print.action.blanklabel -text " " -bg $powbg -font g_titleFont button ${powDWP}print.action.cancel -text "Cancel" -bg $powbg -font g_titleFont \ -command { destroy ${powDWP}print } grid ${powDWP}print.action -row $rowIdx -column 0 -columnspan 10 -sticky news grid ${powDWP}print.action.ok -row 0 -column 1 -sticky w -padx 30 grid ${powDWP}print.action.cancel -row 0 -column 4 -sticky e -padx 30 # grid rowconfigure ${powDWP}print 0 -weight 1 # grid columnconfigure ${powDWP}print 0 -weight 1 if { [${powDWP}print.option.printerentry get] == "" } { ${powDWP}print.option.printerentry insert end $powPrintFunction } else { set powPrintFunction [${powDWP}print.option.printerentry get] } if ![info exists powOutputFileName] { ${powDWP}print.option.fileentry insert end "powGraph.ps" } else { ${powDWP}print.option.fileentry insert end $powOutputFileName } set powOutputFileName [${powDWP}print.option.fileentry get] if ![info exists powSelectDirectory ] { ${powDWP}print.option.direntry insert end [pwd] } else { ${powDWP}print.option.direntry insert end $powSelectDirectory } if { ![info exists powPrintType] || $powPrintType == "" } { ${powDWP}print.choice.printer select ${powDWP}print.option.filelbl configure -state disable ${powDWP}print.option.convertType configure -state disable ${powDWP}print.option.fileentry configure -state disable ${powDWP}print.option.dirlbl configure -state disable ${powDWP}print.option.direntry configure -state disable ${powDWP}print.option.filebutton configure -state disable ${powDWP}print.option.printerlbl configure -state normal ${powDWP}print.option.printerentry configure -state normal } else { if { $powPrintType == "Printer" } { ${powDWP}print.option.filelbl configure -state disable ${powDWP}print.option.convertType configure -state disable ${powDWP}print.option.fileentry configure -state disable ${powDWP}print.option.filebutton configure -state disable ${powDWP}print.option.dirlbl configure -state disable ${powDWP}print.option.direntry configure -state disable ${powDWP}print.option.printerlbl configure -state normal ${powDWP}print.option.printerentry configure -state normal } else { ${powDWP}print.option.filelbl configure -state normal ${powDWP}print.option.convertType configure -state normal ${powDWP}print.option.fileentry configure -state normal ${powDWP}print.option.filebutton configure -state normal ${powDWP}print.option.dirlbl configure -state normal ${powDWP}print.option.direntry configure -state normal ${powDWP}print.option.printerlbl configure -state disable ${powDWP}print.option.printerentry configure -state disable } } if [info exists powGraphSelection] { if { $powGraphSelection == "one" && \ (![info exists currentPreviewGraph] || $currentPreviewGraph == "") } { set currentPreviewGraph [lindex [powAssemblePSfile $currgn] 0] } } else { ${powDWP}print.selection.allgraph select } set token [split $powOutputFileName "."] set powOutputFileType {postscript pswrite ps "Postscript Files"} foreach cvf $powConvertFunction { if { [lindex $cvf 2] == [lindex $token 1] } { set powOutputFileType $cvf tixSetSilent ${powDWP}print.option.convertType "[lindex $cvf 0] - [lindex $cvf 3]" break } } bind ${powDWP}print.selection.entry { global powDWP ${powDWP}print.selection.range select } } proc powPrint { {inputFile {}} } { global powSelectDirectory global powGraphSelection global powbg pcom_fname global powStretch powOutputPaperSize global powConvertFormat powConvertFunction global powHandles powDWP g_titleFont global powPaperDefXsizeInch powPaperDefYsizeInch global powPaperDefXsizePixel powPaperDefYsizePixel global powOutputPaperXsizeInch powOutputPaperYsizeInch global powOutputPaperXsizePixel powOutputPaperYsizePixel global powPlacement powPostOrient global powPaperSizeSelected powPixelToInchRatio global powPrintFunction global previewNameList global ghostScript global powOutputFileType global tcl_platform global searchPath #puts "inputFile: $inputFile" set fileNameList {} if { [llength $inputFile] == 0 } { set fileNameList [powAssemblePSfile] if [info exist ${powDWP}print.selection.allgraph] { ${powDWP}print.selection.allgraph select } } else { if { [llength $inputFile] == 1 } { lappend fileNameList $inputFile if [info exist ${powDWP}print.selection.selectedgraph] { ${powDWP}print.selection.selectedgraph select } } else { lappend fileNameList $inputFile if [info exist ${powDWP}print.selection.range] { ${powDWP}print.selection.range select } } } set idx -1 #puts "fileNameList: $fileNameList" #puts "fileNameList length: [llength $fileNameList]" #puts "previewNameList: $previewNameList" foreach fileName $fileNameList { #puts "fileName: $fileName" if { $tcl_platform(platform) != "windows" } { set errorFlag [ catch { set comm "cat $fileName | $powPrintFunction" exec /bin/sh -c $comm } result ] # file delete -force $fileName } elseif { $tcl_platform(platform) == "windows" } { # this is Windows environment print set previewIdx [lsearch -glob $previewNameList [list * $fileName]] set outputName "" #puts "previewIdx: $previewIdx" if { $previewIdx < 0 || ![file exists [lindex [lindex $previewNameList $previewIdx] 0]] } { set errorFlag [ catch { exec $ghostScript -sDEVICE=jpeg \ -dNOPAUSE -dBATCH -dQUIET \ -sPAPERSIZE=[string tolower $powPaperSizeSelected] \ -I$searchPath \ -sOutputFile=tmpPrint.jpg $fileName } result ] if { !$errorFlag } { set outputName $::env(PSTMPDIR)/tmpPrint.jpg } } else { set outputName [lindex [lindex $previewNameList $previewIdx] 0] } #puts "outputName: $outputName" if { $outputName != "" } { set errorFlag [ catch { exec $powPrintFunction "[_convertToWindowFileName $outputName]" "/print" } err ] } else { #tk_messageBox -icon error -parent .pow -type ok -message "Error sending graphs to printer." } } incr idx if { $idx > [llength $fileNameList] } { # tk_messageBox -icon info -parent .pow -type ok -message "Successful send graphs to printer." } } } proc _convertToWindowFileName { path } { set newStr "" for {set i 0} {$i < [string length $path]} {incr i} { if { [string range $path $i $i] == "/" } { set newStr [format "%s\\" $newStr] } else { set newStr [format "%s%s" $newStr [string range $path $i $i]] } } return $newStr } proc powMergeGraphs { newgn } { #puts "powMergeGraphs start" global currgn powPlotParam powGUI powPlotImages $currgn $powPlotParam(images,$newgn) .pow.pow powPlotCurves $currgn $powPlotParam(curves,$newgn) .pow.pow if { $powGUI } { powRedrawScopebox } } proc powEditNoteDlg { gn idx {id ""} } { #puts "powEditNoteDlg start" global powPlotParam powFontParam powNote powDWP powbg global g_titleFont if { $idx=="" } { set idx [powFindNoteIdx $gn $id] } powSetupNoteVar $gn $idx # # Build Dialog Window # set w ${powDWP}note if { [winfo exists $w] } { raise $w focus $w if { $powNote(idx)<0 } { $w.buttons.apply config -state disabled $w.buttons.delete config -state disabled } else { $w.buttons.apply config -state normal $w.buttons.delete config -state normal } return } powToplevel $w .pow "-bg $powbg" bind $w <> "destroy $w" wm title $w "Annotations" set row 1 label $w.title -text "Edit/Add Annotations" -bg $powbg -font g_titleFont grid $w.title -row $row -column 1 -columnspan 2 -sticky n incr row grid rowconfigure $w $row -minsize 10 incr row label $w.lbl -text "Label:" -bg $powbg -font g_titleFont entry $w.lblentry -width 30 -bg $powbg -textvariable powNote(string) -font g_titleFont grid $w.lbl -row $row -column 1 -sticky e grid $w.lblentry -row $row -column 2 -sticky ew -padx 5 incr row grid rowconfigure $w $row -minsize 3 incr row label $w.fnt -text "Font:" -bg $powbg -font g_titleFont frame $w.fntframe -bg $powbg set mnu [eval tk_optionMenu $w.fntframe.fnt \ powNote(Font) $powFontParam(allFonts,powDef)] $w.fntframe.fnt config -bg $powbg -highlightthickness 0 -width 20 -font g_titleFont $mnu config -bg $powbg -font g_titleFont set mnu [tk_optionMenu $w.fntframe.siz \ powNote(Size) 7 9 12 14 16 18 24 32 40] $w.fntframe.siz config -bg $powbg -highlightthickness 0 -width 3 -font g_titleFont $mnu config -bg $powbg -font g_titleFont pack $w.fntframe.fnt -side left -padx 5 pack $w.fntframe.siz -side left -padx 5 grid $w.fnt -row $row -column 1 -sticky e grid $w.fntframe -row $row -column 2 -sticky w incr row grid rowconfigure $w $row -minsize 3 incr row label $w.stl -text "Style:" -bg $powbg -font g_titleFont frame $w.stlframe -bg $powbg checkbutton $w.stlframe.bld -text Bold -onvalue bold -offvalue normal \ -bg $powbg -variable powNote(Weight) -highlightthickness 0 -font g_titleFont checkbutton $w.stlframe.itl -text Italic -onvalue italic -offvalue roman \ -bg $powbg -variable powNote(Slant) -highlightthickness 0 -font g_titleFont pack $w.stlframe.bld -side left -padx 5 pack $w.stlframe.itl -side left -padx 5 grid $w.stl -row $row -column 1 -sticky e grid $w.stlframe -row $row -column 2 -sticky w incr row grid rowconfigure $w $row -minsize 3 incr row label $w.clr -text "Color:" -bg $powbg -font g_titleFont button $w.clrbtn -textvariable powNote(Color) \ -bg $powbg -highlightthickness 0 -width 7 \ -command "powSelectColor powNote(Color)" -font g_titleFont grid $w.clr -row $row -column 1 -sticky e grid $w.clrbtn -row $row -column 2 -sticky w -padx 5 incr row grid rowconfigure $w $row -minsize 3 incr row label $w.pos -text "Position:" -bg $powbg -font g_titleFont frame $w.posframe -bg $powbg entry $w.posframe.x -width 14 -bg $powbg -textvariable powNote(xpos) -font g_titleFont entry $w.posframe.y -width 14 -bg $powbg -textvariable powNote(ypos) -font g_titleFont pack $w.posframe.x -side left -padx 5 pack $w.posframe.y -side left -padx 5 grid $w.pos -row $row -column 1 -sticky e grid $w.posframe -row $row -column 2 -sticky w incr row grid rowconfigure $w $row -minsize 3 incr row label $w.crd -text "Attach To:" -bg $powbg -font g_titleFont frame $w.crdframe -bg $powbg radiobutton $w.crdframe.graph -text "Graph" \ -variable powNote(coordSys) \ -value "graph" -highlightthickness 0 -bg $powbg \ -command powUpdateNoteCoord -font g_titleFont radiobutton $w.crdframe.coord -text "Coordinates" \ -variable powNote(coordSys) \ -value "coord" -highlightthickness 0 -bg $powbg \ -command powUpdateNoteCoord -font g_titleFont pack $w.crdframe.graph -side left -padx 5 pack $w.crdframe.coord -side left -padx 5 grid $w.crd -row $row -column 1 -sticky e grid $w.crdframe -row $row -column 2 -sticky w incr row grid rowconfigure $w $row -minsize 10 incr row frame $w.buttons -bg $powbg button $w.buttons.apply -text "Apply" -bg $powbg -highlightthickness 0 \ -command {powUpdateNote apply} -font g_titleFont button $w.buttons.add -text "Add" -bg $powbg -highlightthickness 0 \ -command {powUpdateNote add} -font g_titleFont button $w.buttons.delete -text "Delete" -bg $powbg -highlightthickness 0 \ -command {powUpdateNote delete} -font g_titleFont button $w.buttons.done -text "Exit" -bg $powbg -highlightthickness 0 \ -command "destroy $w" -font g_titleFont pack $w.buttons.add -side left -padx 5 pack $w.buttons.delete -side left -padx 5 pack $w.buttons.apply -side left -padx 5 pack $w.buttons.done -side left -padx 5 grid $w.buttons -row $row -column 1 -columnspan 2 incr row grid rowconfigure $w $row -minsize 5 incr row if { $powNote(idx)<0 } { $w.buttons.apply config -state disabled $w.buttons.delete config -state disabled } else { $w.buttons.apply config -state normal $w.buttons.delete config -state normal } } proc powSetupNoteVar { gn idx } { #puts "powSetupNoteVar start" global powNote powFontParam powPlotParam set powNote(gn) $gn if { $idx<0 && [llength $powPlotParam(Notes,$gn)]==0 } { # This is a new record # Grab font info from graph defaults foreach opt $powFontParam(allOpts,powDef) { set powNote($opt) $powFontParam(note${opt},$gn) } set powNote(xpos) 1.01 set powNote(ypos) 0.9 set powNote(string) "Blank" set powNote(coordSys) "graph" } else { if { $idx<0 || $idx >= [llength $powPlotParam(Notes,$gn)] } { # Grab font info from last note set record [lindex $powPlotParam(Notes,$gn) end] set record [lreplace $record 0 0 "Blank"] set record [lreplace $record end end -1] set idx -1 } else { set record [lindex $powPlotParam(Notes,$gn) $idx] } foreach [list string Font Size Weight Slant Color xpos ypos coordSys id] \ $record {} foreach opt \ [list string Font Size Weight Slant Color xpos ypos coordSys id] { set powNote($opt) [subst \$$opt] } } set powNote(idx) $idx set powNote(oldCoord) $powNote(coordSys) } proc powUpdateNote { method } { #puts "powUpdateNote start" global powNote powPlotParam powDWP set gn $powNote(gn) if { $method=="delete" } { # Delete this Note if { $powNote(idx)>=0 } { powDeleteNote $gn $powNote(idx) set powNote(idx) -1 } } elseif { $powNote(string)=="" } { error "Cannot Add/Apply an empty label" } else { # Update the Note set record {} foreach opt [list \ string Font Size Weight Slant Color xpos ypos coordSys] { lappend record $powNote($opt) } if { $method=="add" || $powNote(idx)<0 } { # Create a new Note set powNote(idx) [llength $powPlotParam(Notes,$gn)] lappend record -1 lappend powPlotParam(Notes,$gn) $record } else { # Apply # Grab current ID number of the current Note set r [lindex $powPlotParam(Notes,$gn) $powNote(idx)] lappend record [lindex $r 9] } set newID [powDrawNote $gn $record] set record [lreplace $record 9 9 $newID] set powPlotParam(Notes,$gn) [lreplace \ $powPlotParam(Notes,$gn) $powNote(idx) $powNote(idx) $record] powRedrawGraphHandles $gn } if { $powNote(idx)<0 } { ${powDWP}note.buttons.apply config -state disabled ${powDWP}note.buttons.delete config -state disabled } else { ${powDWP}note.buttons.apply config -state normal ${powDWP}note.buttons.delete config -state normal } } proc powUpdateNoteCoord { } { #puts "powUpdateNoteCoord start" global powNote powPlotParam set gn $powNote(gn) set xpos $powNote(xpos) set ypos $powNote(ypos) foreach [list x0 y1 x1 y0] [.pow.pow coord ${gn}box] {} if { $powNote(oldCoord)==$powNote(coordSys) } { set idx $powNote(idx) if { $idx>=0 } { set r [lindex $powPlotParam(Notes,$gn) $idx] set xpos [lindex $r 6] set ypos [lindex $r 7] set crd [lindex $r 8] if { $crd==$powNote(coordSys) } { set powNote(xpos) $xpos set powNote(ypos) $ypos return } } else { return } } if { $powNote(coordSys)=="graph" } { foreach {x y} [powGraphToCanvas $gn $xpos $ypos .pow.pow] {} set xpos [expr ($x - $x0) / ($x1 - $x0)] set ypos [expr ($y - $y0) / ($y1 - $y0)] } elseif { $powNote(coordSys)=="coord" } { set x [expr $xpos * ($x1-$x0) + $x0] set y [expr $ypos * ($y1-$y0) + $y0] foreach {xpos ypos} [powCanvasToGraph $gn $x $y .pow.pow] {} } set powNote(xpos) $xpos set powNote(ypos) $ypos set powNote(oldCoord) $powNote(coordSys) } proc powAddNote { gn xpos ypos string args } { #puts "powAddNote start" global powPlotParam powFontParam array set opts [list \ -font $powFontParam(noteFont,powDef) \ -size $powFontParam(noteSize,powDef) \ -weight $powFontParam(noteWeight,powDef) \ -slant $powFontParam(noteSlant,powDef) \ -color $powFontParam(noteColor,powDef) \ -coord graph \ ] foreach {opt val} $args { if { [info exists opts($opt)] } { set opts($opt) $val } else { puts "Unrecognized option $opt" } } set record [list $string $opts(-font) $opts(-size) $opts(-weight) \ $opts(-slant) $opts(-color) $xpos $ypos $opts(-coord) -1] set newID [powDrawNote $gn $record] set record [lreplace $record end end $newID] lappend powPlotParam(Notes,$gn) $record powRedrawGraphHandles $gn return $newID } proc powDeleteNote { gn idx } { #puts "powDeleteNote start" global powPlotParam set r [lindex $powPlotParam(Notes,$gn) $idx] set id [lindex $r 9] if { $id>=0 && [.pow.pow find withtag $id]!="" } { .pow.pow delete $id } set powPlotParam(Notes,$gn) \ [lreplace $powPlotParam(Notes,$gn) $idx $idx] powRedrawGraphHandles $gn } proc powDrawNote { gn record } { #puts "powDrawNote start" foreach [list string Font Size Weight Slant Color xpos ypos coordSys id] \ $record {} foreach [list x0 y1 x1 y0] [.pow.pow coord ${gn}box] {} if { $coordSys=="graph" } { set x [expr $xpos * ($x1-$x0) + $x0] set y [expr $ypos * ($y1-$y0) + $y0] } elseif { $coordSys=="coord" } { foreach {x y} [powGraphToCanvas $gn $xpos $ypos .pow.pow] {} if { $x<$x0 || $x>$x1 || $y<$y1 || $y>$y0 } { # Note not inside graph box if { $id>=0 && [.pow.pow find withtag $id]!="" } { .pow.pow delete $id } return -1 } } else { puts "Unsupported coordSys $coordSys" return -1 } if { $id>=0 && [.pow.pow find withtag $id]!="" } { .pow.pow coords $id $x $y .pow.pow itemconfig $id -text $string -fill $Color \ -font [list $Font $Size $Weight $Slant] -anchor sw \ -tags "$gn ${gn}text" } else { set id [.pow.pow create text $x $y -text $string -fill $Color \ -font [list $Font $Size $Weight $Slant] -anchor sw \ -tags "$gn ${gn}text"] .pow.pow bind $id <> "powEditNoteDlg $gn {} $id" #puts "calling powBindBtn 4" powBindBtn <> ".pow.pow bind $id" \ " powDragNote start $gn $id %X %Y " \ " powDragNote drag $gn $id %X %Y " \ " powDragNote end $gn $id %X %Y " } return $id } proc powDragNote { mode gn id X Y } { #puts "powDragNote start" global powMoveX powMoveY powIsDragging powResizeMain powNote powDWP switch -exact $mode { start { set powIsDragging 1 } drag { set dx [expr $X - $powMoveX] set dy [expr $Y - $powMoveY] .pow.pow move $id $dx $dy } end { set idx [powFindNoteIdx $gn $id] powRepositionNote $gn $idx powRedrawGraphHandles $gn set powIsDragging 0 if { [winfo exist ${powDWP}note] } { if { $gn==$powNote(gn) && $idx==$powNote(idx) } { powUpdateNoteCoord } else { powEditNoteDlg $gn {} $id } } } } set powMoveX $X set powMoveY $Y } proc powRepositionNote { gn idx } { #puts "powRepositionNote start" # Calculate the appropriate x/y position for # the note's current canvas position global powPlotParam if { $idx<0 || $idx>[llength $powPlotParam(Notes,$gn)] } return set r [lindex $powPlotParam(Notes,$gn) $idx] set coord [lindex $r 8] set id [lindex $r 9] foreach {x y} [.pow.pow coord $id] {} foreach {x0 y1 x1 y0} [.pow.pow coord ${gn}box] {} if { $coord=="graph" } { set xpos [expr ($x - $x0) / ($x1 - $x0)] set ypos [expr ($y - $y0) / ($y1 - $y0)] } elseif { $coord=="coord" } { foreach {xpos ypos} [powCanvasToGraph $gn $x $y .pow.pow] {} if { $x<$x0 || $x>$x1 || $y<$y1 || $y>$y0 } { # Note not inside graph box if { $id>=0 && [.pow.pow find withtag $id]!="" } { .pow.pow delete $id } set r [lreplace $r 9 9 -1] } } else { error "Unknown coordinate system: $coord" } set r [lreplace $r 6 7 $xpos $ypos] set powPlotParam(Notes,$gn) [lreplace $powPlotParam(Notes,$gn)\ $idx $idx $r] } proc powFindNoteIdx { gn id } { #puts "powFindNoteIdx start" global powPlotParam set idx 0 foreach r $powPlotParam(Notes,$gn) { if { [lindex $r end]==$id } break incr idx } if { $idx >= [llength $powPlotParam(Notes,$gn)] } { set idx -1 } return $idx } proc powRedrawNotes { gn } { #puts "powRedrawNotes start" global powPlotParam set i 0 set notes {} foreach r $powPlotParam(Notes,$gn) { set newID [powDrawNote $gn $r] set r [lreplace $r end end $newID] lappend notes $r } set powPlotParam(Notes,$gn) $notes } proc powAddTextToGraphDoIt { } { #puts "powAddTextToGraphDoIt start" global powDWP if [catch {selection get} gn] { set gn " " } set savebinding [bind .pow.pow ] bind .pow.pow "\ powPlaceText [list [${powDWP}addtext.text get 0.0 end] $gn %x %y .pow.pow]; destroy ${powDWP}addtext;\ bind .pow.pow \{$savebinding\}" } proc powSelectColor { varName } { #puts "powSelectColor start" upvar #0 $varName var set newClr [tk_chooseColor -initialcolor $var] if {$newClr != ""} {set var $newClr} } proc swap { a b} { #puts "swap start" upvar $a one upvar $b two set tmp $one set one $two set two $tmp } proc debug_trace {name element op} { if {$element != ""} { set name #puts "debug_trace start" ${name}($element) } upvar $name x puts "Variable $name set to $x" } proc powUpdateTrackVars {} { #puts "powUpdateTrackVars start" global powGraphCoordsTracker powImagePixelTracker powImageValueTracker powPhysicalPixelTracker global powFirstPixel powPlotParam powTrackText set gn $powTrackText(gn) if [regexp {[0-9]} $powTrackText(rx)] { if {$powPlotParam(tickLabels,$gn)=="degrees" \ && [powWCSexists $gn]} { set rx [powHourRA $powTrackText(rx)] set ry [powDegDec $powTrackText(ry)] set powGraphCoordsTracker \ "Graph coordinates:\n ( $rx, $ry )" } else { set rxVal $powTrackText(rx) if {$powPlotParam(xTickScal,$gn)=="log"} { # Make sure the log value isn't out-of-bounds if { $rxVal>300 || $rxVal<-300 } { set rxVal "***" } else { set rxVal [format "%.6lg" [expr pow(10.0,$rxVal)]] } } else { set rxVal [format "%.6lg" $rxVal] } set ryVal $powTrackText(ry) if {$powPlotParam(yTickScal,$gn)=="log"} { # Make sure the log value isn't out-of-bounds if { $ryVal>300 || $ryVal<-300 } { set ryVal "***" } else { set ryVal [format "%.6lg" [expr pow(10.0,$ryVal)]] } } else { set ryVal [format "%.6lg" $ryVal] } set powGraphCoordsTracker "Graph coordinates:\n ( $rxVal, $ryVal )" } } else { set powGraphCoordsTracker "Graph coordinates:\n ( X , X )" } #puts $powTrackText(imgx) if [regexp {[0-9]} $powTrackText(imgx)] { set result [powConvertImage2Physical [expr $powTrackText(imgx) + $powFirstPixel] [expr $powTrackText(imgy) + $powFirstPixel]] set powPhysicalPixelTracker "Physical pixel:\n ( [lindex $result 0], [lindex $result 1])" set powImagePixelTracker "Image pixel:\n ( [expr $powTrackText(imgx) + $powFirstPixel], [expr $powTrackText(imgy) + $powFirstPixel] )" } else { set powPhysicalPixelTracker "Physical pixel:\n ( X , X )" set powImagePixelTracker "Image pixel:\n ( X , X )" } if [regexp {[0-9]} $powTrackText(imgz)] { set ctoken [split $powTrackText(imgz) "."] if { [llength $ctoken] == 2 && [regexp {[0-9]} [lindex $ctoken 1]] } { set pixval [format %.16lg [expr $powTrackText(imgz)]] } else { set pixval $powTrackText(imgz) } } elseif { $powTrackText(imgz)=="NULL" } { set pixval "NULL" } else { set pixval "X" } set powImageValueTracker "Pixel value:\n $pixval ($powTrackText(zunits))" } proc powConvertPhysical2Image { x y } { global powLTM_11 powLTM_12 powLTM_21 powLTM_22 powLTV1 powLTV2 global currgn set image_x $x set image_y $y if ![info exists powLTM_11($currgn)] { set powLTM_11($currgn) [powDetermineKeyWordExist $currgn "LTM1_1"] if { $powLTM_11($currgn) == false } { # LTM1_1, LTM1_2, LTM2_1, LTM2_2, LTV1, LTV2 not exist unset powLTM_11($currgn) } else { set powLTM_12($currgn) [powDetermineKeyWordExist $currgn "LTM1_2"] set powLTM_21($currgn) [powDetermineKeyWordExist $currgn "LTM2_1"] set powLTM_22($currgn) [powDetermineKeyWordExist $currgn "LTM2_2"] set powLTV1($currgn) [powDetermineKeyWordExist $currgn "LTV1"] set powLTV2($currgn) [powDetermineKeyWordExist $currgn "LTV2"] } } if [info exists powLTM_11($currgn)] { if { $powLTM_12($currgn) == "false" } { set powLTM_12($currgn) 0 } if { $powLTM_21($currgn) == "false" } { set powLTM_21($currgn) 0 } if { $powLTM_22($currgn) == "false" } { set powLTM_22($currgn) 0 } if { $powLTV1($currgn) == "false" } { set powLTV1($currgn) 0 } if { $powLTV2($currgn) == "false" } { set powLTV2($currgn) 0 } set image_x [expr $powLTM_11($currgn) * $x + $powLTM_12($currgn) * $y + $powLTV1($currgn)] set image_y [expr $powLTM_21($currgn) * $x + $powLTM_22($currgn) * $y + $powLTV2($currgn)] } return [list $image_x $image_y] } proc powConvertRadiusPhysical2Image { phy_x phy_y img_x phy_radius } { set phy_outer_x [expr $phy_x + $phy_radius] set result [powConvertPhysical2Image $phy_outer_x $phy_y] return [expr abs([lindex $result 0] - $img_x)] } proc powConvertImage2Physical { x y } { global powLTM_11 powLTM_12 powLTM_21 powLTM_22 powLTV1 powLTV2 global currgn set physical_x $x set physical_y $y if ![info exists powLTM_11($currgn)] { set powLTM_11($currgn) [powDetermineKeyWordExist $currgn "LTM1_1"] if { $powLTM_11($currgn) == false } { # LTM1_1, LTM1_2, LTM2_1, LTM2_2, LTV1, LTV2 not exist unset powLTM_11($currgn) } else { set powLTM_12($currgn) [powDetermineKeyWordExist $currgn "LTM1_2"] set powLTM_21($currgn) [powDetermineKeyWordExist $currgn "LTM2_1"] set powLTM_22($currgn) [powDetermineKeyWordExist $currgn "LTM2_2"] set powLTV1($currgn) [powDetermineKeyWordExist $currgn "LTV1"] set powLTV2($currgn) [powDetermineKeyWordExist $currgn "LTV2"] } } if [info exists powLTM_11($currgn)] { if { $powLTM_12($currgn) == "false" } { set powLTM_12($currgn) 0 } if { $powLTM_21($currgn) == "false" } { set powLTM_21($currgn) 0 } if { $powLTM_22($currgn) == "false" } { set powLTM_22($currgn) 0 } if { $powLTV1($currgn) == "false" } { set powLTV1($currgn) 0 } if { $powLTV2($currgn) == "false" } { set powLTV2($currgn) 0 } set physical_x [expr ($powLTM_22($currgn) * ($x - $powLTV1($currgn)) - $powLTM_21($currgn) * ($y - $powLTV2($currgn))) / ($powLTM_11($currgn) * $powLTM_22($currgn) - $powLTM_12($currgn) * $powLTM_21($currgn))] set physical_y [expr ( -1.0 * $powLTM_12($currgn) * ($x - $powLTV1($currgn)) + $powLTM_11($currgn) * ($y - $powLTV2($currgn))) / ($powLTM_11($currgn) * $powLTM_22($currgn) - $powLTM_12($currgn) * $powLTM_21($currgn))] } return [list $physical_x $physical_y] } proc powConvertRadiusImage2Physical { img_x img_y phy_x img_radius } { set img_outer_x [expr $img_x + $img_radius] set result [powConvertImage2Physical $img_outer_x $img_y] return [expr abs([lindex $result 0] - $phy_x)] } proc powHelp { topic } { #puts "powHelp start topic" global env tcl_platform powHelpTopics powbg powDWP global Rw if { [string match "*.html" $topic] } { set topic [string range $topic 0 end-5] } if { [winfo exist ${powDWP}hyperhelp] == 0} { if { $tcl_platform(platform)=="windows" } { set size large } else { set size medium } set allTopics {} foreach aTopic [lsort [array names powHelpTopics]] { lappend allTopics [list $powHelpTopics($aTopic) $aTopic] } iwidgets::hyperhelp ${powDWP}hyperhelp -title "POW: Hyperhelp" \ -topics $allTopics \ -fontname courier \ -fontsize $size \ -helpdir $env(POW_HELPDIR) \ -background $powbg \ -textbackground $powbg \ -beforelink "powHelpResolveLink" # -helpdir $env(POW_LIBRARY) catch { unset Rw } } ${powDWP}hyperhelp showtopic $topic ${powDWP}hyperhelp activate update idletasks if ![info exists Rw] { scan [winfo geometry ${powDWP}hyperhelp] "%dx%d+%d+%d" Rw Rh Rx Ry catch { wm geometry ${powDWP}hyperhelp [expr $Rw / 2]x[expr $Rh / 2]+0+0 } err } else { catch { wm geometry ${powDWP}hyperhelp ${Rw}x${Rh}+0+0 } err } } proc powHelpResolveLink { path } { global g_backupDir powDWP env if {![file exists $g_backupDir/$path] && [string first $env(POW_HELPDIR) $path] < 0 } { powHelp [${powDWP}hyperhelp cget -helpdir]/$path } else { powHelp $path } } proc powMax { a b } { #puts "powMax start" return [expr ($a > $b) ? $a : $b] } proc powMin { a b } { #puts "powMin start" return [expr ($a < $b) ? $a : $b] } proc powFindFont { w {pointsizes 120} {weight medium} {slant r}} { #puts "powFindFont start" foreach family {times courier helvetica } { foreach points $pointsizes { if {[catch {$w config -font \ -*-$family-$weight-$slant-*-*-*-$points-*}] == 0} { return -*-$family-$weight-$slant-*-*-*-$points-* } } } $w config -font fixed return fixed } proc powGetFontList { gn lbl } { #puts "powGetFontList start" global powFontParam return [list \ $powFontParam(${lbl}Font,$gn) \ $powFontParam(${lbl}Size,$gn) \ $powFontParam(${lbl}Weight,$gn) \ $powFontParam(${lbl}Slant,$gn)] } proc powScopeZoom { in_or_out {scale "no"} {value -1.0}} { global currgn saveROI global powPlotParam powZoomStart global g_magnification #puts "powScopeZoom start, g_magnification: $g_magnification" #puts "powScopeZoom start, scale: $scale" if ![info exists powPlotParam(prev_magnification,$currgn)] { set powPlotParam(prev_magnification,$currgn) 1.0 set powPlotParam(new_magnification,$currgn) 1.0 set powPlotParam(g_multiplier,$currgn) 4.0 set powPlotParam(g_magnification,$currgn) 1.0 } set powPlotParam(prev_magnification,$currgn) $powPlotParam(new_magnification,$currgn) set powPlotParam(new_magnification,$currgn) $g_magnification set powPlotParam(g_magnification,$currgn) $g_magnification if ![info exists g_magnification] { if { $value == -1.0 } { set powPlotParam(new_magnification,$currgn) 1.0 set powPlotParam(g_multiplier,$currgn) 4.0 set powPlotParam(g_magnification,$currgn) 1.0 set g_magnification 1.0 } } else { if { $value == -1.0 } { # exact magnification if [regexp "reset" $in_or_out] { set g_magnification 1.0 } set powPlotParam(new_magnification,$currgn) $g_magnification } else { if [regexp "in" $in_or_out] { set powPlotParam(new_magnification,$currgn) \ [expr $powPlotParam(prev_magnification,$currgn) * $value] } else { set powPlotParam(new_magnification,$currgn) \ [expr $powPlotParam(prev_magnification,$currgn) / $value] } set g_magnification $powPlotParam(new_magnification,$currgn) set powPlotParam(g_magnification,$currgn) $g_magnification } set powPlotParam(g_multiplier,$currgn) [expr 1.0 / $powPlotParam(new_magnification,$currgn)] set value $powPlotParam(new_magnification,$currgn) } #set select_magnification $g_magnification #puts "powPlotParam(prev_magnification,$currgn): $powPlotParam(prev_magnification,$currgn)" #puts "powPlotParam(new_magnification,$currgn): $powPlotParam(new_magnification,$currgn)" #puts "powPlotParam(g_multiplier,$currgn): $powPlotParam(g_multiplier,$currgn)" #puts "powPlotParam(g_magnification,$currgn): $powPlotParam(g_magnification,$currgn)" #puts "g_magnification: $g_magnification" #puts "value: $value" if { $powPlotParam(new_magnification,$currgn) < [expr 1.0 / 64.0] } { set powPlotParam(new_magnification,$currgn) [expr 1.0 / 64.0] set g_magnification [expr 1.0 / 64.0] tk_messageBox -icon error -type ok -parent .pow \ -message "Couldn't zoom out any further." return } if { $powPlotParam(prev_magnification,$currgn) == $powPlotParam(new_magnification,$currgn) } { powEndROI 1 return } set powZoomStart($currgn) 1 #powEndROI 1 set powZoomStart($currgn) 0 #set powPlotParam(g_magnification,$currgn) $powPlotParam(new_magnification,$currgn) #set powPlotParam(prev_magnification,$currgn) $powPlotParam(g_magnification,$currgn) if { $powPlotParam(new_magnification,$currgn) == 1.0 } { powEndROI 1 set powPlotParam(prev_magnification,$currgn) 1.0 set powPlotParam(new_magnification,$currgn) 1.0 set powPlotParam(g_multiplier,$currgn) 4.0 set powPlotParam(g_magnification,$currgn) 1.0 set g_magnification 1.0 return } if [regexp "in" $in_or_out] { set multiplier [expr $powPlotParam(prev_magnification,$currgn) / $powPlotParam(new_magnification,$currgn)] } else { set multiplier 2.0 } set powPlotParam(g_multiplier,$currgn) $multiplier # set GUI value #set powPlotParam(g_magnification,$currgn) [expr 1.0 / $multiplier] #set g_magnification $powPlotParam(g_magnification,$currgn) #puts "A1 powPlotParam(prev_magnification,$currgn): $powPlotParam(prev_magnification,$currgn)" #puts "A1 powPlotParam(new_magnification,$currgn): $powPlotParam(new_magnification,$currgn)" #puts "A1 powPlotParam(g_multiplier,$currgn): $powPlotParam(g_multiplier,$currgn)" #puts "A1 powPlotParam(g_magnification,$currgn): $powPlotParam(g_magnification,$currgn)" #puts "A1 g_magnification: $g_magnification" if {! [string compare [.pow.scope find withtag ROI] ""] || ![winfo ismapped .pow.scope]} { # no ROI currently, ROI is whole graph OR no scopebox at all set ROIbbox [.pow.pow coords ${currgn}box] set halfwidth [expr ([lindex $ROIbbox 2] - [lindex $ROIbbox 0])/2.0] set halfheight [expr ([lindex $ROIbbox 3] - [lindex $ROIbbox 1])/2.0] set x_center [expr [lindex $ROIbbox 0] + $halfwidth] set y_center [expr [lindex $ROIbbox 1] + $halfheight] set new_halfwidth [expr $halfwidth * $multiplier] set new_halfheight [expr $halfheight * $multiplier] .pow.pow create rectangle \ [expr $x_center - $new_halfwidth] \ [expr $y_center - $new_halfheight] \ [expr $x_center + $new_halfwidth] \ [expr $y_center + $new_halfheight] \ -tags ROI -outline blue powEndROI 2 .pow.pow return } else { set ROIbbox [.pow.scope coords ROI] set saveROI $ROIbbox .pow.scope delete ROI } set halfwidth [expr ([lindex $ROIbbox 2] - [lindex $ROIbbox 0])/2.0] set halfheight [expr ([lindex $ROIbbox 3] - [lindex $ROIbbox 1])/2.0] set x_center [expr [lindex $ROIbbox 0] + $halfwidth] set y_center [expr [lindex $ROIbbox 1] + $halfheight] set new_halfwidth [expr $halfwidth * $multiplier] set new_halfheight [expr $halfheight * $multiplier] .pow.scope create rectangle \ [expr $x_center - $new_halfwidth] \ [expr $y_center - $new_halfheight] \ [expr $x_center + $new_halfwidth] \ [expr $y_center + $new_halfheight] \ -tags ROI -outline blue powEndROI 2 .pow.scope #puts "A powPlotParam(prev_magnification,$currgn): $powPlotParam(prev_magnification,$currgn)" #puts "A powPlotParam(new_magnification,$currgn): $powPlotParam(new_magnification,$currgn)" #puts "A powPlotParam(g_multiplier,$currgn): $powPlotParam(g_multiplier,$currgn)" #puts "A powPlotParam(g_magnification,$currgn): $powPlotParam(g_magnification,$currgn)" #puts "A g_magnification: $g_magnification" #set g_magnification $select_magnification } proc powGetCurrVariables {} { #puts "powGetCurrVariables start" global powPlotParam currgn currimg global powCurveParam global powImageParam global powFontParam if { ![info exists currgn] || $currgn=="powDef" } return foreach opt $powPlotParam(allOpts,powDef) { set powPlotParam(${opt},powDef) $powPlotParam(${opt},$currgn) } if { [info exists currimg] && $currimg != "" } { foreach opt $powImageParam(allOpts,powDef) { set powImageParam(${opt},powDef) \ $powImageParam(${opt}${currimg},$currgn) } } set crv [lindex $powPlotParam(curves,$currgn) 0] if { $crv != "NULL" } { foreach opt $powCurveParam(allOpts,powDef) { set powCurveParam(${opt},powDef) \ $powCurveParam(${opt}${crv},$currgn) } } foreach lbl $powFontParam(allTypes,powDef) { foreach opt $powFontParam(allOpts,powDef) { set powFontParam(${lbl}${opt},powDef) \ $powFontParam(${lbl}${opt},$currgn) } } } proc powSaveConfig { } { global powbg powCurveParam powImageParam powFontParam global powcursor powResizeMain currgn global showlinks powScopeHeight powScopeWidth powMinHeight powMinWidth global powPlotParam powShowScope powGUIposition global powLutButton powROIButton global POWRC currgn fvPrefObj event delete <> event delete <> event delete <> event delete <> event delete <> event delete <> event add <> event add <> event add <> event add <> if { $powROIButton != 0 && $powROIButton != "NULL" } { # Must delete BtnPress sequence to prevent it from hiding the ROI event event delete <> event add <> event add <> } if [catch {open $POWRC w} RCFILE] { error "Couldn't open $POWRC, not saving configuration" } else { puts $RCFILE "\n# Application parameters:" puts $RCFILE "set powbg \"$powbg\"" puts $RCFILE "set powcursor \"$powcursor\"" puts $RCFILE "set powResizeMain \"$powResizeMain\"" puts $RCFILE "set showlinks \"$showlinks\"" if { $powShowScope } { puts $RCFILE "set powScopeWidth \"$powScopeWidth\"" puts $RCFILE "set powScopeHeight \"$powScopeHeight\"" } else { puts $RCFILE "set powScopeWidth \"0\"" puts $RCFILE "set powScopeHeight \"0\"" } puts $RCFILE "set powMinHeight \"$powMinHeight\"" puts $RCFILE "set powMinWidth \"$powMinWidth\"" puts $RCFILE "set powGUIposition \"$powGUIposition\"" puts $RCFILE "set powLutButton \"$powLutButton\"" puts $RCFILE "set powROIButton \"$powROIButton\"" puts $RCFILE "\n# Default Font Parameters:" foreach lbl $powFontParam(allTypes,powDef) { foreach opt $powFontParam(allOpts,powDef) { puts $RCFILE "set powFontParam(${lbl}${opt},powDef)\ \"$powFontParam(${lbl}${opt},powDef)\"" } } if [info exists powPlotParam(xdimdisp,$currgn)] { set powPlotParam(xdimdisp,powDef) $powPlotParam(xdimdisp,$currgn) set powPlotParam(ydimdisp,powDef) $powPlotParam(ydimdisp,$currgn) # set result [$fvPrefObj setNewGraphSize [list $powPlotParam(xdimdisp,$currgn) $powPlotParam(ydimdisp,$currgn)]] } puts $RCFILE "\n# Default Graph Parameters:" foreach opt $powPlotParam(allOpts,powDef) { puts $RCFILE "set powPlotParam($opt,powDef)\ \"$powPlotParam($opt,powDef)\"" } puts $RCFILE "\n# Default Curve Parameters:" foreach opt $powCurveParam(allOpts,powDef) { puts $RCFILE "set powCurveParam($opt,powDef) \"$powCurveParam($opt,powDef)\"" } puts $RCFILE "\n# Default Image Parameters:" foreach opt $powImageParam(allOpts,powDef) { puts $RCFILE "set powImageParam($opt,powDef) \"$powImageParam($opt,powDef)\"" } close $RCFILE } } proc powBreakAllLinks { } { #puts "powBreakAllLinks start" #deletes all link info global axisToChainHash chainToAxisHash nextchain if [info exists axisToChainHash] { unset axisToChainHash unset chainToAxisHash unset nextchain } .pow.pow delete link } proc powLinkAxes {gn1 axis1 gn2 axis2} { #puts "powLinkAxes start" global axisToChainHash chainToAxisHash nextchain #catch stupid input if {$gn1 == $gn2} {return} if {![info exists nextchain]} { set nextchain 1 } set graphlist [powListGraphs] if {[lsearch $graphlist $gn1] == -1} {return "graph $gn1 does not exist";} if {[lsearch $graphlist $gn2] == -1} {return "graph $gn2 does not exist";} set chain1 0 set chain2 0 if {[array names axisToChainHash $gn1$axis1] != ""} {set chain1 $axisToChainHash($gn1$axis1)} if {[array names axisToChainHash $gn2$axis2] != ""} {set chain2 $axisToChainHash($gn2$axis2)} if {$chain1 == 0 && $chain2 == 0} { #new chain set axisToChainHash($gn1$axis1) $nextchain set axisToChainHash($gn2$axis2) $nextchain set chainToAxisHash($nextchain) [list $gn1$axis1 $gn2$axis2] incr nextchain } elseif {$chain1 != 0 && $chain2 !=0} { #two chains, delete one powMergeChains $chain1 $chain2 } elseif {$chain1 != 0} { #add axis 2 to chain 1 set axisToChainHash($gn2$axis2) $chain1 lappend chainToAxisHash($chain1) $gn2$axis2 } else { #add axis 1 to chain 2 set axisToChainHash($gn1$axis1) $chain2 lappend chainToAxisHash($chain2) $gn1$axis1 } } proc powMergeChains {chain1 chain2} { #puts "powMergeChains start" #delete two existing chains and make a new one consisting of all of their #members global axisToChainHash chainToAxisHash nextchain foreach axis [array names axisToChainHash] { if {$axisToChainHash($axis) == $chain1 || \ $axisToChainHash($axis) == $chain2} { set axisToChainHash($axis) $nextchain } } set chainToAxisHash($nextchain) [concat $chainToAxisHash($chain1) $chainToAxisHash($chain2)] unset chainToAxisHash($chain1) unset chainToAxisHash($chain2) } proc powBreakLink {gn axis} { #puts "powBreakLink start" #removes graph 1 axis 1 from the chain it belongs to global axisToChainHash chainToAxisHash set chain 0 if {[array names axisToChainHash $gn$axis] != ""} { set chain $axisToChainHash($gn$axis) } else { puts "Graph $gn axis $axis is not part of a chain" return } unset axisToChainHash($gn$axis) if {[llength $chainToAxisHash($chain)] <= 2} { unset chainToAxisHash($chain) } else { set chainToAxisHash($chain) [lreplace $chainToAxisHash($chain) [set bozo [lsearch $chainToAxisHash($chain) $gn$axis]] $bozo] } } proc chop {theString} { #puts "chop start" return [string range $theString 0 [expr [string length $theString]-2]] } proc powAlignChain {gn axis orient {gap default}} { #puts "powAlignChain start" #stacks all graphs in a chain either (H)orizontally or (V)ertically global axisToChainHash chainToAxisHash powResizeMain powPlotParam if {![info exists axisToChainHash($gn$axis)]} return; foreach graph $chainToAxisHash($axisToChainHash($gn$axis)) { #some (all?) graphs in a chain may be unmapped so loop until we get one #that is mapped set oldgraph [lindex $chainToAxisHash($axisToChainHash($gn$axis)) 0] set oldgraph [chop $oldgraph] if {[.pow.pow find withtag $oldgraph] != ""} break } foreach graph [lrange $chainToAxisHash($axisToChainHash($gn$axis)) 1 end] { set graph [chop $graph] if {[.pow.pow find withtag $graph] != ""} { #good, this graph is mapped set gbox [.pow.pow coords ${oldgraph}box] set bbox [.pow.pow bbox ${oldgraph}] if {[lindex $orient 0] == "H"} { if {$gap == "default"} { set gap [expr 2 * $powPlotParam(xmargin,$graph)] } set toX [expr [lindex $bbox 2] \ + $gap ] set toY [lindex $gbox 1] } else { if {$gap == "default"} { set gap [expr 2 * $powPlotParam(ymargin,$graph)] } set toX [lindex $gbox 0] set toY [expr [lindex $bbox 3] + $gap ] } set coords [.pow.pow coords ${graph}box] set fromX [lindex $coords 0] set fromY [lindex $coords 1] powMoveGraph $graph [expr int($toX - $fromX)] [expr int($toY - $fromY)] set oldgraph $graph } } powReconfigureToplevel $powResizeMain } proc powReconfigureToplevel {{resizemain 1} } { #puts "powReconfigureToplevel start" global powMinHeight powMinWidth powMaxWidth powMaxHeight global powRealMinHeight powRealMinWidth global powHeaderWidth powHeaderHeight global powContainer #resize POW window if necessary # update idletasks set bigbbox [.pow.pow bbox all] if {$resizemain && ($powContainer == "none" || $powContainer == "NULL")} { set windowX [expr [lindex $bigbbox 2] - [lindex $bigbbox 0] + 50] set windowY [expr [lindex $bigbbox 3] - [lindex $bigbbox 1] + 50] set windowX [powMax $windowX $powMinWidth ] set windowY [powMax $windowY $powMinHeight] set windowX [powMin $windowX $powMaxWidth ] set windowY [powMin $windowY $powMaxHeight] incr windowX $powHeaderWidth incr windowY $powHeaderHeight set windowX [powMax $windowX $powRealMinWidth ] set windowY [powMax $windowY $powRealMinHeight] foreach {x y} [lrange [split [wm geometry .pow] {x+-}] 2 3] {} if {$x != 0 && $y != 0} { catch {wm geometry .pow "${windowX}x${windowY}+$x+$y"} } else { catch {wm geometry .pow "${windowX}x${windowY}"} } } # Check if scrollregion has significantly changed so that one doesn't # force a full-screen update set currBnds [.pow.pow cget -scrollregion] set newBnds [list [expr [lindex $bigbbox 0] - 20] \ [expr [lindex $bigbbox 1] - 20] \ [expr [lindex $bigbbox 2] + 20] \ [expr [lindex $bigbbox 3] + 20] ] if { [expr abs([lindex $currBnds 0]-[lindex $newBnds 0])]>10 \ || [expr abs([lindex $currBnds 1]-[lindex $newBnds 1])]>10 \ || [expr abs([lindex $currBnds 2]-[lindex $newBnds 2])]>10 \ || [expr abs([lindex $currBnds 3]-[lindex $newBnds 3])]>10 } { .pow.pow configure -scrollregion $newBnds } powShowLinks } proc powChangeBg {} { #puts "powChangeBg start" global powbg powShowHandlesFlag powPlotParam set oldpowbg [.pow.pow cget -background] foreach com [info commands .pow.*] { if {[$com cget -bg] == $oldpowbg} { catch {$com configure -bg $powbg} } if {[$com cget -background] == $oldpowbg} { catch {$com configure -background $powbg} } } #catch the next line in case no graphs yet catch {.pow.currgn configure -background yellow} .pow configure -bg $powbg foreach gn [powListGraphs] { if {![regexp {scope$} $gn] && \ $powPlotParam(bgcolor,$gn) == $oldpowbg} { powGraphOptions $gn bgcolor $powbg } } } proc powExit { } { global axisToChainHash chainToAxisHash nextchain powGUI powRegionListGlobal #set powRegionListGlobal {} destroy .pow catch { unset axisToChainHash } catch { unset chainToAxisHash } catch { unset nextchain} powCleanUp } proc powLogGraph { gn x y } { #puts "powLogGraph start" global powPlotParam powCurveParam # Cannot have log plots with WCS information if { [powWCSexists $gn] && ($x=="log" || $y=="log") } { error "Cannot apply log transforms to WCS graphs" } foreach bnd [list xBot yBot xTop yTop xTickScal yTickScal] { set $bnd $powPlotParam($bnd,$gn) } if { $powPlotParam(curves,$gn) != "NULL" } { # Try to preserve the bounding box region if { $x!=$xTickScal } { if { $x=="log" } { if { $xBot>0.0 } { set xBot [expr log10($xBot)] } else { set xBot NULL } if { $xTop>0.0 } { set xTop [expr log10($xTop)] } else { set xTop NULL } } else { if { $xBot<-300 || $xBot>300 } { set xBot NULL } else { set xBot [expr pow(10.0,$xBot)] } if { $xTop<-300 || $xTop>300 } { set xTop NULL } else { set xTop [expr pow(10.0,$xTop)] } } } if { $y!=$yTickScal } { if { $y=="log" } { if { $yBot>0.0 } { set yBot [expr log10($yBot)] } else { set yBot NULL } if { $yTop>0.0 } { set yTop [expr log10($yTop)] } else { set yTop NULL } } else { if { $yBot<-300 || $yBot>300 } { set yBot NULL } else { set yBot [expr pow(10.0,$yBot)] } if { $yTop<-300 || $yTop>300 } { set yTop NULL } else { set yTop [expr pow(10.0,$yTop)] } } } set powPlotParam(xBot,$gn) $xBot set powPlotParam(yBot,$gn) $yBot set powPlotParam(xTop,$gn) $xTop set powPlotParam(yTop,$gn) $yTop } set powPlotParam(xTickScal,$gn) $x set powPlotParam(yTickScal,$gn) $y if { $x=="log" } { set x Yes } else { set x No } if { $y=="log" } { set y Yes } else { set y No } foreach crv $powPlotParam(curves,$gn) { if { $crv == "NULL" } continue set powCurveParam(logX${crv},$gn) $x set powCurveParam(logY${crv},$gn) $y } powEraseGraph $gn 1 powMapGraph $gn # powAdornGraph $gn .pow.pow # powRedrawGraphHandles $gn } proc powEraseGraph { gn {scope 1}} { #puts "powEraseGraph start" global powGUI currgn #Removes a graph from the display .pow.pow delete $gn .pow.pow delete ${gn}handles if { $currgn==$gn } { .pow.pow delete current_gn if {$powGUI && $scope} { .pow.scope delete all } } } proc powDeleteGraph { gn {opt "prompt"} } { global powFitsHeader powFitsHeaderCnt global xCount yCount powWCS #puts "powDeleteGraph start" if { $opt == "prompt" } { set feedback [promptMsg "This will permanently delete current graph.\n Do you want to continue?" \ return Yes No] if { $feedback == "CANCEL" } return } catch { powDestroyGraph $gn } err catch { powDeleteImage $gn $gn } err catch { powDeleteCurve $gn $gn } err catch { unset powFitsHeader($gn) } catch { unset powFitsHeaderCnt($gn) } catch { unset powFitsHeader(${gn}scope) } catch { unset powFitsHeaderCnt(${gn}scope) } catch { unset xCount($gn) } catch { unset xCount(${gn}scope) } catch { unset yCount($gn) } catch { unset yCount(${gn}scope) } catch { unset powWCS($gn) } catch { unset powWCS(${gn}scope) } } proc powFreeGraph { gn } { #puts "powFreeGraph start" # Called from powDestroyGraph global powOrderedGraphList set idx [lsearch -exact $powOrderedGraphList $gn] if { $idx >= 0 } { set powOrderedGraphList \ [lreplace $powOrderedGraphList $idx $idx ""] } [gNotifications default] postMessage $gn graphHasBeenDestroyed } proc powUnmapGraph { gn } { #puts "powUnmapGraph start" global currgn powScopeGn powEraseGraph $gn 1 if { $currgn == $gn } { set currgn "powDef" set powScopeGn "-" set otherGraphs [.pow.pow find withtag gbox] if {$otherGraphs != ""} { set newGraph [lindex [.pow.pow gettags [lindex $otherGraphs end]] 0] powSelectGraph $newGraph } else { powUpdateGraphMenuOptions powUpdateCurrentDialogs } } } proc powMapGraph { gn {restore_position 0}} { #puts "powMapGraph start" global powPlotParam if $restore_position { set xo $powPlotParam(xo,$gn) set yo $powPlotParam(yo,$gn) } powCreateGraph $gn $powPlotParam(curves,$gn) $powPlotParam(images,$gn) \ $powPlotParam(xunits,$gn) $powPlotParam(yunits,$gn) \ $powPlotParam(xlabel,$gn) $powPlotParam(ylabel,$gn) \ $powPlotParam(xdimdisp,$gn) $powPlotParam(ydimdisp,$gn) \ $powPlotParam(xBot,$gn) $powPlotParam(yBot,$gn) \ $powPlotParam(xTop,$gn) $powPlotParam(yTop,$gn) if $restore_position { powMoveGraphTo $gn $xo $yo .pow.pow } } proc powDeleteImage {gn img} { #puts "powDeleteImage start" global powPlotParam .pow.pow delete ${img}disp$gn catch {.pow.scope delete ${img}disp${gn}scope} .pow.pow delete current_img catch { image delete $img image delete $gn } err catch { image delete ${img}scope image delete ${gn}scope } err catch { image delete ${curve}$img image delete ${curve}$gn } err set whichImage [lsearch $powPlotParam(images,$gn) $img] set powPlotParam(images,$gn) [lreplace $powPlotParam(images,$gn) $whichImage $whichImage] } proc powDeleteCurve {gn curve} { #puts "powDeleteCurve start" #deletes global powPlotParam .pow.pow delete ${curve}$gn catch {.pow.scope delete ${curve}${gn}scope} set whichCurve [lsearch $powPlotParam(curves,$gn) $curve] set powPlotParam(curves,$gn) [lreplace $powPlotParam(curves,$gn) $whichCurve $whichCurve] } proc invert_cmap_if_flag_set { gn img } { #puts "invert_cmap_if_flag_set start" global cmap_inv powPseudoImages currimg currgn powImageParam if { $powImageParam(invert${img},$gn) } { if $powPseudoImages { ${img}disp${gn} colormap invert } else { powPhotoColorTable invert } } } proc powAddCustomLut { cmapName lut } { #puts "powAddCustomLut start" global powImageParam powbg if { [expr [llength $lut]%3]!=0 } { error "Lut must be list with multiple-of-3 elements (R G B)" } set powImageParam(cmapLUT_$cmapName,powDef) $lut set allMaps $powImageParam(allMaps,powDef) set map [lindex $allMaps end] if { [lindex $map 0] == "Custom" } { if { [lsearch -exact $map $cmapName]==-1 } { lappend map $cmapName # Add menu item to Custom menu .pow.mbar.colors.cCustom add radiobutton -label $cmapName \ -value $cmapName \ -variable powImageParam(colormap,powDef) \ -command "powCmds::colormap $cmapName" } set powImageParam(allMaps,powDef) [lreplace $allMaps end end $map] } else { lappend powImageParam(allMaps,powDef) [list Custom $cmapName] # Add Cust menu plus this item set bdVal [.pow.mbar.colors cget -bd] set idx [.pow.mbar.colors index [lindex $map 0]] incr idx menu .pow.mbar.colors.cCustom -bg $powbg -bd $bdVal .pow.mbar.colors insert $idx cascade -menu .pow.mbar.colors.cCustom \ -label "Custom" .pow.mbar.colors.cCustom add radiobutton -label $cmapName \ -value $cmapName \ -variable powImageParam(colormap,powDef) \ -command "powCmds::colormap $cmapName" } return } proc powSetLut { gn img scale {recalc {}} } { #puts "powSetLut start" global powSqueeze powSlide powClen global currimg currgn powPlotParam powImageParam set powClen 255 if {$scale == $powImageParam(scale${img},$gn) && $recalc=="" \ && [info exists powImageParam(lut${img},$gn)] } { powSetImageScale $gn $img $scale powCmapStretchIntensity $gn $img $powClen $powClen \ $powImageParam(lut${img},$gn) return } powSetImageScale $gn $img $scale set powSqueeze 0.0 set powSlide 0.0 powCmapStretchIntensity $gn $img $powClen $powClen \ [list 0 0 $powClen $powClen] } proc powSetImageScale { gn img scale } { #puts "powSetImageScale start" global powPseudoImages currimg currgn global powPlotParam powImageParam powGUI foreach {gn2 img2} [powGetColorbarLink $gn $img] {} set powImageParam(scale${img},$gn) $scale if { $gn2 != "" } { set powImageParam(scale${img2},$gn2) $scale } if { $powGUI && ![regexp scope$ $gn] } { set powImageParam(scale${img},${gn}scope) $scale if { $gn2 != "" } { set powImageParam(scale${img2},${gn2}scope) $scale } } # Make sure we only do the equalization on original image, not colorbar # nor colorbar's scope image if { $scale == "histo" } { if { $powGUI && [regexp scope$ $gn] } { set gn [string range $gn 0 [expr [string length $gn]-6]] foreach {gn2 img2} [powGetColorbarLink $gn $img] {} } if { [regexp _colorbar$ $img] } { if { $img2 != "" } { set gn $gn2 set img $img2 } } } if { $scale == "histo" } { set minmax [powImageScale $scale $img \ $powImageParam(RBmin${img},$gn) \ $powImageParam(RBmax${img},$gn)] } else { powImageScale $scale } } proc powCmapStretchIntensity { gn img cwidth clen lut } { #puts "powCmapStretchIntensity start" global powPseudoImages global powPlotParam powImageParam powGUI foreach {gn2 img2} [powGetColorbarLink $gn $img] {} set powImageParam(lut${img},$gn) $lut if { $gn2 != "" } { set powImageParam(lut${img2},$gn2) $lut } if { $powGUI && ![regexp scope$ $gn] } { set powImageParam(lut${img},${gn}scope) $lut if { $gn2 != "" } { set powImageParam(lut${img2},${gn2}scope) $lut } } if $powPseudoImages { ${img}disp${gn} cmap_stretch intensity $cwidth $clen $lut if { $gn2 != "" } { ${img2}disp${gn2} cmap_stretch intensity $cwidth $clen $lut } } else { # powPhotoColorTable $powImageParam(colormap${img},$gn) powPhotoCmapStretch $cwidth $clen $lut } } proc powBoundDiddleLut {gn img x y} { #puts "powBoundDiddleLut start" set cx [.pow.pow canvasx $x] set cy [.pow.pow canvasy $y] set bbox [.pow.pow coords ${gn}box] set lx [lindex $bbox 0] set ly [lindex $bbox 1] set ux [lindex $bbox 2] set uy [lindex $bbox 3] #make range from -1 to 1 set fx [expr (2.0 * ($cx - $lx)/($ux - $lx) - 1.0)] set fy [expr (2.0 * ($cy - $ly)/($uy - $ly) - 1.0)] powDiddleLut $gn $img $fx $fy } proc powDiddleLut { gn img slide squeeze } { #puts "powDiddleLut start" #$squeze and $slide should range from -1 to 1, not inclusive global powSqueeze powSlide currimg powClen global powPseudoImages powPlotParam powImageParam currgn set powSqueeze $squeeze set powSlide $slide if { ![info exist powClen] } return set squeeze [expr double($powSqueeze)] set slide [expr double($powSlide)] set increment [expr int($powClen * $slide)] if {$squeeze > 0 && $squeeze < 1} { set factor [expr (1.0 - $squeeze)] set increment [expr $increment + $squeeze*$powClen/5.0] } elseif {$squeeze < 0 && $squeeze > - 1} { set factor [expr 1.0/(1.0 + $squeeze)] set increment [expr $increment - ($factor - 1.0) * $powClen/5.0] } else { set factor 1.0 } for {set i 0} {$i <= $powClen} {incr i 5} { set newi [expr $i * $factor + $increment] set newi [expr ($newi < 0 ) ? 0 : $newi] set newi [expr ($newi > $powClen ) ? $powClen : $newi] lappend l2 [expr int(floor($newi))] lappend l2 $i } powCmapStretchIntensity $gn $img $powClen $powClen $l2 if { !$powPseudoImages } { powReditherImages $gn $img } } proc powShowHandles {showhandles } { #puts "powShowHandles start" global powShowHandlesFlag currgn powbg powPlotParam tcl_platform global powHiddenWindows set powShowHandlesFlag $showhandles if {$showhandles} then { .pow.pow raise current_img .pow.pow raise current_gn .pow.pow itemconfigure current_img -outline green .pow.pow itemconfigure current_gn -outline yellow .pow.pow raise buttonfg .pow.pow configure -bg $powbg foreach graph [powListGraphs] { .pow.pow itemconfigure ${graph}bkg -fill $powPlotParam(bgcolor,$graph) \ -outline $powPlotParam(bgcolor,$graph) #for win32 if {[string match "Win*" $tcl_platform(os) ] &&\ ![regexp {scope$} $graph]} { .pow.pow delete deleteMe set images $powPlotParam(images,$graph) set powPlotParam(images,$graph) 'NULL' powPlotImages $graph $images .pow.pow } } foreach key [array names powHiddenWindows "*,loc"] { foreach [list wind k] [split $key ,] {} eval .pow.pow create window $powHiddenWindows($wind,loc) \ -tags {$powHiddenWindows($wind,tags)} -window $wind \ -anchor $powHiddenWindows($wind,anchor) unset powHiddenWindows($key) } } else { .pow.pow itemconfigure ohandle -outline {} .pow.pow lower ohandle .pow.pow itemconfigure graphbkg -fill {} -outline {} # .pow.pow configure -bg white .pow.pow raise ${currgn}line foreach wind [.pow.pow find withtag canvas_window] { set windowname [.pow.pow itemcget $wind -window] set powHiddenWindows($windowname,loc) \ [.pow.pow coord $wind] set powHiddenWindows($windowname,tags) \ [.pow.pow itemcget $wind -tags] set powHiddenWindows($windowname,anchor) \ [.pow.pow itemcget $wind -anchor] .pow.pow delete $wind # $windowname configure -foreground white -background white \ # -highlightthickness 0 -relief flat } } } proc chopped {theString} { #puts "chopped start" return [string index $theString [expr [string length $theString] - 1]] } proc powShowLinks { } { #puts "powShowLinks start" global showlinks axisToChainHash chainToAxisHash .pow.pow delete link if {$showlinks} then { foreach chain [array names chainToAxisHash] { set oldaxis [chopped $chainToAxisHash($chain)] set oldgraph [chop [lindex $chainToAxisHash($chain) 0]] foreach graph [lrange $chainToAxisHash($chain) 1 end] { set axis [chopped $graph] set graph [chop $graph] set abox [.pow.pow coords ${oldgraph}box] set bbox [.pow.pow coords ${graph}box] if {$oldaxis == "X"} { set fromX [expr int(([lindex $abox 2]+[lindex $abox 0])/2.0)] set fromY [expr int([lindex $abox 3])] } else { set fromY [expr int(([lindex $abox 3]+[lindex $abox 1])/2.0)] set fromX [expr int([lindex $abox 0])] } if {$axis == "X"} { set toX [expr int(([lindex $bbox 2]+[lindex $bbox 0])/2.0)] set toY [expr int([lindex $bbox 3])] } else { set toY [expr int(([lindex $bbox 3]+[lindex $bbox 1])/2.0)] set toX [expr int([lindex $bbox 0])] } .pow.pow create line $fromX $fromY $toX $toY -tags "link" -fill pink set oldaxis $axis set oldgraph $graph } } } } proc powGetColorbarLink { gn img } { #puts "powGetColorbarLink start" global powPlotParam if { [info exists powPlotParam(Colorbar${img},$gn)] } { regexp "(.*)disp(.*)" $powPlotParam(Colorbar${img},$gn) z img2 gn2 } elseif { [info exists \ powPlotParam(Colorbar${img}_colorbar,${gn}_colorbar)] } { set img2 ${img}_colorbar set gn2 ${gn}_colorbar } else { set img2 "" set gn2 "" } return [list $gn2 $img2] } proc powSetCurrImageOpts { args } { #puts "powSetCurrImageOpts start" global powImageParam powPlotParam curr_img currimg currgn if { [info exists curr_img] && $currgn!="powDef" } { foreach img $powPlotParam(images,$currgn) { eval powSetImageOptions $currgn $img $args } } } proc powSetImageOptions {gn image {args ""}} { #puts "powSetImageOptions start" global powPlotParam powImageParam powGUI currgn foreach {gn2 image2} [powGetColorbarLink $gn $image] {} if { $args == "" } { set lst "" foreach opt $powImageParam(allOpts,powDef) { catch {lappend lst $opt $powImageParam(${opt}${image},$gn)} } return $lst } else { foreach {opt val} $args { set idx [lsearch -exact $powImageParam(allOpts,powDef) $opt] if { $idx != -1 } { set powImageParam(${opt}${image},$gn) $val if { $gn2 != "" } { set powImageParam(${opt}${image2},$gn2) $val } } if { $opt=="scale" } { powSetLut $gn $image $val forceIt } } if { [.pow.pow find withtag ${image}disp${gn}] != "" } { powSetColorTable $gn $image powReditherImages $gn $image } } } proc powPlotImages {gn images {canvas ".pow.pow"}} { #puts "powPlotImage starts" global powPlotParam powImageParam global filename_array powcursor global powPseudoImages powRBmin powRBmax if [regexp "NULL" $images] return # remove "NULL" from images list if present if [regexp "NULL" $powPlotParam(images,$gn)] { set powPlotParam(images,$gn) {} } set imgcnt 0 foreach current_image "$images" { # if image is already in list, don't plot it if {[lsearch $powPlotParam(images,$gn) $current_image]>=0} continue # Check if image's WCS/scaling is consistent with this graph if { [catch {powTestImage $gn $current_image} err] } { tk_messageBox -icon error -type ok -parent .pow \ -message "Couldn't place $current_image into graph...\ \n\n\"$err\"\n\nSkipping image." continue } incr imgcnt #puts "\nplotting image: $current_image in $gn" # Setup defaults... powDef for images, original for colorbars if { $canvas == ".pow.scope" } { set trueGn [string range $gn 0 [expr [string length $gn]-6] ] foreach opt $powImageParam(allOpts,powDef) { set powImageParam(${opt}${current_image},$gn) \ $powImageParam(${opt}${current_image},$trueGn) } set powImageParam(RBmin${current_image},$gn) \ $powImageParam(RBmin${current_image},$trueGn) set powImageParam(RBmax${current_image},$gn) \ $powImageParam(RBmax${current_image},$trueGn) # set powImageParam(lut${current_image},$gn) \ # $powImageParam(lut${current_image},$trueGn) } elseif { [string match "*_colorbar" $gn] && \ [string match "*_colorbar" $current_image] } { regexp "(.*)disp(.*)" \ $powPlotParam(Colorbar${current_image},$gn) z orig_img orig_gn foreach opt $powImageParam(allOpts,powDef) { if { ![info exists powImageParam(${opt}${current_image},$gn)] } { set powImageParam(${opt}${current_image},$gn) \ $powImageParam(${opt}${orig_img},$orig_gn) } set powImageParam(lut${current_image},$gn) \ $powImageParam(lut${orig_img},$orig_gn) } } else { foreach opt $powImageParam(allOpts,powDef) { #puts "pow.tcl: opt: ${opt}" if { ![info exists powImageParam(${opt}${current_image},$gn)] } { set powImageParam(${opt}${current_image},$gn) \ $powImageParam(${opt},powDef) #puts "pow.tcl: powImageParam(${opt},powDef): $powImageParam(${opt},powDef)" } } } # make a copy of the current image if $powPseudoImages { image create pict ${current_image}disp$gn } else { image create photo ${current_image}disp$gn } #This if block allows rescalings to persist through ROI zooms #you could get very bizarre behavior is somebodies reusing image names.... #nothing I can think of to do about that though if {![info exists powImageParam(RBmin${current_image},$gn)]} { #puts "pow.tcl: RBmin not exists" set powImageParam(RBmin${current_image},$gn) \ $powRBmin($current_image) set powImageParam(RBmax${current_image},$gn) \ $powRBmax($current_image) } set clipbox [powGetImageClipbox $gn $current_image $canvas] set powPlotParam(clipbox$current_image,$gn) $clipbox if {![regexp "clipped" $clipbox]} { # First two elements indicate location on graph to place image set x0 [lindex $clipbox 0] set y0 [lindex $clipbox 1] #puts "pow.tcl: BX0: $x0" #puts "pow.tcl: BY0: $y0" set pcoords [powGraphToCanvas $gn $x0 $y0 $canvas] set x0 [lindex $pcoords 0] set y0 [lindex $pcoords 1] #puts "pow.tcl: AX0: $x0" #puts "pow.tcl: AY0: $y0" set image_id [$canvas create image $x0 $y0 \ -image ${current_image}disp$gn -anchor sw \ -tags "$gn disp$gn\ ${current_image}disp$gn image_body\ img_$current_image"] if {$canvas == ".pow.pow" } { powBindBtn <> ".pow.pow bind $image_id" \ "powSelectImage $gn $current_image" \ "powBoundDiddleLut $gn $current_image %x %y" \ {} # The following prevents the <> binding from executing if # the <> binding is more appropriate due to modifiers # Pan Chai - commented out to make sure RegionList create correctly # powBindBtn <> ".pow.pow bind $image_id" {} {} {} if { ![info exists selImg] } {set selImg $current_image} } } lappend powPlotParam(images,$gn) $current_image powSetColorTable $gn $current_image powReditherImage $gn $current_image $canvas } if { [llength $powPlotParam(images,$gn)]==0 } { set powPlotParam(images,$gn) "NULL" } if { [info exists selImg] } { powSelectImage $gn $selImg } #puts "pow.tcl: done" } proc powDeSelectImage { } { #puts "powDeSelectImage start" global curr_img currimg powPlotParam if {[string compare [.pow.pow find withtag current_img] ""]} { .pow.pow delete current_img } catch {unset curr_img} catch {unset currimg} } proc powSelectImage {gn img} { #puts "powSelectImage start" global curr_img currimg powPlotParam powGUI currgn powPseudoImages #puts "gn: $gn, currgn: $currgn" set powPlotParam(currimg,$gn) $img if { $gn != $currgn } return #delete previous bbox rectangle .pow.pow delete current_img #make all things visible .pow.pow raise ${gn}line if { [info exists currimg] } { set prevImg $currimg set prevGn $currgn } else { set prevImg "" set prevGn "" } set currimg $img set curr_img ${img}disp$gn set tags [.pow.pow find withtag disp$gn] if { $tags != "" } { .pow.pow raise $curr_img [lindex $tags end] } if $powGUI { set scopeids [.pow.scope find withtag disp${gn}scope] if {$scopeids != ""} { .pow.scope raise img_$img [lindex $scopeids end] } } set ibbox [.pow.pow bbox ${img}disp$gn] if {$ibbox != ""} { eval [concat .pow.pow create rectangle $ibbox \ -tags [list "current_img $gn handle ohandle"] -outline green] } if { $currgn != $prevGn || $currimg != $prevImg } { powSetColorTable $currgn $currimg powUpdateGraphMenuOptions [gNotifications default] postMessage $currimg imageHasBeenSelected } } proc powSelectGraph {gn} { global powDWP global currgn currimg mag powPlotParam global powGUI powScopeGn yellowLineWidth global g_magnification #add a bit of slack around bbox foreach [list x0 y0 x1 y1] [.pow.pow bbox $gn] {} if { [llength [.pow.pow bbox $gn]] == 0 } return incr x0 -2 incr y0 -2 incr x1 2 incr y1 2 foreach [list ox0 oy0 ox1 oy1] [.pow.pow coord current_gn] {} if { ![info exists ox0] || \ [expr abs( $x0 - $ox0 ) + abs( $y0 - $oy0 ) + \ abs( $x1 - $ox1 ) + abs( $y1 - $oy1 ) ] > 1 } { #delete previous bbox rectangle .pow.pow delete current_gn .pow.pow create rectangle $x0 $y0 $x1 $y1 \ -tags "current_gn graphDragable ${gn}yhandle handle ohandle" \ -outline yellow -width $yellowLineWidth } # Rearrange graph layers and select current image if selecting new graph if { $currgn!=$gn } { [gNotifications default] postMessage $currgn graphHasBeenUnselected set currgn $gn if {[regexp "NULL" $powPlotParam(images,$gn)]} { .pow.pow delete current_img set powPlotParam(currimg,$gn) "NULL" } if $powGUI { if {! [string compare [.pow.scope find withtag ${gn}scopebox] ""]} { powRedrawScopebox } } powUpdateCurrentDialogs if ![info exists powPlotParam(prev_magnification,$currgn)] { set powPlotParam(prev_magnification,$currgn) 1.0 set powPlotParam(new_magnification,$currgn) 1.0 set powPlotParam(g_multiplier,$currgn) 4.0 set powPlotParam(g_magnification,$currgn) 1.0 } #puts "powSelectGraph powPlotParam(prev_magnification,$currgn): $powPlotParam(prev_magnification,$currgn)" #puts "powSelectGraph powPlotParam(new_magnification,$currgn): $powPlotParam(new_magnification,$currgn)" #puts "powSelectGraph powPlotParam(g_multiplier,$currgn): $powPlotParam(g_multiplier,$currgn)" #puts "powSelectGraph powPlotParam(g_magnification,$currgn): $powPlotParam(g_magnification,$currgn)" set g_magnification $powPlotParam(g_magnification,$currgn) } elseif $powGUI { if {! [string compare [.pow.scope find withtag ${gn}scopebox] ""]} { powRedrawScopebox } } # Now restore current image for this graph if { [info exists powPlotParam(currimg,$gn)] \ && $powPlotParam(currimg,$gn)!="NULL" } { powSelectImage $gn $powPlotParam(currimg,$gn) } elseif [info exists currimg] { unset currimg } .pow.pow raise ${gn}handles .pow.pow lower ${gn}bkg .pow.pow raise ${gn}text .pow.pow raise $gn .pow.pow lower graphSelect_$gn $gn .pow.pow raise current_gn powUpdateGraphMenuOptions if { [info exists powDWP] && [winfo exists ${powDWP}region]} { powSetupRegions $gn powUpdateRegionDlg $gn } [gNotifications default] postMessage $gn graphHasBeenSelected } proc powUpdateGraphMenuOptions {} { #puts "powUpdateGraphMenuOptions start" global currgn currimg powGUI global powPlotParam powImageParam powMenuOption if $powGUI { set powMenuOption(tickScal) \ "$powPlotParam(xTickScal,$currgn)-$powPlotParam(yTickScal,$currgn)" .pow.mbar.edit.tlabels entryconfigure "Decimal" \ -variable powPlotParam(tickLabels,$currgn) .pow.mbar.edit.tlabels entryconfigure "Base 60 (deg)" \ -variable powPlotParam(tickLabels,$currgn) .pow.mbar.edit.grid entryconfigure "Show Grid Lines" \ -variable powPlotParam(GridLines,$currgn) foreach clr [list White Black Blue Red] { .pow.mbar.edit.grid entryconfigure $clr \ -variable powPlotParam(GridColor,$currgn) } foreach opt [list Solid "Small Dash" "Large Dash"] { .pow.mbar.edit.grid entryconfigure $opt \ -variable powPlotParam(GridDash,$currgn) } if { [info exists currimg] && $currimg != "" } { set img $currimg set gn $currgn } else { set img "" set gn powDef } foreach colorGrp $powImageParam(allMaps,powDef) { set cName [lindex $colorGrp 0] foreach color [lrange $colorGrp 1 end] { .pow.mbar.colors.c$cName entryconfigure $color \ -variable powImageParam(colormap${img},$gn) } } .pow.mbar.colors entryconfigure "Invert Colortable" \ -variable powImageParam(invert${img},$gn) .pow.mbar.colors entryconfigure linear \ -variable powImageParam(scale${img},$gn) .pow.mbar.colors entryconfigure "square root" \ -variable powImageParam(scale${img},$gn) .pow.mbar.colors entryconfigure logarithmic \ -variable powImageParam(scale${img},$gn) .pow.mbar.colors entryconfigure "Histo Equalize" \ -variable powImageParam(scale${img},$gn) } #puts "powUpdateGraphMenuOptions end" } proc powUpdateCurrentDialogs { } { #puts "powUpdateCurrentDialogs start" global currgn powDWP if { [winfo exists ${powDWP}gEdit] } { powEditResetDialog } } proc powRedrawScopebox { } { #puts "powRedrawScopebox start" global currgn powPlotParam powScopeWidth powScopeHeight powScopeMargin global currimg powScopeGn powOrderedGraphList .pow.scope delete all # Make sure the scope's Title is up-to-date set title $powPlotParam(titleString,$currgn) if { $currgn=="powDef" } { set powScopeGn "-" } elseif { [string length $title] > 24 } { set ll [expr [string length $title]-10] set powScopeGn "[string range $title 0 11]...[string range $title $ll end]" } elseif { $title=="" } { set idx [expr [lsearch $powOrderedGraphList $currgn]+1] set powScopeGn "Untitled $idx" } else { set powScopeGn $title } # Do we need to go any further? Any curves/images in graph? if {[regexp "NULL" $powPlotParam(curves,$currgn)] && \ [regexp "NULL" $powPlotParam(images,$currgn)] } return set width [expr $powScopeWidth - 2*$powScopeMargin] set height [expr $powScopeHeight - 2*$powScopeMargin] set width [expr ($width < 10 ? 10 : $width )] set height [expr ($height< 10 ? 10 : $height)] powCreateGraph ${currgn}scope $powPlotParam(curves,$currgn) \ $powPlotParam(images,$currgn) $powPlotParam(xunits,$currgn) \ $powPlotParam(yunits,$currgn) $powPlotParam(xlabel,$currgn) \ $powPlotParam(ylabel,$currgn) \ $width $height \ NULL NULL NULL NULL .pow.scope # Raise current image if { [info exists currimg] && $currimg != "" } { set scopeids [.pow.scope find withtag disp${currgn}scope] if {$scopeids != ""} { .pow.scope raise img_$currimg [lindex $scopeids end] } } powDrawScopeROI [list \ $powPlotParam(xBot,$currgn) \ $powPlotParam(yBot,$currgn) \ $powPlotParam(xTop,$currgn) \ $powPlotParam(yTop,$currgn)] } proc powResizeScope { width height } { #puts "powResizeScope start" global powScopeWidth powScopeHeight powScopeMargin currgn global powShowScope powScopeSize global menuBarDeleteFlag # Resize Scopebox window set powScopeSize [list $width $height] if { $width && $height } { set powShowScope 1 set powScopeWidth $width set powScopeHeight $height set powScopeMargin [expr ($width+$height)/20] .pow.scope configure -width $width -height $height powLayoutGUI powRedrawScopebox } else { # set powShowScope 0 grid remove .pow.scopeframe grid remove .pow.trackers grid remove .pow.gui powDeleteMenuBarItem .pow.scope configure -width 1 -height 1 } powUpdateGeometry } proc powUpdateGeometry {} { #puts "powUpdateGeometry start" global powRealMinWidth powRealMinHeight powResizeMain # Update window geometry powSetGeometry set resize 0 foreach {dx dy} [lrange [split [wm geometry .pow] {x+-}] 0 1] {} if { $powRealMinWidth>$dx } { set dx $powRealMinWidth set resize 1 } if { $powRealMinHeight>$dy } { set dy $powRealMinHeight set resize 1 } if { $resize } { # set x [winfo x .pow] # set y [winfo y .pow] wm geometry .pow "${dx}x${dy}" } powReconfigureToplevel $powResizeMain } proc powGetCurrentGraph { } { #puts "powGetCurrentGraph start" global currgn if [info exist currgn] { if { $currgn=="powDef" } { return "" } return $currgn } else { return "" } } proc powMagImage {gn img {canvas .pow.pow}} { #puts "powMagImage start" #lowlevel routine, don't call this yourself #resizes image to match the current magstep and ROI window global powPlotParam curr_img currimg global powPseudoImages powImageParam isMac global menuBarDeleteFlag set clipbox $powPlotParam(clipbox${img},$gn) if [regexp "clipped" $clipbox] return catch {image delete ${img}disp$gn} if $powPseudoImages { image create pict ${img}disp$gn } else { image create photo ${img}disp$gn } set width [image width $img] set height [image height $img] #collect up the inputs to ship to Tk_(Pict||Photo)PutScaledBlock set x0 [lindex $clipbox 2] set y0 [lindex $clipbox 3] set x1 [lindex $clipbox 4] set y1 [lindex $clipbox 5] foreach {X0 Y0} [powPixelToCanvas $gn $img -0.5 -0.5 $canvas] {} foreach {X1 Y1} [powPixelToCanvas $gn $img \ [expr $width-0.5] [expr $height-0.5] $canvas] {} set zoomX [expr ($X1-$X0)/$width] set zoomY [expr ($Y0-$Y1)/$height] set width [expr int( ($x1 - $x0)*$zoomX + 0.5 )] set height [expr int( ($y1 - $y0)*$zoomY + 0.5 )] if { $isMac && ![powTestMacMemory [expr $width*$height]] } { tk_messageBox -type ok -icon error \ -message "Not enough memory to display $img. Will hide it\ until memory becomes available." } else { powPutZoomedBlock $img $gn $x0 $y0 $width $height $zoomX $zoomY } # set curr_img ${img}disp$gn if { $powPseudoImages } { powSetRange $gn $img \ $powImageParam(RBmin${img},$gn) $powImageParam(RBmax${img},$gn) } } proc powSetCurveOptions {gn curve {args ""}} { global powCurveParam powGUI currgn global powWCS powFitsHeader powFitsHeaderCnt xCount yCount powPlotParam if { $args == "" } { set lst "" foreach opt $powCurveParam(allOpts,powDef) { catch {lappend lst $opt $powCurveParam(${opt}${curve},$gn)} } return $lst } elseif { [llength $args] == 1 } { set opt [lindex $args 0] set idx [lsearch -exact $powCurveParam(allOpts,powDef) $opt] if { $idx != -1 } { if { $opt=="pColor" || $opt=="lColor" } { set val [powColorToHex $val] } return $powCurveParam(${opt}${curve},$gn) } else { return "" } } else { foreach {opt val} $args { set idx [lsearch -exact $powCurveParam(allOpts,powDef) $opt] if { $idx != -1 } { if { $opt=="pColor" || $opt=="lColor" } { set val [powColorToHex $val] } set powCurveParam(${opt}${curve},$gn) $val } } if { [.pow.pow find withtag ${curve}${gn}] != "" } { .pow.pow delete ${curve}${gn} powPlot1Curve $gn $curve .pow.pow if {$powGUI && ($gn == $currgn)} { .pow.scope delete ${curve}${gn}scope powPlot1Curve ${gn}scope $curve .pow.scope } } } } proc powAddCurves {gn curves} { #puts "powAddCurves start" global powPlotParam currgn powGUI powPlotCurves $gn $curves .pow.pow if { $powGUI && $gn == $currgn } { powRedrawScopebox } } proc powAddImages {gn images} { #puts "powAddImages start" global powPlotParam currgn powGUI powPlotImages $gn $images .pow.pow if { $powGUI && $gn == $currgn } { powRedrawScopebox } } proc powRemoveCurves {gn curves} { #puts "powRemoveCurves start" global powPlotParam currgn powGUI set hasChanged 0 foreach c $curves { set idx [lsearch -exact $powPlotParam(curves,$gn) $c] if { $c != "NULL" && $idx != -1 } { set hasChanged 1 .pow.pow delete $c$gn set powPlotParam(curves,$gn) \ [lreplace $powPlotParam(curves,$gn) $idx $idx] } } if { [llength $powPlotParam(curves,$gn)]==0 } { set powPlotParam(curves,$gn) "NULL" } if { $powGUI && $gn == $currgn && $hasChanged } { powRedrawScopebox } } proc powRemoveImages {gn images} { #puts "powRemoveImages start" global powPlotParam currgn powGUI set hasChanged 0 foreach i $images { set idx [lsearch -exact $powPlotParam(images,$gn) $i] if { $i != "NULL" && $idx != -1 } { set hasChanged 1 .pow.pow delete ${i}disp$gn set powPlotParam(images,$gn) \ [lreplace $powPlotParam(images,$gn) $idx $idx] } } if { [llength $powPlotParam(images,$gn)]==0 } { set powPlotParam(images,$gn) "NULL" } if { $powGUI && $gn == $currgn && $hasChanged } { powRedrawScopebox } } proc powGetCurveLength { crv } { #puts "powGetCurveLength start" array set crvInfo [powFetchCurveInfoHash $crv] array set vecInfo [powFetchVectorInfoHash $crvInfo(X)] return [powFetchDataLength $vecInfo(data)] } proc powPlot1Curve {gn crv {canvas .pow.pow}} { global powCurveParam powScopeWidth powScopeHeight global powPlotParam global xCount yCount if { $canvas == ".pow.scope" } { set trueGn [string range $gn 0 [expr [string length $gn]-6] ] foreach opt $powCurveParam(allOpts,powDef) { set powCurveParam(${opt}${crv},$gn) \ $powCurveParam(${opt}${crv},$trueGn) } } else { foreach opt $powCurveParam(allOpts,powDef) { if {! [info exists powCurveParam(${opt}${crv},$gn)]} { if { $opt == "pShape" && [powGetCurveLength $crv]>10000 \ && ($powCurveParam(LOD,powDef) == 0 || \ $powCurveParam(LOD,powDef) > 10000) } { set powCurveParam(${opt}${crv},$gn) Dot } elseif { [info exists powCurveParam(${opt}${crv},powDef)] } { set powCurveParam(${opt}${crv},$gn) \ $powCurveParam(${opt}${crv},powDef) } else { set powCurveParam(${opt}${crv},$gn) \ $powCurveParam(${opt},powDef) } } } } foreach opt $powCurveParam(allOpts,powDef) { set $opt $powCurveParam(${opt}${crv},$gn) } if { $logX || $logY } { if { [powWCSexists $gn] } { # Cannot mix WCS and log, so change options to No set powCurveParam(logX${crv},$gn) No set powCurveParam(logY${crv},$gn) No set logX No set logY No } } if { $canvas == ".pow.scope" } { # Shrink point size if drawing in the scope window if { $pSize>0 } { set pSize [expr round($pSize*($powScopeWidth+$powScopeHeight)/800.0)] if { $pSize<=1 } { set pShape Dot } } } # call curve plotting routine $canvas create powCurve $crv $gn \ -pointdisplay $pDisp \ -pointtype $pShape \ -pointsize $pSize \ -pointerror $pSizeErr \ -pointfill $pFill \ -linedisplay $lDisp \ -dash $lStyle \ -width $lWidth \ -stairstep $lStep \ -boxfill $lBoxFill \ -lfill $lColor \ -pfill $pColor \ -logx $logX \ -logy $logY \ -tags "$gn $crv$gn" \ -LOD $LOD } proc powPlotCurves {gn curves {canvas .pow.pow}} { global powPlotParam powCurveParam powcursor powResizeMain if [regexp "NULL" $curves] return #remove "NULL" from curves list if present if [regexp "NULL" $powPlotParam(curves,$gn)] {set powPlotParam(curves,$gn) { }} set crvCnt [llength $powPlotParam(curves,$gn)] foreach current_curve $curves { # if curve is already in list, don't plot it if [regexp $current_curve $powPlotParam(curves,$gn)] continue # Check if we need to assign a new color to this curve if { ![info exists powCurveParam(lColor${current_curve},$gn)] && \ ![info exists powCurveParam(lColor${current_curve},powDef)] } { set colors $powCurveParam(allColors,powDef) set nElem [lsearch $colors $powCurveParam(lColor,powDef)] # Must increment by 2* because list contains COLOR #HEX COLOR #HEX incr nElem [expr $crvCnt+$crvCnt] if { $nElem<0 } { set powCurveParam(lColor${current_curve},$gn) \ $powCurveParam(lColor,powDef) } else { while { $nElem >= [llength $colors] } { incr nElem -[llength $colors] } set powCurveParam(lColor${current_curve},$gn) \ [lindex $colors $nElem] } } if { ![info exists powCurveParam(pColor${current_curve},$gn)] && \ ![info exists powCurveParam(pColor${current_curve},powDef)] } { set colors $powCurveParam(allColors,powDef) set nElem [lsearch $colors $powCurveParam(pColor,powDef)] # Must increment by 2* because list contains COLOR #HEX COLOR #HEX incr nElem [expr $crvCnt+$crvCnt] if { $nElem<0 } { set powCurveParam(pColor${current_curve},$gn) \ $powCurveParam(pColor,powDef) } else { while { $nElem >= [llength $colors] } { incr nElem -[llength $colors] } set powCurveParam(pColor${current_curve},$gn) \ [lindex $colors $nElem] } } if { [catch {powPlot1Curve $gn $current_curve $canvas} err] } { tk_messageBox -icon error -type ok -parent .pow \ -message "Couldn't place $current_curve into graph...\ \n\n\"$err\"\n\nSkipping curve." } else { # add name to list of curves lappend powPlotParam(curves,$gn) $current_curve incr crvCnt } } } proc powWhereAmI {x y {canvas ".pow.pow"}} { set boxes [$canvas find withtag gbox] set topbox -1 set topgraph "" foreach graph [powListGraphs] { set gbox [$canvas coords ${graph}box] if { $gbox == "" } continue if { $x >= [lindex $gbox 0] && $x <= [lindex $gbox 2] \ && $y >= [lindex $gbox 1] && $y <= [lindex $gbox 3] } { set order [lsearch $boxes [$canvas find withtag ${graph}box]] if {$order>$topbox} {set topbox $order; set topgraph $graph } } } if {$topbox>=0} {return $topgraph} else {return "NULL"} } proc powWhereAmI_img {gn x y {canvas ".pow.pow"}} { set images [$canvas find withtag disp$gn] set N [llength $images] if { $N==0 } { return "NULL" } for { set i $N } { $i>0 } { } { incr i -1 set img [lindex $images $i] set ibox [$canvas bbox $img] if { $ibox == "" } continue if { $x >= [lindex $ibox 0] && $x <= [lindex $ibox 2] \ && $y >= [lindex $ibox 1] && $y <= [lindex $ibox 3] } { set tags [$canvas gettags $img] #puts "tags: $tags" set elem [lsearch -glob $tags ?*disp$gn] #puts "elem: $elem" set check [split $gn "()"] #puts "check: $check" if { [llength $check] > 1 } { # Pan Chai: check patten needed to update if the gn name is changed of table image # we got "()" special character in the gn name and only has one set if { [regexp "^(.+)disp[lindex $check 0](\\()[lindex $check 1](\\))[lindex $check 2]$" [lindex $tags $elem] dmy theImage] } { return $theImage } } else { if { [regexp "^(.+)disp$gn$" [lindex $tags $elem] dmy theImage] } { return $theImage } } } } return "NULL" } # C routines: CanvasToGraph, GraphToPixel # PixelToGraph, GraphToCanvas # TCL routines: CanvasToPixel, PixelToCanvas proc powPixelToCanvas {gn img x y {canvas .pow.pow}} { #puts "powPixelToCanvas start" set ccoords [powPixelToGraph $img $x $y] set rx [lindex $ccoords 0] set ry [lindex $ccoords 1] set ccoords [powGraphToCanvas $gn $rx $ry $canvas] #puts "PixelToCanvas - $x $y $ccoords $gn" return $ccoords } proc powCanvasToPixel {gn img x y {canvas .pow.pow}} { #puts "powCanvasToPixel start" global powPlotParam set ccoords [powCanvasToGraph $gn $x $y $canvas] #puts "powCanvasToPixel: ccoords: $ccoords" set rx [lindex $ccoords 0] set ry [lindex $ccoords 1] set ccoords [powGraphToPixel $img $rx $ry] #puts "ccoords - $x $y $ccoords" return $ccoords } proc set_tracker_info {x y {canvas ".pow.pow"}} { global powPlotParam powTrackText currimg currgn global powPseudoImages powEditObject global xCount yCount set cx [$canvas canvasx $x] set cy [$canvas canvasy $y] set gn [powWhereAmI $cx $cy $canvas] set powTrackText(gn) $gn if { $gn != "NULL" } { set gcoords [powCanvasToGraph $gn $cx $cy $canvas] set powTrackText(rx) [lindex $gcoords 0] set powTrackText(ry) [lindex $gcoords 1] set img [powWhereAmI_img $gn $cx $cy $canvas] set powTrackText(img) $img if { $img != "NULL" } { set icoords [powCanvasToPixel $gn $img $cx $cy $canvas] set imgx [expr int([lindex $icoords 0]+0.5)] set imgy [expr int([lindex $icoords 1]+0.5)] set width [image width $img] set height [image height $img] #puts "imgx: $imgx, imgy: $imgy, width: $width, height: $height" if { ($imgx < $width) && ($imgy < $height) \ && ($imgx >= 0) && ($imgy >= 0) } { set powTrackText(imgx) $imgx set powTrackText(imgy) $imgy if [info exist powPlotParam(flipD,$gn)] { switch $powPlotParam(flipD,$gn) { "X" { if { [info exists xCount($gn)] && [expr $xCount($gn) % 2] != 0 } { set powTrackText(imgx) [expr $width - $powTrackText(imgx) - 1] } } "Y" { if { [info exists yCount($gn)] && [expr $yCount($gn) % 2] != 0 } { set powTrackText(imgy) [expr $height - $powTrackText(imgy) - 1] } } "B" { if { [info exists xCount($gn)] && [expr $xCount($gn) % 2] != 0 } { set powTrackText(imgx) [expr $width - $powTrackText(imgx) - 1] } if { [info exists yCount($gn)] && [expr $yCount($gn) % 2] != 0 } { set powTrackText(imgy) [expr $height - $powTrackText(imgy) - 1] } } } } set powTrackText(imgz) [powGetImageZ $img $imgx $imgy] } else { set powTrackText(imgx) "X" set powTrackText(imgy) "X" set powTrackText(imgz) "X" } set powTrackText(zunits) [powGetImageUnits $img Z] } else { set powTrackText(imgx) "X" set powTrackText(imgy) "X" set powTrackText(imgz) "X" set powTrackText(zunits) " " } } else { set powTrackText(rx) X set powTrackText(ry) X set powTrackText(imgx) "X" set powTrackText(imgy) "X" set powTrackText(imgz) "X" set powTrackText(zunits) " " } powUpdateTrackVars } proc powStretchGraph {gn xfactor yfactor {canvas ".pow.pow"}} { #puts "powStretchGraph start, xfactor: $xfactor, yfactor: $yfactor" global powPlotParam powResizeGraph $gn $xfactor $yfactor $canvas } proc powMagGraph {gn newxmagstep newymagstep {canvas ".pow.pow"}} { #puts "powMagGraph start" global powPlotParam set xfactor \ [expr double($newxmagstep) / double($powPlotParam(xmagstep,$gn))] set yfactor \ [expr double($newymagstep) / double($powPlotParam(ymagstep,$gn))] powResizeGraph $gn $xfactor $yfactor $canvas } proc powResizeGraph {gn xfactor yfactor {canvas ".pow.pow"}} { #puts "powResizeGraph start" #lowlevel routine, don't call this yourself. Use powMagGraph or powStretchGraph #all "resizings" of a graph are done here. Don't you dare #do them elsewhere or you'll regret it. global powPlotParam powcursor powResizeMain global currimg powScopeMargin global baseX baseY global xFactor yFactor foreach el [array names powPlotParam] { set p1 [lindex [split $el ,] 0] set p2 [lindex [split $el ,] 1] if { $p2 == $gn } { set $p1 $powPlotParam($p1,$p2) } } if { [$canvas find withtag ${gn}box] == "" } return set bbox [$canvas coords ${gn}box] # save initial coordinates if {$canvas == ".pow.scope"} { set ul [list $powScopeMargin $powScopeMargin] } else { set ul [list [lindex $bbox 0] [lindex $bbox 1]] } $canvas scale $gn [lindex $bbox 0] [lindex $bbox 1] $xfactor $yfactor set fbox [$canvas coords ${gn}box] if { ![info exists baseX] } { set baseX [expr [lindex $bbox 2] - [lindex $bbox 0]] set baseY [expr [lindex $bbox 3] - [lindex $bbox 1]] } set xFactor [expr [expr [lindex $fbox 2] - [lindex $fbox 0]] / $baseX] set yFactor [expr [expr [lindex $fbox 3] - [lindex $fbox 1]] / $baseY] set powPlotParam(xmagstep,$gn) [expr $xfactor * $powPlotParam(xmagstep,$gn)] set powPlotParam(ymagstep,$gn) [expr $yfactor * $powPlotParam(ymagstep,$gn)] powSetGraphMagstep $gn $powPlotParam(xmagstep,$gn) \ $powPlotParam(ymagstep,$gn) if {![regexp "NULL" $images]} { foreach img $powPlotParam(images,$gn) { powMagImage $gn $img $canvas } } if {$canvas == ".pow.pow"} { # Redraw all the adornments .pow.pow delete ${gn}handles .pow.pow delete ${gn}shandle .pow.pow delete ${gn}yhandle #draw new tick marks and numbers to go with and new labels powDrawTicks $gn $canvas #make new GraphHandles powMakeGraphLabels $gn powMakeGraphHandles $gn powSelectGraph $gn } [gNotifications default] postMessage $gn graphHasResized } proc powRestoreGraph {gn {canvas .pow.pow}} { #puts "powRestoreGraph start" set bbox [$canvas bbox $gn] set x [lindex $bbox 0] set y [lindex $bbox 1] set mx [expr ($x < 20) ? 20 - $x : 0] set my [expr ($y < 20) ? 20 - $y : 0] powMoveGraph $gn $mx $my $canvas } proc tagXdim {can tag} { #puts "tagXdim start" set bbox [$can coords $tag] return [expr [lindex $bbox 2] - [lindex $bbox 0]] } proc tagYdim {can tag} { #puts "tagYdim start" set bbox [$can coords $tag] return [expr [lindex $bbox 3] - [lindex $bbox 1]] } proc powStretchGraphToSize {gn xdim ydim {canvas ".pow.pow"}} { #puts "powStretchGraphToSize start, xdim: $xdim, ydim: $ydim" #stretches/shrinks graph to fit in xdim/ydim size global powPlotParam powEditPlotParam set curr_xdim [tagXdim $canvas ${gn}box] set curr_ydim [tagYdim $canvas ${gn}box] set xfactor [expr double($xdim)/double($curr_xdim)] set yfactor [expr double($ydim)/double($curr_ydim)] powStretchGraph $gn $xfactor $yfactor $canvas #save requested current size of graph if ![info exists powEditPlotParam(xdimdisp,powDef)] { set powEditPlotParam(xdimdisp,powDef) $powPlotParam(xdimdisp,$gn) set powEditPlotParam(ydimdisp,powDef) $powPlotParam(ydimdisp,$gn) } set powPlotParam(xdimdisp,$gn) $xdim set powPlotParam(ydimdisp,$gn) $ydim set powEditPlotParam(xdimdisp,new) $xdim set powEditPlotParam(ydimdisp,new) $ydim if {$canvas == ".pow.pow"} { powSelectGraph $gn } } proc powDragGraph { stage X Y } { #puts "powDragGraph start" global powMoveX powMoveY powIsDragging global currgn powResizeMain switch -exact $stage { start { set powMoveX $X set powMoveY $Y set powIsDragging 1 } drag { powHideCurves $currgn powMoveHandle $currgn $X $Y } end { powShowCurves $currgn powReconfigureToplevel $powResizeMain set powIsDragging 0 } } } #Plotting routines below here ... proc powMoveGraph {gn xDist yDist {canvas ".pow.pow"}} { #puts "powMoveGraph start" global powPlotParam if { $xDist==0 && $yDist==0 } return $canvas move $gn $xDist $yDist $canvas move ${gn}handles $xDist $yDist $canvas move ${gn}yhandle $xDist $yDist incr powPlotParam(xo,$gn) $xDist incr powPlotParam(yo,$gn) $yDist [gNotifications default] postMessage $gn graphHasMoved $xDist $yDist } proc powMoveGraphTo {gn x y {canvas ".pow.pow"}} { #puts "powMoveGraphTo start" global powPlotParam set bbox [$canvas coords ${gn}box] set xDist [expr $x - [lindex $bbox 0]] set yDist [expr $y - [lindex $bbox 1]] $canvas move $gn $xDist $yDist $canvas move ${gn}handles $xDist $yDist $canvas move ${gn}yhandle $xDist $yDist set powPlotParam(xo,$gn) $x set powPlotParam(yo,$gn) $y # powRestoreGraph $gn $canvas [gNotifications default] postMessage $gn graphHasMoved $xDist $yDist } proc powRedrawGraphHandles {gn} { #puts "powRedrawGraphHandles start" global currgn if { [.pow.pow find withtag ${gn}handles] != "" } { .pow.pow delete ${gn}handles .pow.pow delete ${gn}shandle powMakeGraphHandles $gn # If this is current graph, call SelectGraph to update yellow box if { $gn == $currgn } {powSelectGraph $gn} } } proc powMakeGraphHandles {gn} { #puts "powMakeGraphHandles start" global powPlotParam env # update idletasks set bbox [.pow.pow bbox $gn] set left [lindex $bbox 0] set top [lindex $bbox 1] set right [lindex $bbox 2 ] set bot [lindex $bbox 3] #Make "handle" for graph, you can pick up the graph and #move it around by dragging this if [string match "*t*" $powPlotParam(handleposition,$gn)] { set y $top } elseif [string match "*b*" $powPlotParam(handleposition,$gn)] { set y $bot } else { set y [expr ($top + $bot)/2.0] } if [string match "*l*" $powPlotParam(handleposition,$gn)] { set x $left } elseif [string match "*r*" $powPlotParam(handleposition,$gn)] { set x $right } else { set x [expr ($left + $right)/2.0] } # .pow.ms${gn}handle - the 'ms' stands for Move/select and is necessary # to allow graph names to start with a capital set msName "ms[powCleanName $gn]handle" if [winfo exists .pow.$msName] { .pow.$msName configure -bg $powPlotParam(bgcolor,$gn) \ -text $powPlotParam(handletext,$gn) -cursor fleur } else { button .pow.$msName \ -bg $powPlotParam(bgcolor,$gn) \ -text $powPlotParam(handletext,$gn) -cursor fleur bind .pow.$msName \ "set powMoveX %X ; set powMoveY %Y" bind .pow.$msName \ "powHideCurves $gn ; powMoveHandle $gn %X %Y" bind .pow.$msName \ "+powShowCurves $gn; powSelectGraph $gn; \ powReconfigureToplevel \$powResizeMain" } raise .pow.$msName .pow.pow # .pow.pow create window $x $y \ # -tags "${gn}handle handle ghandle ${gn}handles canvas_window" \ # -anchor $powPlotParam(handleanchor,$gn) \ # -window .pow.$msName #Make "stretch handle" for graph, you will be able to expand the graph #by dragging this. set sName "s[powCleanName $gn]handle" if [winfo exists .pow.$sName] { .pow.$sName configure -bg $powPlotParam(bgcolor,$gn) \ -bitmap stretcharrow\ -cursor bottom_right_corner } else { button .pow.$sName -bg $powPlotParam(bgcolor,$gn) \ -bitmap stretcharrow \ -cursor bottom_right_corner bind .pow.$sName \ "powHideCurves $gn; powStretch $gn %X %Y" bind .pow.$sName \ "powBeginStretch $gn %X %Y; \ set fixedStretch \"yes\"; \ powStretch $gn %X %Y; " bind .pow.$sName \ "powBeginStretch $gn %X %Y; \ set fixedStretch \"no\"; \ powStretch $gn %X %Y; " bind .pow.$sName \ "powShowCurves $gn; powEndStretch $gn" } .pow.pow create window $right $bot\ -tags " ${gn}shandle shandle handle ${gn}handles canvas_window" \ -anchor se -window .pow.$sName raise .pow.$sName .pow.pow #Make a colored background .pow.pow create rectangle $bbox \ -tags "${gn}handles ${gn}bkg graphbkg" \ -fill $powPlotParam(bgcolor,$gn) -outline $powPlotParam(bgcolor,$gn) .pow.pow lower ${gn}bkg # Now create an underlying polygon with -fill {} to catch all clicks .pow.pow delete graphSelect_$gn foreach {x0 y0 x1 y1} $bbox {} .pow.pow create polygon $x0 $y0 $x0 $y1 $x1 $y1 $x1 $y0 $x0 $y0 \ -outline {} -fill {} -tags "${gn}handles graphSelect_$gn" .pow.pow lower graphSelect_$gn $gn #Store position of "Select" handle relative to graph box # update idletasks set hcoords [.pow.pow coords ${gn}handle] set bcoords [.pow.pow coords ${gn}box] set powPlotParam(handleoffsetx,$gn) \ [expr [lindex $hcoords 0] - [lindex $bcoords 0]] set powPlotParam(handleoffsety,$gn) \ [expr [lindex $hcoords 1] - [lindex $bcoords 1]] } proc powCleanName {gn} { #puts "powCleanName start" regsub -all {\.} $gn {_} a return $a } proc powHideCurves { gn } { #puts "powHideCurves start" global powPlotParam foreach crv $powPlotParam(curves,$gn) { if {$crv=="NULL"} continue #if the curve has string Z data, the next statement will fail #since the string Z data is implemented as a separate #canvas text item with the same tag and canvas text items don't #have the -hidden option... so catch it catch {.pow.pow itemconfig ${crv}${gn} -hidden 1} } } proc powShowCurves { gn } { #puts "powShowCurves start" global powPlotParam foreach crv $powPlotParam(curves,$gn) { if {$crv=="NULL"} continue #if the curve has string Z data, the next statement will fail #since the string Z data is implemented as a separate #canvas text item with the same tag and canvas text items don't #have the -hidden option... so catch it catch {.pow.pow itemconfig ${crv}${gn} -hidden 0} } } proc powMoveHandle {gn x y} { #puts "powMoveHandle start" global powMoveX powMoveY powPlotParam # Calculate root bounding box of .pow.pow canvas (- a little) set left [expr [winfo rootx .pow.pow] + 10] set top [expr [winfo rooty .pow.pow] + 10] set right [expr [winfo width .pow.pow] + $left - 20] set bott [expr [winfo height .pow.pow] + $top - 20] # Check whether we have moved outside of the .pow.pow canvas if { $x < $left } { set x $left } elseif { $x > $right } { set x $right } if { $y < $top } { set y $top } elseif { $y > $bott } { set y $bott } set dx [expr $x - $powMoveX] set dy [expr $y - $powMoveY] powMoveGraph $gn [expr $x - $powMoveX] [expr $y - $powMoveY] set powMoveX $x set powMoveY $y } proc powFindOverlapGraph { Lft Top Rgt Bot } { #puts "powFindOverlapGraph start" set gn "" foreach gnIdx [.pow.pow find withtag gbox] { foreach {lft top rgt bot} [.pow.pow bbox $gnIdx] {} if { $rgt<$Lft || $lft>$Rgt || $top>$Bot || $bot<$Top } continue set gn [lindex [.pow.pow gettags $gnIdx] 0] } return $gn } proc powBeginROI {x y {canvas .pow.pow}} { global roi_xo roi_yo saveROI global roi_xn roi_yn global currgn currimg global roi_pixelxo roi_pixelyo if {[$canvas find withtag ROI] != ""} { set saveROI [$canvas coords ROI] } set roi_xo [$canvas canvasx $x] set roi_yo [$canvas canvasy $y] set roi_xn $roi_xo set roi_yn $roi_yo if [info exists currimg] { set result [powCanvasToPixel $currgn $currimg $roi_xo $roi_yo ".pow.pow"] set roi_pixelxo [lindex $result 0] set roi_pixelyo [lindex $result 1] } $canvas create rectangle $x $y $x $y -tags ROI -outline blue } proc powDragROI {x y {canvas .pow.pow}} { #puts "powDragROI start" global roi_xo roi_yo global roi_xn roi_yn $canvas delete ROI set roi_xn [$canvas canvasx $x] set roi_yn [$canvas canvasy $y] if {![info exists roi_xo] || ![info exists roi_yo] || ($roi_xo == $roi_xn && $roi_yo == $roi_yn)} { return } $canvas create rectangle $roi_xo $roi_yo \ [$canvas canvasx $x] [$canvas canvasy $y] \ -tags ROI -outline blue } proc powPanROI {x y {canvas .pow.pow}} { #puts "powPanROI start" set ROIbbox [$canvas coords ROI] set halfwidth [expr ([lindex $ROIbbox 2] - [lindex $ROIbbox 0])/2.0] set halfheight [expr ([lindex $ROIbbox 3] - [lindex $ROIbbox 1])/2.0] $canvas delete ROI $canvas create rectangle [expr $x - $halfwidth] [expr $y - $halfheight] [expr $x + $halfwidth] [expr $y + $halfheight] -tags ROI -outline blue } proc powFlipImage { direction } { global powPlotParam powFlipPlotWCSDefault powFlipPlotFitsHeaderDefault global powContourParam global powWCS powFitsHeader powFitsHeaderCnt global currgn global xCount yCount global profile_gn set inDirection $direction set token img set idx [string first "_contour" $currgn] set currgn_contour "" set inputCurrgnIsContour "false" if { $idx >= 0 } { set inputCurrgnIsContour "true" set currgn_contour $currgn set currgn [string range $currgn 0 [expr $idx - 1]] } else { set currgn_contour ${currgn}_contour } set errorFlag [ catch { powFindData $currgn } err ] if ![info exists powPlotParam(graphType,$currgn)] { set powPlotParam(graphType,$currgn) "image" set powPlotParam(graphType,${currgn}scope) "image" } if { $errorFlag } { set errorFlag [ catch { array set crvInfo [powFetchCurveInfoHash c1_$currgn] } err ] if { !$errorFlag && [info exist powWCS(c1_$currgn)] } { set powPlotParam(graphType,c1_$currgn) "binary" set powPlotParam(zoomed,c1_$currgn) $powPlotParam(zoomed,$currgn) } set powPlotParam(graphType,$currgn) "binary" set powPlotParam(graphType,${currgn}scope) "binary" set imageInfoList {} lappend imageInfoList "data" lappend imageInfoList c1_$currgn lappend imageInfoList "width" lappend imageInfoList $powPlotParam(xdimdisp,$currgn) lappend imageInfoList "height" lappend imageInfoList $powPlotParam(ydimdisp,$currgn) } else { set obj $currgn set imageInfoList [powFetchImageInfoHash $obj] if { [expr [llength $imageInfoList] % 2] != 0 } { lappend imageInfoList DONTCARE } } set useWCS true array set powEditObject $imageInfoList if { $powWCS($currgn) == "" || [lindex [lindex $powWCS($currgn) 0] 0] == 0.0 } { set useWCS false } if { $powPlotParam(graphType,$currgn) == "binary" } { if { $useWCS == "false" } { if [info exist powWCS(c1_$currgn)] { set powPlotParam(graphType,c1_$currgn) "binary" } set powPlotParam(graphType,$currgn) "binary" set powPlotParam(graphType,${currgn}scope) "binary" } else { #tk_messageBox -message "Flipping is not available for plot using WCS info." \ # -title "Not Available" -type ok -parent .pow #return } } set refPixList [lindex $powWCS($currgn) 1] set gemoList [lindex $powWCS($currgn) 2] switch $direction { "X" - "Y" - "B" { if ![info exists powFlipPlotWCSDefault($currgn)] { set powFlipPlotWCSDefault($currgn) $powWCS($currgn) set powFlipPlotFitsHeaderDefault($currgn) $powFitsHeader($currgn) } if { ![info exists powFlipPlotWCSDefault(c1_$currgn)] && \ [info exists powWCS(c1_$currgn)] } { set powFlipPlotWCSDefault(c1_$currgn) $powWCS(c1_$currgn) set powFlipPlotFitsHeaderDefault(c1_$currgn) $powFitsHeader(c1_$currgn) } } } set directionList {} if ![info exists xCount($currgn)] { set xCount($currgn) 0 set xCount(${currgn}scope) 0 } if ![info exists yCount($currgn)] { set yCount($currgn) 0 set yCount(${currgn}scope) 0 } set powPlotParam(flipD,$currgn) $direction switch $direction { "X" - "Y" { lappend directionList $direction } "B" { lappend directionList "X" lappend directionList "Y" } "U" { if { [expr $xCount($currgn) % 2] != 0 } { lappend directionList "X" } if { [expr $yCount($currgn) % 2] != 0 } { lappend directionList "Y" } } } set setWCSFlag true set yPos 2 if { [llength $gemoList] <= 0 } { set setWCSFlag false #set powWCS($currgn) {{0.0 0.0} {$powEditObject(width) $powEditObject(height)} {1.0 -0.0 0.0 1.0} {{} {}} {{} {}}} #set powWCS($currgn) {{0.0 0.0)} {0.0 0.0} {1.0 -0.0 0.0 1.0} {{} {}} {{} {}}} set gemoList [list 1.0 -0.0 0.0 1.0] set refPixList [list $powEditObject(width) $powEditObject(height)] } else { set yPos [expr int(sqrt([llength $gemoList]))] } set naxisIdx $yPos # determine exact CDELT2 position in gemoList incr yPos set CDnExist [powDetermineKeyWordExist $currgn "CD1_1"] for {set d 0} { $d < [llength $directionList] } {incr d} { set direction [lindex $directionList $d] switch $direction { "X" { set CDELTExist [powDetermineKeyWordExist $currgn "CDELT1"] set refPixValue [expr abs($powEditObject(width) - [lindex $refPixList 0]) + 1] set refPixList [lreplace $refPixList 0 0 $refPixValue] # regardless if CDELT or CDn exist, this bit CDELT1 or CD1_1 has to be flipped set gemoValue [expr [lindex $gemoList 0] * -1.0] set gemoList [lreplace $gemoList 0 0 $gemoValue] if { $CDnExist != "false" } { # CD1_1 and CD2_1 need to be flipped set gemo2Value [expr [lindex $gemoList $naxisIdx] * -1.0] set gemoList [lreplace $gemoList $naxisIdx $naxisIdx $gemo2Value] } if { $CDELTExist != "false" } { set CDELTExist [expr $CDELTExist * -1.0] } if { $setWCSFlag == "true" } { set powWCS($currgn) [lreplace $powWCS($currgn) 1 1 $refPixList] set powWCS($currgn) [lreplace $powWCS($currgn) 2 2 $gemoList] } incr xCount($currgn) incr xCount(${currgn}scope) if { $useWCS == "true" } { if { $CDELTExist != "false" } { powChangeFitsHeaderKeyWordValue $currgn {"CDELT1" "CRPIX1"} \ $direction \ [list $CDELTExist \ [lindex $refPixList 0]] \ $refPixList } if { $CDnExist != "false" } { powChangeFitsHeaderKeyWordValue $currgn {"CD1_1" "CD2_1" "CRPIX1"} \ $direction \ [list [lindex $gemoList 0] \ [lindex $gemoList $naxisIdx] \ [lindex $refPixList 0]] \ $refPixList } } } "Y" { set CDELTExist [powDetermineKeyWordExist $currgn "CDELT2"] set refPixValue [expr $powEditObject(height) - [lindex $refPixList 1] + 1] set refPixList [lreplace $refPixList 1 1 $refPixValue] # regardless if CDELT or CDn exist, this bit CDELT2 or CD2_2 has to be flipped set gemoValue [expr [lindex $gemoList $yPos] * -1] set gemoList [lreplace $gemoList $yPos $yPos $gemoValue] if { $CDnExist != "false" } { set gemo2Value [expr [lindex $gemoList [expr $naxisIdx - 1]] * -1.0] set gemoList [lreplace $gemoList [expr $naxisIdx - 1] \ [expr $naxisIdx - 1] $gemo2Value] } if { $CDELTExist != "false" } { set CDELTExist [expr $CDELTExist * -1.0] } if { $setWCSFlag == "true" } { set powWCS($currgn) [lreplace $powWCS($currgn) 1 1 $refPixList] set powWCS($currgn) [lreplace $powWCS($currgn) 2 2 $gemoList] } incr yCount($currgn) incr yCount(${currgn}scope) if { $useWCS == "true" } { if { $CDELTExist != "false" } { powChangeFitsHeaderKeyWordValue $currgn {"CDELT2" "CRPIX2"} \ $direction \ [list $CDELTExist \ [lindex $refPixList 1]] \ $refPixList } if { $CDnExist != "false" } { powChangeFitsHeaderKeyWordValue $currgn {"CD2_2" "CD1_2" "CRPIX2"} \ $direction \ [list [lindex $gemoList $yPos] \ [lindex $gemoList [expr $naxisIdx - 1]] \ [lindex $refPixList 1]] \ $refPixList } } } } #puts "CDnExit: $CDnExist, CDELTExist: $CDELTExist" if { $powPlotParam(graphType,$currgn) == "image" } { powCreateDataFlip $currgn $direction $powEditObject(height) $powEditObject(width) } } if { $inDirection == "U" } { set xCount($currgn) 0 set yCount($currgn) 0 set xCount(${currgn}scope) 0 set yCount(${currgn}scope) 0 } #powDebugDataPrint "$currgn" $powFitsHeader($currgn) #powAdornGraph $currgn .pow.pow if { $inputCurrgnIsContour == "false" } { powRedrawGraphHandles $currgn powRedrawScopebox powEndROI 1 } else { if { $currgn_contour != "" && [info exists powContourParam(separate)] && \ $powContourParam(separate) == "yes" } { powMakeContours $powContourParam(image) \ $powContourParam(list) \ $powContourParam(res) powRedrawScopebox #powEndROI 1 } } } proc powDebugDataPrint { title string } { puts "$title" set k 0 for {set i 0} {$i < [string length $string]} {incr i 80} { set currentStr [string range $string $i [expr $i + 79]] puts "<$currentStr>" incr k } puts "count: $k" } proc powDetermineKeyWordExist { img keyword } { global powFitsHeader set str $powFitsHeader($img) set findFlag false set i 0 while { 1 } { set currentStr [string range $str $i [expr $i + 79]] incr i 80 if { [string trim $currentStr] == "" } { if { $i > [string length $str] } break continue } set currentStrToken [split $currentStr "=/"] set headerT [string trim [lindex $currentStrToken 0]] set valueT [string trim [lindex $currentStrToken 1]] if { [string tolower $headerT] == "end" } { break } if { $headerT == $keyword } { set findFlag $valueT break } } return $findFlag } proc powChangeFitsHeaderKeyWordValue { img keywordList direction changeList refPixList } { global powFitsHeader powWCS powFitsHeaderCnt global xCount yCount #puts "powChangeFitsHeaderKeyWordValue: keywordList: $keywordList" #puts " : changeList : $changeList" set changeListDone {} set str $powFitsHeader($img) set i 0 set powFitsHeaderStrCnt 0 set powFitsHeaderStr "" while { 1 } { set currentStr [string range $str $i [expr $i + 79]] incr i 80 if { [string trim $currentStr] == "" } { if { $i > [string length $str] } break continue } set currentStrToken [split $currentStr "=/"] set headerT [string trim [lindex $currentStrToken 0]] set valueT [string trim [lindex $currentStrToken 1]] set header [lindex $currentStrToken 0] set value [lindex $currentStrToken 1] set comment [lindex $currentStrToken 2] if { [string tolower $headerT] == "end" } { set endStr $currentStr break } set findFlag false set idx [lsearch -exact $keywordList $headerT] set keyword "" if { $idx < 0 } { set headerT [string range $headerT 0 [expr [string length $headerT] - 2]] set idx [lsearch -exact $keywordList $headerT] if { $idx >= 0 } { set findFlag true set keyword [lindex $keywordList $idx] } } else { set findFlag true set keyword [lindex $keywordList $idx] } if { $findFlag == "true" } { lappend changeListDone $keyword switch -glob $keyword { "CROTA2" - "CRPIX*" { set newStr [format "%.10E " [lindex $changeList $idx]] } "CD*" { set testStr [string trim $value] if { [string range $testStr 0 0] == "-" } { set testStr [string range $testStr 1 end] } else { set testStr [format " -%s" $testStr] } set newStr [format "%s " $testStr] } "CTYPE*" { set newStr [format "'%s' " [lindex $changeList $idx]] } } if { [llength $currentStrToken] == 2 } { set newStr [format "%-s=%22s" $header $newStr] set newStr [format "%s%[expr 80 - [string length $newStr]]s" $newStr " "] } elseif { [llength $currentStrToken] == 3 } { set newStr [format "%-s=%[string length $value]s/%s" $header $newStr $comment] } } else { set newStr $currentStr } # make sure final card is 80 characters long set newStr [string range $newStr 0 79] if { $powFitsHeaderStrCnt == 0 } { set powFitsHeaderStr $newStr } else { set powFitsHeaderStr [format "%s%s" $powFitsHeaderStr $newStr] } incr powFitsHeaderStrCnt } # check to see if any keyword required by user is not in original header if { [llength $changeListDone] != [llength $keywordList] } { set restKeywordList {} set restKeywordValueList {} for { set i 0 } {$i < [llength $keywordList]} {incr i} { set idx [lsearch -exact $changeListDone [lindex $keywordList $i]] if { $idx < 0 } { lappend restKeywordList [lindex $keywordList $i] lappend restKeywordValueList [lindex $changeList $i] } } for { set i 0 } {$i < [llength $restKeywordList]} {incr i} { set newStr [format "%-8s=%21s" [lindex $restKeywordList $i] \ [lindex $restKeywordValueList $i]] set newStr [format "%s%[expr 80 - [string length $newStr]]s" $newStr " "] set powFitsHeaderStr [format "%s%s" $powFitsHeaderStr $newStr] incr powFitsHeaderCnt($img) } } # add end token string set powFitsHeaderStr [format "%s%s" $powFitsHeaderStr $endStr] if { $direction != "U" } { set powFitsHeader($img) $powFitsHeaderStr set powFitsHeader(${img}scope) $powFitsHeaderStr } else { set powFitsHeader(${img}scope) $powFitsHeader($img) } set powWCS(${img}scope) $powWCS($img) if [info exists powFitsHeader(c1_$img)] { # set powWCS(c1_$img) $powWCS($img) set powFitsHeader(c1_$img) $powFitsHeader($img) set powFitsHeaderCnt(c1_$img) $powFitsHeaderCnt($img) set xCount(c1_$img) $xCount($img) set yCount(c1_$img) $yCount($img) } powResetWcsStructure -d $img $direction [lindex $refPixList 0] [lindex $refPixList 1] } proc powEndROI { zoomback {canvas .pow.pow}} { global saveROI powGUI global roi_xo roi_yo global roi_xn roi_yn r_staticYonG r_staticX0onG ROIbbox global roi_pixelxn roi_pixelyn global ROIunits powZoomStart global g_magnification global xCount yCount global powWCS powFitsHeader powFitsHeaderCnt global currentGraphList global powWCSLabel global powDrawDone #if zoomback is true, we're restoring the "default size" of the graph #otherwise, this is the end of a user dragging an ROI box global powPlotParam currgn axisToChainHash chainToAxisHash powResizeMain powEditPlotParam global powGraphsTagRangeList powTagsColorMap currimg global powGraphsTagRectList if { [info exists roi_xn] && [info exist currimg] } { set result [powCanvasToPixel $currgn $currimg $roi_xn $roi_yn ".pow.pow"] set roi_pixelxn [lindex $result 0] set roi_pixelyn [lindex $result 1] } #Guard against the simple click. if { [info exists roi_xo] && [info exists roi_xn] && [info exists roi_yo] && [info exists roi_yn] } { if {$zoomback ==0 && $roi_xo == $roi_xn && $roi_yo == $roi_yn} { if {$canvas != ".pow.scope" } { $canvas delete ROI unset roi_xo roi_xn roi_yo roi_yn } return } } set zoomback [expr $zoomback % 2] #puts "zoomback: $zoomback" if {$canvas == ".pow.scope"} { set currgraph ${currgn}scope # If graph is empty, scopebox will be empty, so don't draw ROI if { [.pow.scope find withtag ${currgraph}box]=="" } { .pow.scope delete ROI return } } else { set currgraph $currgn } if {!($zoomback)} { set ROIbbox [$canvas coords ROI] #puts "ROIbbox: $ROIbbox" set x0 [lindex $ROIbbox 0] set x1 [lindex $ROIbbox 2] set y0 [lindex $ROIbbox 3] set y1 [lindex $ROIbbox 1] if { $canvas==".pow.pow" } { # Find which graph ROI overlaps, if any set overlap_gn [powFindOverlapGraph $x0 $y1 $x1 $y0] if { $overlap_gn != "" && $overlap_gn!=$currgn } { powSelectGraph $overlap_gn set currgraph $currgn } } #get "real" coordinates of ROIbbox set gcoords [powCanvasToGraph $currgraph $x0 $y0 $canvas] set llx [lindex $gcoords 0] set lly [lindex $gcoords 1] set gcoords [powCanvasToGraph $currgraph $x1 $y1 $canvas] set urx [lindex $gcoords 0] set ury [lindex $gcoords 1] set r_staticYonG [expr ($lly + $ury) / 2.0] set r_staticX0onG $llx } else { catch { powResetWcsStructure -r $currgn 0.0 0.0 } } set graphlist $currgn if {[array names axisToChainHash ${currgn}X] != ""} { set graphlist [concat $graphlist $chainToAxisHash($axisToChainHash(${currgn}X))] } if {[array names axisToChainHash ${currgn}Y] != ""} { set graphlist [concat $graphlist $chainToAxisHash($axisToChainHash(${currgn}Y))] } set currentGraphList $graphlist set principal 1 foreach graph [concat $graphlist] { set graphIdx 0 if [info exists currimg] { set graphIdx [lsearch -exact $powPlotParam(images,$graph) $currimg] } if {!$principal} { set axis [chopped $graph] set graph [chop $graph] } if {!$zoomback} { if $principal { #note rROIbbox is in "scientific" coordinate, other bboxs are in "X" coordinates (i.e. upper left origin) set rROIbbox [list $llx $lly $urx $ury] if { $canvas != ".pow.scope" } { $canvas delete ROI } } else { if {$axis == "X"} { set abox [.pow.pow coords ${graph}box] set cllx $llx set clly [lindex [powCanvasToGraph $graph \ [lindex $abox 0] [lindex $abox 3] .pow.pow] 1] set curx $urx set cury [lindex [powCanvasToGraph $graph \ [lindex $abox 2] [lindex $abox 1] .pow.pow] 1] set rROIbbox [list $cllx $clly $curx $cury] } else { set abox [.pow.pow coords ${graph}box] set cllx [lindex [powCanvasToGraph $graph \ [lindex $abox 0] [lindex $abox 3] .pow.pow] 0] set clly $lly set curx [lindex [powCanvasToGraph $graph \ [lindex $abox 2] [lindex $abox 1] .pow.pow] 0] set cury $ury set rROIbbox [list $cllx $clly $curx $cury] } } } #get together everything you need for the next call to powCreateGraph set graph_position [.pow.pow coords ${graph}handle] set ROIcurves $powPlotParam(curves,$graph) set ROIimages $powPlotParam(images,$graph) set selection $powPlotParam(wcsName,$currgn) if { $selection == "WCS" } { set selection "DEFAULT" } else { set selection [string toupper [string range $selection end end]] } set powPlotParam(xunits,$graph) $powWCSLabel(xunit,$graph,$selection) set powPlotParam(yunits,$graph) $powWCSLabel(yunit,$graph,$selection) #puts "selection: $selection, graph: $graph" #puts "powPlotParam(xunits,$graph): $powWCSLabel(xunit,$graph,$selection)" #puts "powPlotParam(yunits,$graph): $powWCSLabel(yunit,$graph,$selection)" #puts "powPlotParam(xlabel,$graph): $powWCSLabel(xlabel,$graph,$selection)" #puts "powPlotParam(ylabel,$graph): $powWCSLabel(ylabel,$graph,$selection)" if ![info exist powWCSLabel(xlabel,$graph,$selection)] { set powWCSLabel(xlabel,$graph,$selection) "" } if ![info exist powWCSLabel(ylabel,$graph,$selection)] { set powWCSLabel(ylabel,$graph,$selection) "" } set powPlotParam(xlabel,$graph) $powWCSLabel(xlabel,$graph,$selection) set powPlotParam(ylabel,$graph) $powWCSLabel(ylabel,$graph,$selection) set ROIunits [list $powPlotParam(xunits,$graph) \ $powPlotParam(yunits,$graph) \ $powPlotParam(xlabel,$graph) \ $powPlotParam(ylabel,$graph) ] set ROIgraphOptions [powGetGraphOptions $graph] #puts "powEndROI powPlotParam(xmagstep,$currgn): $powPlotParam(xmagstep,$currgn)" #puts "powEndROI powPlotParam(prev_magnification,$currgn): $powPlotParam(prev_magnification,$currgn)" #puts "powEndROI powPlotParam(new_magnification,$currgn): $powPlotParam(new_magnification,$currgn)" #puts "powEndROI powPlotParam(g_multiplier,$currgn): $powPlotParam(g_multiplier,$currgn)" #puts "powEndROI powPlotParam(g_magnification,$currgn): $powPlotParam(g_magnification,$currgn)" #puts "powEndROI g_magnification: $g_magnification" # powUnmapGraph $graph 0 #puts "powPlotParam(xBot,$currgn) $powPlotParam(xBot,$currgn)" #puts "powPlotParam(xTop,$currgn) $powPlotParam(xTop,$currgn)" #puts "powPlotParam(yBot,$currgn) $powPlotParam(yBot,$currgn)" #puts "powPlotParam(yTop,$currgn) $powPlotParam(yTop,$currgn)" #puts "powPlotParam(xdimdisp,$currgn): $powPlotParam(xdimdisp,$currgn)" #puts "powPlotParam(zoomed,$currgn) $powPlotParam(zoomed,$currgn)" if {$zoomback} { if { ![info exists powZoomStart($currgn)] || $powZoomStart($currgn) != 1 } { set powPlotParam(zoomed,$graph) 1 eval [concat powCreateGraph $graph \{$ROIcurves\} \{$ROIimages\} \ $ROIunits $powPlotParam(xdimdisp,$graph) \ $powPlotParam(ydimdisp,$graph)] } else { set powPlotParam(xBot,$graph) $powPlotParam(xBot,$currgn) set powPlotParam(xTop,$graph) $powPlotParam(xTop,$currgn) set powPlotParam(yBot,$graph) $powPlotParam(yBot,$currgn) set powPlotParam(yTop,$graph) $powPlotParam(yTop,$currgn) set powPlotParam(zoomed,$graph) $powPlotParam(zoomed,$currgn) } set rROIbbox [list $powPlotParam(xBot,$graph) \ $powPlotParam(yBot,$graph) \ $powPlotParam(xTop,$graph) \ $powPlotParam(yTop,$graph) ] } else { set powPlotParam(zoomed,$currgn) 1 if [info exists powPlotParam(zoomed,c1_$currgn)] { set powPlotParam(zoomed,c1_$currgn) 1 } eval [concat powCreateGraph $graph \{$ROIcurves\} \{$ROIimages\} \ $ROIunits $powPlotParam(xdimdisp,$graph) \ $powPlotParam(ydimdisp,$graph) $rROIbbox] } eval [concat powGraphOptions $graph $ROIgraphOptions] set principal 0 if { [llength $ROIimages] > 1 } { # this is a movie powSelectImage $graph [lindex $powPlotParam(images,$graph) $graphIdx] } } if {$powGUI && $canvas != ".pow.scope"} { .pow.scope delete ROI powDrawScopeROI $rROIbbox } if {[info exists powGraphsTagRangeList($currgn)]} { foreach tagrangelist [concat $powGraphsTagRangeList($currgn)] { set tag [lindex $tagrangelist 3] eval [concat powColorRange $currgn $tagrangelist $powTagsColorMap($tag) 1] } } if {[info exists powGraphsTagRectList($currgn)]} { foreach tagrectlist [concat $powGraphsTagRectList($currgn)] { set tag [lindex $tagrectlist 4] eval [concat powColorRect $currgn $tagrectlist $powTagsColorMap($tag) 1] } } if { $zoomback == 1 } { # zoom back to original set powPlotParam(prev_magnification,$currgn) 1.0 set powPlotParam(new_magnification,$currgn) 1.0 set powPlotParam(g_multiplier,$currgn) 4.0 set powPlotParam(g_magnification,$currgn) 1.0 set g_magnification 1.0 } # this is for editing the graph set powEditPlotParam(xBot,new) $powPlotParam(xBot,$currgn) set powEditPlotParam(yBot,new) $powPlotParam(yBot,$currgn) set powEditPlotParam(xTop,new) $powPlotParam(xTop,$currgn) set powEditPlotParam(yTop,new) $powPlotParam(yTop,$currgn) set powDrawDone 1 } proc powDrawScopeROI { rROIbbox } { #puts "powDrawScopeROI start" global currgn set gn ${currgn}scope # If graph is empty, scopebox will be empty, so don't draw ROI if { [.pow.scope find withtag ${gn}box]=="" } return set rllx [lindex $rROIbbox 0] set rlly [lindex $rROIbbox 1] set rurx [lindex $rROIbbox 2] set rury [lindex $rROIbbox 3] set ccoords [powGraphToCanvas $gn $rllx $rlly .pow.scope] set ulx [lindex $ccoords 0] set lry [lindex $ccoords 1] set ccoords [powGraphToCanvas $gn $rurx $rury .pow.scope] set lrx [lindex $ccoords 0] set uly [lindex $ccoords 1] .pow.scope create rectangle $ulx $uly $lrx $lry -tags ROI -outline blue } #Select the graph if it is not the current graph. Then replot it. proc powDrawOriginal {x y} { #puts "powDrawOriginal start" global powDrawOriginalFlag global currgn set powDrawOriginalFlag true set gn [powWhereAmI $x $y] if {$gn != $currgn } { if { $gn != "NULL" } { set currgn $gn } else { # outside of graph, possible on scope set gn $currgn } powSelectGraph $gn } powEndROI 1 } proc powStretch {gn x y} { #puts "powStretch start" global stretchX0 stretchY0 global powPlotParam global fixedStretch new_xdim new_ydim global yellowLineWidth global ulx_yellow uly_yellow lrx_yellow lry_yellow global powHandX0 powHandY0 global powGBWidth powGBHeight global powrootx powrooty # Calculate root bounding box of allowed area of the canvas (- a little) if { ![info exists powrootx] || ![info exists powrooty] } { return } set cx [.pow.pow canvasx [expr $x - $powrootx]] set cy [.pow.pow canvasy [expr $y - $powrooty]] set left [expr $ulx_yellow + 30] set top [expr $uly_yellow + 30] set right [.pow.pow canvasx [expr [winfo width .pow.pow] - 20]] set bott [.pow.pow canvasy [expr [winfo height .pow.pow] - 20]] # Check whether we have moved outside of the .pow.pow canvas # or past the upper left corner of the current_gn box if { $cx < $left } { set cx $left } elseif { $cx > $right } { set cx $right } if { $cy < $top } { set cy $top } elseif { $cy > $bott } { set cy $bott } .pow.pow delete current_gn #how far have we moved the stretch-handle? set dx [expr $cx - $stretchX0] set dy [expr $cy - $stretchY0] #check magstep # calculate new xfactor from change in size of graphbox if { [expr $powGBWidth + $dx] < 1 } { set dx [expr 1 - $powGBWidth] } if { [expr $powGBHeight + $dy] < 1 } { set dy [expr 1 - $powGBHeight] } set xfactor [expr double($powGBWidth + $dx) / double($powGBWidth) ] set yfactor [expr double($powGBHeight + $dy) / double($powGBHeight)] if { $fixedStretch == "yes" } { if { $xfactor < $yfactor } { set yfactor $xfactor set dy [expr double($powGBHeight) * ($yfactor - 1.0)] } else { set xfactor $yfactor set dx [expr double($powGBWidth) * ($xfactor - 1.0)] } } #Move the stretch-handle .pow.pow coords ${gn}shandle [expr $powHandX0 + $dx] [expr $powHandY0 +$dy] #make new current_gn .pow.pow create rectangle $ulx_yellow $uly_yellow \ [expr $lrx_yellow + $dx] [expr $lry_yellow + $dy] \ -tags "current_gn graphDragable ${gn}yhandle handle ohandle" \ -outline yellow -width $yellowLineWidth set new_xdim [expr $xfactor * $powGBWidth] set new_ydim [expr $yfactor * $powGBHeight] #make magstep label set sizeText [format "%4d x %4d" [expr round($new_xdim)] \ [expr round($new_ydim)] ] .pow.ms[powCleanName ${gn}]handle configure -text "GraphSize: $sizeText" } proc powBeginStretch {gn x y} { #puts "powBeginStretch start" global powPlotParam ulx_yellow uly_yellow lrx_yellow lry_yellow global yellowLineWidth stretchX0 stretchY0 stretchGBWidth stretchGBHeight global powHandX0 powHandY0 global powGBWidth powGBHeight global powrootx powrooty powSelectGraph $gn set bbox [.pow.pow coords current_gn] set ulx_yellow [lindex $bbox 0] set uly_yellow [lindex $bbox 1] set lrx_yellow [lindex $bbox 2] set lry_yellow [lindex $bbox 3] set handcoords [.pow.pow coords ${gn}shandle] set powHandX0 [lindex $handcoords 0] set powHandY0 [lindex $handcoords 1] set gbox [.pow.pow coords ${gn}box] set powGBWidth [expr [lindex $gbox 2] - [lindex $gbox 0]] set powGBHeight [expr [lindex $gbox 3] - [lindex $gbox 1]] set powrootx [winfo rootx .pow.pow] set powrooty [winfo rooty .pow.pow] set stretchX0 [.pow.pow canvasx [expr $x - $powrootx ]] set stretchY0 [.pow.pow canvasy [expr $y - $powrooty ]] } proc powEndStretch {gn} { #puts "powEndStretch start" global powcursor powResizeMain powPlotParam global fixedStretch new_xdim new_ydim powStretchGraphToSize $gn $new_xdim $new_ydim powSelectGraph $gn powReconfigureToplevel $powResizeMain } proc powStartNewRow { } { #puts "powStartNewRow start" global powOpenAreaTop # update idletasks set powOpenAreaTop [lindex [.pow.pow bbox all] 3] } proc powInitGraph {gn xMin xMax yMin yMax xunits yunits xLabel yLabel \ {canvas ".pow.pow"} \ {xDim 600} {yDim 400} \ {xDimDisp 600} {yDimDisp 400} {aspect yes} \ {xmargin 60} {ymargin 60} } { # An array of plotting parameters global powPlotParam powOpenAreaTop powbg powScopeMargin powFontParam global powHeaderWcsKeyWord global powWCSList catch { wm deiconify .pow } #####################Plot set powPlotParam(images,$gn) "NULL" set powPlotParam(curves,$gn) "NULL" #set powPlotParam(zoomed,$gn) 0 if ![info exists powPlotParam(zoomed,$gn)] { set powPlotParam(zoomed,$gn) 0 } if {![info exists powOpenAreaTop]} {set powOpenAreaTop 10} if { $canvas == ".pow.scope" } { set powPlotParam(xo,$gn) $powScopeMargin set powPlotParam(yo,$gn) $powScopeMargin } elseif {[info exists powPlotParam(xo,$gn)]} { # Do nothing, thereby keeping the xo/yo values intact } elseif {$canvas == ".pow.pow"} then { # update idletasks set bbox [.pow.pow bbox all] if {$bbox != ""} { set leftSide [lindex $bbox 0] .pow.pow addtag currentRow enclosed $leftSide $powOpenAreaTop \ [lindex $bbox 2] [lindex $bbox 3] # update idletasks set bbox [.pow.pow bbox currentRow] .pow.pow dtag currentRow if {$bbox != ""} then { set powPlotParam(xo,$gn) [expr [lindex $bbox 2] + $xmargin] } else { set powPlotParam(xo,$gn) [expr $leftSide + $xmargin] } } else { set powPlotParam(xo,$gn) $xmargin } set powPlotParam(yo,$gn) [expr $powOpenAreaTop + $ymargin ] } set powPlotParam(graphHeight,$gn) $yDim set powPlotParam(graphWidth,$gn) $xDim set powPlotParam(xBot,$gn) $xMin set powPlotParam(xTop,$gn) $xMax set powPlotParam(xunits,$gn) $xunits set powPlotParam(xlabel,$gn) $xLabel set powPlotParam(yBot,$gn) $yMin set powPlotParam(yTop,$gn) $yMax set powPlotParam(yunits,$gn) $yunits set powPlotParam(ylabel,$gn) $yLabel ###################defaults for optional graph params handled by # powGraphOptions if {![info exists powPlotParam(bgcolor,$gn)]} { set powPlotParam(bgcolor,$gn) $powbg } if {![info exists powPlotParam(xmargin,$gn)]} { set powPlotParam(xmargin,$gn) $xmargin } if {![info exists powPlotParam(ymargin,$gn)]} { set powPlotParam(ymargin,$gn) $ymargin } if {![info exists powPlotParam(handletext,$gn)]} { set powPlotParam(handletext,$gn) "Select/Move: $gn" } if {![info exists powPlotParam(handleanchor,$gn)]} { set powPlotParam(handleanchor,$gn) "sw" } if {![info exists powPlotParam(handleposition,$gn)]} { set powPlotParam(handleposition,$gn) "tl" } if {![info exists powPlotParam(titleString,$gn)]} { set powPlotParam(titleString,$gn) "$gn" } if {![info exists powPlotParam(titlePosition,$gn)]} { set powPlotParam(titlePosition,$gn) "n" } if {![info exists powPlotParam(titleAnchor,$gn)]} { set powPlotParam(titleAnchor,$gn) "s" } # Axis tick and grid options... if {![info exists powPlotParam(GridLines,$gn)]} { set powPlotParam(GridLines,$gn) $powPlotParam(GridLines,powDef) } if {![info exists powPlotParam(GridColor,$gn)]} { set powPlotParam(GridColor,$gn) $powPlotParam(GridColor,powDef) } if {![info exists powPlotParam(GridDash,$gn)]} { set powPlotParam(GridDash,$gn) $powPlotParam(GridDash,powDef) } if {![info exists powPlotParam(xNumTicks,$gn)]} { set powPlotParam(xNumTicks,$gn) $powPlotParam(xNumTicks,powDef) } if {![info exists powPlotParam(yNumTicks,$gn)]} { set powPlotParam(yNumTicks,$gn) $powPlotParam(yNumTicks,powDef) } if {![info exists powPlotParam(xTickLength,$gn)]} { # order is [lft rgt top bot] set powPlotParam(xTickLength,$gn) $powPlotParam(xTickLength,powDef) } if {![info exists powPlotParam(yTickLength,$gn)]} { # order is [lft rgt top bot] set powPlotParam(yTickLength,$gn) $powPlotParam(yTickLength,powDef) } if {![info exists powPlotParam(xLabelTicks,$gn)]} { # order is [lft rgt top bot] set powPlotParam(xLabelTicks,$gn) $powPlotParam(xLabelTicks,powDef) } if {![info exists powPlotParam(yLabelTicks,$gn)]} { # order is [lft rgt top bot] set powPlotParam(yLabelTicks,$gn) $powPlotParam(yLabelTicks,powDef) } if {![info exists powPlotParam(tickLabels,$gn)]} { set powPlotParam(tickLabels,$gn) $powPlotParam(tickLabels,powDef) } if {![info exists powPlotParam(tickFormatCmdX,$gn)]} { set powPlotParam(tickFormatCmdX,$gn) $powPlotParam(tickFormatCmdX,powDef) } if {![info exists powPlotParam(tickFormatCmdY,$gn)]} { set powPlotParam(tickFormatCmdY,$gn) $powPlotParam(tickFormatCmdY,powDef) } if {![info exists powPlotParam(xTickScal,$gn)]} { set powPlotParam(xTickScal,$gn) $powPlotParam(xTickScal,powDef) } if {![info exists powPlotParam(yTickScal,$gn)]} { set powPlotParam(yTickScal,$gn) $powPlotParam(yTickScal,powDef) } if {![info exists powPlotParam(Notes,$gn)]} { set powPlotParam(Notes,$gn) {} } # WCS selection if {![info exists powPlotParam(wcsName,$gn)]} { set powPlotParam(wcsName,$gn) $powPlotParam(wcsName,powDef) } set idx 3 foreach wcsName [list a b c d e f g h i j k l m n o p q r s t u v w x y z] { if { [llength $powWCSList($gn)] == 2 } { set found [lsearch -exact [lindex $powWCSList($gn) 1] [string toupper $wcsName]] if { $found >= 0 } { .pow.mbar.edit.wcs entryconfigure $idx -state normal } } incr idx } update idletasks # Text Font Options... foreach lbl $powFontParam(allTypes,powDef) { foreach opt $powFontParam(allOpts,powDef) { if { ![info exists powFontParam(${lbl}${opt},$gn)] } { set powFontParam(${lbl}${opt},$gn) \ $powFontParam(${lbl}${opt},powDef) } } } # Graph size if { $xDimDisp == "NULL" } { if { ![info exists powPlotParam(xdimdisp,$gn)] } { set powPlotParam(xdimdisp,$gn) $powPlotParam(xdimdisp,powDef) } set xDimDisp $powPlotParam(xdimdisp,$gn) } else { set powPlotParam(xdimdisp,$gn) $xDimDisp } if { $yDimDisp == "NULL" } { if { ![info exists powPlotParam(ydimdisp,$gn)] } { set powPlotParam(ydimdisp,$gn) $powPlotParam(ydimdisp,powDef) } set yDimDisp $powPlotParam(ydimdisp,$gn) } else { set powPlotParam(ydimdisp,$gn) $yDimDisp } if {![info exists powPlotParam(FixedAspect,$gn)]} { set powPlotParam(FixedAspect,$gn) $aspect } #puts "powInitGraph Graph magstep, xDim: $xDim, yDim: $yDim, xDimDisp: $xDimDisp, yDimDisp, $yDimDisp" set xmagstep [expr double($xDimDisp)/$xDim] set ymagstep [expr double($yDimDisp)/$yDim] set newaspect [expr $xmagstep/$ymagstep] if { $powPlotParam(FixedAspect,$gn) } { if { [info exists powPlotParam(xmagstep,$gn)] } { set aspect [expr $powPlotParam(xmagstep,$gn) \ / $powPlotParam(ymagstep,$gn) ] if { $newaspect > $aspect } { set xmagstep [expr $ymagstep*$aspect] } else { set ymagstep [expr $xmagstep/$aspect] } } else { if { $xmagstep<$ymagstep } { if { [expr $xmagstep*$yDim] < [expr $yDimDisp/15.0] } { set ymagstep [expr $yDimDisp/15.0/$yDim] set powPlotParam(yNumTicks,$gn) \ [expr $powPlotParam(yNumTicks,$gn)/2+1] } else { set ymagstep $xmagstep } } else { if { [expr $ymagstep*$xDim] < [expr $xDimDisp/15.0] } { set xmagstep [expr $xDimDisp/15.0/$xDim] set powPlotParam(xNumTicks,$gn) \ [expr $powPlotParam(xNumTicks,$gn)/2+1] } else { set xmagstep $ymagstep } } # Handle special 1D case even better... if { $xDim==1 } { set powPlotParam(xNumTicks,$gn) 0 } if { $yDim == 1 } { set powPlotParam(yNumTicks,$gn) 0 } } } set powPlotParam(xmagstep,$gn) $xmagstep set powPlotParam(ymagstep,$gn) $ymagstep powSetGraphMagstep $gn $xmagstep $ymagstep ####### End of powInitGraph ######## } proc powBuildGraph { gn images curves canvas } { global powPlotParam powResizeMain powGUI currgn powOrderedGraphList global powcursor powbg powFirstTimeThroughFlag foreach el [list xo yo graphWidth graphHeight xmagstep ymagstep] { set $el $powPlotParam($el,$gn) } # Clean the canvas if there was a previous version of this graph $canvas delete $gn # Plot graph box and other niceties $canvas create rectangle $xo $yo \ [expr $graphWidth * $xmagstep + $xo] \ [expr $graphHeight * $ymagstep + $yo] \ -tags "$gn ${gn}box ${gn}line gbox" -outline black if {$canvas == ".pow.pow"} { # Can't have an image from the previous graph interfering with a new one powDeSelectImage powAdornGraph $gn $canvas .pow.pow delete ${gn}handles .pow.pow delete ${gn}shandle powMakeGraphHandles $gn if {$powFirstTimeThroughFlag} { powReconfigureToplevel 1 set powFirstTimeThroughFlag 0 } else { powReconfigureToplevel $powResizeMain } # Scroll to new graph set cbbox [.pow.pow cget -scrollregion] set bbox1 [.pow.pow bbox $gn] set xloc [expr double( [lindex $bbox1 0]+[lindex $bbox1 2]) \ / [lindex $cbbox 2] / 2.0 ] set yloc [expr double( [lindex $bbox1 1]+[lindex $bbox1 3]) \ / [lindex $cbbox 3] / 2.0 ] set xv [.pow.pow xview] if {$xloc<[lindex $xv 0] || $xloc>[lindex $xv 1]} { .pow.pow xview moveto [expr double([lindex $bbox1 0]-30) \ / [lindex $cbbox 2] ] } set yv [.pow.pow yview] if {$yloc<[lindex $yv 0] || $yloc>[lindex $yv 1]} { .pow.pow yview moveto [expr double([lindex $bbox1 1]-30) \ / [lindex $cbbox 3] ] } if { $gn != $currgn } { # Place a "working" message on graph, update screen, then continue set gMidX [expr 0.5*($graphWidth * $xmagstep) + $xo] set gMidY [expr 0.5*($graphHeight * $ymagstep) + $yo] .pow.pow create text $gMidX $gMidY \ -anchor center -tags deleteMe -text "Building graph..." update idletasks .pow.pow delete deleteMe } .pow.pow bind $gn "powSelectGraph $gn" .pow.pow bind graphSelect_$gn "powSelectGraph $gn" } powPlotImages $gn $images $canvas powPlotCurves $gn $curves $canvas if { $canvas==".pow.pow" \ && [lsearch -exact $powOrderedGraphList $gn]==-1 } { lappend powOrderedGraphList $gn } [gNotifications default] postMessage $gn graphHasFinishedDrawing } proc powSetCursor { crsr } { #puts "powSetCursor start" global powSaveCursor if { $crsr == "reset" } { set crsr [lindex $powSaveCursor end] set powSaveCursor [lreplace $powSaveCursor end end] } else { lappend powSaveCursor [.pow.pow cget -cursor] } .pow configure -cursor $crsr .pow.pow configure -cursor $crsr catch {.pow.scope configure -cursor $crsr} } proc powOverlapTest {id {canvas .pow.pow}} { #puts "powOverlapTest start" set bb [$canvas bbox $id] if {$bb != ""} { set olap [eval $canvas find overlapping $bb] } else { return 0 } foreach item $olap { set tags [$canvas gettags $item] if {$item != $id && !([string match "*handle*" $tags ])} { return 1 } } return 0 } proc powRedrawBox {gn {canvas .pow.pow}} { #puts "powRedrawBox start" global powPlotParam currimg foreach el [array names powPlotParam] { set p1 [lindex [split $el ,] 0] set p2 [lindex [split $el ,] 1] if { $p2 == $gn } { set $p1 $powPlotParam($p1,$p2) } } #find corners of new box set x0 [lindex [$canvas coords ${gn}box] 0] set y0 [lindex [$canvas coords ${gn}box] 3] set ccoords [powGraphToCanvas $gn $xTop $yTop $canvas] set x1 [lindex $ccoords 0] set y1 [lindex $ccoords 1] #remove previous box $canvas delete ${gn}box # plot the new box $canvas create rectangle $x0 $y1 $x1 $y0 \ -tags "$gn gbox ${gn}box ${gn}line" -outline black } proc powChangeGrid { {redraw 0} } { global powPlotParam currgn if { $currgn=="powDef" } {return} if {$redraw} { powAdornGraph $currgn .pow.pow } else { .pow.pow itemconfig ${currgn}grid \ -fill $powPlotParam(GridColor,$currgn) \ -dash $powPlotParam(GridDash,$currgn) } } proc powContour { } { #puts "powContour start" global currimg powRBmin powRBmax powbg powContourParam currgn global powDWP global g_titleFont if { ![info exists currimg] || $currimg=="NULL" || $currimg=="" } { tk_messageBox -message "Select a graph with an image first." \ -title "No Image" -type ok -parent .pow return } set powContourParam(image) $currimg set powContourParam(gn) $currgn set powContourParam(res) 2 set powContourParam(separate) no set powContourParam(nContrs) 10 set lst [powGetTics $powRBmin($currimg) $powRBmax($currimg) 10 linear] set powContourParam(min) [lindex $lst 0] set powContourParam(max) [lindex $lst end] set powContourParam(scale) linear if {[winfo exists ${powDWP}contour]} {destroy ${powDWP}contour} powToplevel ${powDWP}contour .pow "-bg $powbg" bind ${powDWP}contour <> "destroy ${powDWP}contour" catch {wm title ${powDWP}contour "Create Contours"} button ${powDWP}contour.help -text "Help" \ -command {powHelp Contours.html} \ -bg $powbg -takefocus 0 -font g_titleFont label ${powDWP}contour.image -bg $powbg -text "Image:" -font g_titleFont label ${powDWP}contour.currimg -bg yellow -fg black -text $currimg -font g_titleFont label ${powDWP}contour.imgrng -bg $powbg -text "Image Range:" -font g_titleFont frame ${powDWP}contour.imgfrm -bg $powbg label ${powDWP}contour.imgfrm.min -bg $powbg -width 10 \ -text "$powRBmin($currimg)" -font g_titleFont label ${powDWP}contour.imgfrm.dash -bg $powbg -text " - " -font g_titleFont label ${powDWP}contour.imgfrm.max -bg $powbg -width 10 \ -text "$powRBmax($currimg)" -font g_titleFont pack ${powDWP}contour.imgfrm.min -in ${powDWP}contour.imgfrm -side left \ -padx 4 -pady 1 -fill x -expand 1 pack ${powDWP}contour.imgfrm.dash -in ${powDWP}contour.imgfrm -side left \ -padx 4 -pady 1 pack ${powDWP}contour.imgfrm.max -in ${powDWP}contour.imgfrm -side left \ -padx 4 -pady 1 -fill x -expand 1 label ${powDWP}contour.pixrng -bg $powbg -text "Contour Range:" -font g_titleFont frame ${powDWP}contour.pixfrm -bg $powbg entry ${powDWP}contour.pixfrm.min -bg $powbg -width 10 \ -textvariable powContourParam(min) -takefocus 1 -font g_titleFont label ${powDWP}contour.pixfrm.dash -bg $powbg -text " - " -font g_titleFont entry ${powDWP}contour.pixfrm.max -bg $powbg -width 10 \ -textvariable powContourParam(max) -takefocus 1 -font g_titleFont pack ${powDWP}contour.pixfrm.min -in ${powDWP}contour.pixfrm -side left \ -padx 4 -pady 1 -fill x -expand 1 pack ${powDWP}contour.pixfrm.dash -in ${powDWP}contour.pixfrm -side left \ -padx 4 -pady 1 pack ${powDWP}contour.pixfrm.max -in ${powDWP}contour.pixfrm -side left \ -padx 4 -pady 1 -fill x -expand 1 label ${powDWP}contour.scale -bg $powbg -text "Scale:" -font g_titleFont frame ${powDWP}contour.sclbutt -bg $powbg radiobutton ${powDWP}contour.sclbutt.linear -bg $powbg -text Linear \ -variable powContourParam(scale) -value linear \ -highlightthickness 0 -takefocus 0 -font g_titleFont radiobutton ${powDWP}contour.sclbutt.sqrt -bg $powbg -text Sqrt \ -variable powContourParam(scale) -value sqrt \ -highlightthickness 0 -takefocus 0 -font g_titleFont radiobutton ${powDWP}contour.sclbutt.log -bg $powbg -text Log \ -variable powContourParam(scale) -value log \ -highlightthickness 0 -takefocus 0 -font g_titleFont pack ${powDWP}contour.sclbutt.linear -in ${powDWP}contour.sclbutt -side left \ -padx 4 -pady 1 pack ${powDWP}contour.sclbutt.sqrt -in ${powDWP}contour.sclbutt -side left \ -padx 4 -pady 1 pack ${powDWP}contour.sclbutt.log -in ${powDWP}contour.sclbutt -side left \ -padx 4 -pady 1 label ${powDWP}contour.ncntrs -bg $powbg -text "# Contours:" -font g_titleFont frame ${powDWP}contour.ncntrsbutt -bg $powbg button ${powDWP}contour.ncntrsbutt.less -bg $powbg -text "<" \ -command { incr powContourParam(nContrs) -1 } -takefocus 0 -font g_titleFont entry ${powDWP}contour.ncntrsbutt.numb -bg $powbg \ -textvariable powContourParam(nContrs) -width 5 -takefocus 1 -font g_titleFont button ${powDWP}contour.ncntrsbutt.more -bg $powbg -text ">" \ -command { incr powContourParam(nContrs) 1 } -takefocus 0 -font g_titleFont pack ${powDWP}contour.ncntrsbutt.less -in ${powDWP}contour.ncntrsbutt -side left \ -pady 1 pack ${powDWP}contour.ncntrsbutt.numb -in ${powDWP}contour.ncntrsbutt -side left \ -pady 1 pack ${powDWP}contour.ncntrsbutt.more -in ${powDWP}contour.ncntrsbutt -side left \ -pady 1 trace variable powContourParam(nContrs) w { powSetContours } trace variable powContourParam(min) w { powSetContours } trace variable powContourParam(max) w { powSetContours } trace variable powContourParam(scale) w { powSetContours } label ${powDWP}contour.clist -bg $powbg -text "Contours:" -font g_titleFont frame ${powDWP}contour.cntrs -bg $powbg scrollbar ${powDWP}contour.cntrs.scrolly -orient vertical -takefocus 0 \ -command {${powDWP}contour.cntrs.lst yview} -bg $powbg text ${powDWP}contour.cntrs.lst -bg $powbg -width 20 -height 5 \ -yscrollcommand {${powDWP}contour.cntrs.scrolly set } \ -takefocus 0 -font g_titleFont grid ${powDWP}contour.cntrs.lst -in ${powDWP}contour.cntrs -row 1 -column 1 \ -sticky news grid ${powDWP}contour.cntrs.scrolly -in ${powDWP}contour.cntrs -row 1 -column 2 \ -sticky news grid rowconfigure ${powDWP}contour.cntrs 1 -weight 1 grid columnconfigure ${powDWP}contour.cntrs 1 -weight 1 label ${powDWP}contour.res -bg $powbg -text "Resolution:" -font g_titleFont frame ${powDWP}contour.resbutt -bg $powbg radiobutton ${powDWP}contour.resbutt.high -bg $powbg -text High \ -variable powContourParam(res) -value 1 -highlightthickness 0 \ -takefocus 0 -font g_titleFont radiobutton ${powDWP}contour.resbutt.med -bg $powbg -text Medium \ -variable powContourParam(res) -value 2 -highlightthickness 0 \ -takefocus 0 -font g_titleFont radiobutton ${powDWP}contour.resbutt.low -bg $powbg -text Low \ -variable powContourParam(res) -value 3 -highlightthickness 0 \ -takefocus 0 -font g_titleFont pack ${powDWP}contour.resbutt.high -in ${powDWP}contour.resbutt -side left \ -padx 4 -pady 1 pack ${powDWP}contour.resbutt.med -in ${powDWP}contour.resbutt -side left \ -padx 4 -pady 1 pack ${powDWP}contour.resbutt.low -in ${powDWP}contour.resbutt -side left \ -padx 4 -pady 1 checkbutton ${powDWP}contour.separate -bg $powbg \ -text "Place contours in separate graph" \ -variable powContourParam(separate) -onvalue yes -offvalue no \ -highlightthickness 0 -takefocus 0 -font g_titleFont frame ${powDWP}contour.buttons -bg $powbg button ${powDWP}contour.buttons.make -text "Make Contours" -bg $powbg \ -command { powMakeContours $powContourParam(image) \ [${powDWP}contour.cntrs.lst get 1.0 end] \ $powContourParam(res) } -font g_titleFont button ${powDWP}contour.buttons.exit -text "Exit" -bg $powbg \ -command {destroy ${powDWP}contour} -font g_titleFont pack ${powDWP}contour.buttons.make -in ${powDWP}contour.buttons -side left \ -padx 4 -pady 3 pack ${powDWP}contour.buttons.exit -in ${powDWP}contour.buttons -side left \ -padx 4 -pady 3 grid ${powDWP}contour.help -in ${powDWP}contour -row 0 -column 2 -sticky ne grid ${powDWP}contour.image -in ${powDWP}contour -row 0 -column 0 -sticky e \ -pady 8 grid ${powDWP}contour.currimg -in ${powDWP}contour -row 0 -column 1 -sticky ew \ -pady 8 -padx 6 grid ${powDWP}contour.imgrng -in ${powDWP}contour -row 2 -column 0 -sticky e grid ${powDWP}contour.imgfrm -in ${powDWP}contour -row 2 -column 1 -sticky ew \ -columnspan 2 grid ${powDWP}contour.pixrng -in ${powDWP}contour -row 3 -column 0 -sticky e grid ${powDWP}contour.pixfrm -in ${powDWP}contour -row 3 -column 1 -sticky ew \ -columnspan 2 grid ${powDWP}contour.ncntrs -in ${powDWP}contour -row 4 -column 0 -sticky e grid ${powDWP}contour.ncntrsbutt -in ${powDWP}contour -row 4 -column 1 -sticky w \ -padx 4 grid ${powDWP}contour.scale -in ${powDWP}contour -row 5 -column 0 -sticky e grid ${powDWP}contour.sclbutt -in ${powDWP}contour -row 5 -column 1 -sticky w grid ${powDWP}contour.clist -in ${powDWP}contour -row 6 -column 0 -sticky e grid ${powDWP}contour.cntrs -in ${powDWP}contour -row 6 -column 1 -sticky news \ -padx 5 -columnspan 2 grid ${powDWP}contour.res -in ${powDWP}contour -row 8 -column 0 -sticky e grid ${powDWP}contour.resbutt -in ${powDWP}contour -row 8 -column 1 -sticky w \ -pady 8 grid ${powDWP}contour.separate -in ${powDWP}contour -row 10 -column 0 -sticky ew \ -padx 6 -pady 8 -columnspan 3 grid ${powDWP}contour.buttons -in ${powDWP}contour -row 11 -column 0 -columnspan 3 \ -pady 8 grid columnconfigure ${powDWP}contour 1 -weight 1 grid rowconfigure ${powDWP}contour 0 -weight 1 grid rowconfigure ${powDWP}contour 1 -minsize 10 grid rowconfigure ${powDWP}contour 7 -minsize 10 grid rowconfigure ${powDWP}contour 6 -weight 1 grid rowconfigure ${powDWP}contour 11 -weight 1 powSetContours 0 0 0 } proc powGetScale { min max scale nlvls } { #puts "powGetScale start" global powDWP set offset 0.0 if { $min<0.0 } { set offset [expr -2.0*$min] set min [expr $min+$offset] set max [expr $max+$offset] } set min [expr double($min)] set max [expr double($max)] set list "" switch $scale { linear { set step [expr ($max-$min) / ($nlvls-1) ] set val $min for {set i 0} {$i<$nlvls} {incr i} { lappend list [expr $val-$offset] set val [expr $val + $step] } } sqrt { set step [expr ( sqrt($max) - sqrt($min) ) / ($nlvls-1) ] set val [expr sqrt($min)] for {set i 0} {$i<$nlvls} {incr i} { lappend list [expr $val*$val-$offset] set val [expr $val + $step] } } log { if {$min==0.0} {set min [expr 0.001*$max]} set step [expr log( $max / $min ) / ($nlvls-1) ] set val [expr log($min)] for {set i 0} {$i<$nlvls} {incr i} { lappend list [expr exp($val)-$offset] set val [expr $val + $step] } } exp {} } return $list } proc powSetContours { a b c } { #puts "powSetContours start" global powContourParam powDWP set nContrs $powContourParam(nContrs) if { $nContrs == "" } return if { !($nContrs > 2) } { set nContrs 2 } set powContourParam(list) "" set powContourParam(list) \ [powGetScale $powContourParam(min) $powContourParam(max) \ $powContourParam(scale) $nContrs] if { [winfo exists ${powDWP}contour.cntrs.lst] } { ${powDWP}contour.cntrs.lst delete 1.0 end ${powDWP}contour.cntrs.lst insert end [join $powContourParam(list) "\n"] } } proc powMakeContours { img list res } { global powContourParam powPlotParam global powWCS powCurveParam global powFitsHeader powFitsHeaderCnt xCount yCount global powWCSList powWCSLabel powWCSName global useWCSInfo global currgn set gn $powContourParam(gn) set cntr ${img}_contour catch { powDeleteGraph $cntr NOPROMPT } set useWCS false if { [info exists powWCS($img)] && $powWCS($img)!="" } { set powWCS($cntr) $powWCS($img) if { [lindex [lindex $powWCS($img) 0] 0] != 0.0 } { set useWCS true } } set powWCSList($cntr) $powWCSList($gn) set powWCSList(${cntr}scope) $powWCSList($gn) set powWCSName($cntr) $powWCSName($gn) set powWCSName(${cntr}scope) $powWCSName($gn) powCreateContour $cntr $img $list $res set powContourParam(list) $list set useWCSInfo($cntr) $fvPref::ifWCSInfo set useWCSInfo(${cntr}scope) $fvPref::ifWCSInfo set powWCSLabel(xlabel,$cntr,DEFAULT) $powWCSLabel(xlabel,$gn,DEFAULT) set powWCSLabel(ylabel,$cntr,DEFAULT) $powWCSLabel(ylabel,$gn,DEFAULT) set powWCSLabel(xunit,$cntr,DEFAULT) $powWCSLabel(xunit,$gn,DEFAULT) set powWCSLabel(yunit,$cntr,DEFAULT) $powWCSLabel(yunit,$gn,DEFAULT) if { $powContourParam(separate) == "yes" } { set graph $cntr set images NULL set curves $cntr set powFitsHeader($cntr) $powFitsHeader($gn) set powFitsHeader(${cntr}scope) $powFitsHeader($gn) set powFitsHeaderCnt($cntr) $powFitsHeaderCnt($gn) set powFitsHeaderCnt(${cntr}scope) $powFitsHeaderCnt($gn) set powWCS(${cntr}scope) $powWCS($cntr) if { $useWCS == "true" } { set powPlotParam(graphType,$cntr) $powPlotParam(graphType,$gn) set powPlotParam(graphType,${cntr}scope) $powPlotParam(graphType,$cntr) } else { set powPlotParam(graphType,$cntr) "binary" set powPlotParam(graphType,${cntr}scope) "binary" set powPlotParam(graphType,$gn) "binary" } set powPlotParam(zoomed,$cntr) $powPlotParam(zoomed,$gn) set powPlotParam(zoomed,${cntr}scope) $powPlotParam(zoomed,$cntr) set xCount($cntr) $xCount($gn) set yCount($cntr) $yCount($gn) set xCount(${cntr}scope) $xCount($cntr) set yCount(${cntr}scope) $yCount($cntr) } else { set graph $gn set images $powPlotParam(images,$gn) set curves $powPlotParam(curves,$gn) if {$curves=="NULL"} { set curves $cntr } else { lappend curves $cntr } } # Find the true width of the of the graph box set width [tagXdim .pow.pow ${gn}box] set height [tagYdim .pow.pow ${gn}box] if { [lsearch -exact [powListGraphs] $graph]>=0 } { powUnmapGraph $graph } set powCurveParam(lStyle${cntr},$graph) " " set powCurveParam(lDisp${cntr},$graph) Yes set powCurveParam(pDisp${cntr},$graph) No set fixed $powPlotParam(FixedAspect,$gn) powCreateGraph $graph $curves $images \ $powPlotParam(xunits,$gn) $powPlotParam(yunits,$gn) \ $powPlotParam(xlabel,$gn) $powPlotParam(ylabel,$gn) \ $width $height \ $powPlotParam(xBot,$gn) $powPlotParam(yBot,$gn) \ $powPlotParam(xTop,$gn) $powPlotParam(yTop,$gn) set powPlotParam(FixedAspect,$graph) $fixed } proc powAdornGraph {gn {canvas ".pow.pow"}} { global powPlotParam if {$canvas != ".pow.pow" || $gn=="powDef" } {return} foreach par [list xNumTicks yNumTicks GridColor GridDash GridLines \ xTickScal yTickScal tickLabels] { set $par $powPlotParam($par,$gn) } if { $tickLabels=="degrees" && [powWCSexists $gn] } { # Convert "wcs" scaling to ra/dec to distinguish x/y axes set xTickScal "ra" set yTickScal "dec" } # Make tick frequency non-linear set xNumTicks [expr $xNumTicks + int(exp($xNumTicks/3.0)) - 1] set yNumTicks [expr $yNumTicks + int(exp($yNumTicks/3.0)) - 1] .pow.pow delete ${gn}grid set powPlotParam(tickList,$gn) \ [powDrawGridLines $gn $canvas $xTickScal $yTickScal \ $GridColor $xNumTicks $yNumTicks $GridDash \ $GridLines ] #puts "powPlotParam(tickList,$gn): $powPlotParam(tickList,$gn)" powDrawTicks $gn $canvas powMakeGraphLabels $gn } proc powDrawTicks { gn {canvas .pow.pow} } { global powPlotParam powFontParam global powTicksPerAxis global xCount yCount foreach par [list xTickLength xLabelTicks yTickLength yLabelTicks \ xmargin xTickScal yTickScal tickLabels tickFormatCmdX \ tickFormatCmdY] { set $par $powPlotParam($par,$gn) } set sideOrder [list lft rgt top bot] if { $tickLabels=="degrees" && [powWCSexists $gn] } { set xTickScal "ra" set yTickScal "dec" } .pow.pow delete ${gn}ticks ${gn}nums ${gn}label foreach axis [list x y] { foreach side [list top lft rgt bot none] { set powTicksPerAxis($axis$side,$gn) 0 } } ################################################################ # # Analyze tick values to identify required precision on labels # set xValues {} set yValues {} foreach {x y val axis side} $powPlotParam(tickList,$gn) { if { $axis=="x" } { lappend xValues $val } elseif { $axis=="y" } { lappend yValues $val } } set xValues [lsort -unique -real $xValues] set xLabelFmt [powBuildAxisFormat $xValues $xTickScal \ $powPlotParam(tickFormatCmdX,$gn)] set yValues [lsort -unique -real $yValues] set yLabelFmt [powBuildAxisFormat $yValues $yTickScal \ $powPlotParam(tickFormatCmdY,$gn)] # # ################################################################ #set direction "U" set newTickList $powPlotParam(tickList,$gn) #foreach {x y val axis side} $powPlotParam(tickList,$gn) # incr powTicksPerAxis($axis$side,$gn) foreach {x y val axis side} $powPlotParam(tickList,$gn) { incr powTicksPerAxis($axis$side,$gn) foreach {x y} [powGraphToCanvas $gn $x $y $canvas] {} if {$axis=="x"} { if {$xTickScal=="ra"} { set label [powHourRA $val $xLabelFmt] if { [llength $xValues]<2 } { # string will be of format xxhxxmxx.xxxxs regsub {\.*0*s$} $label "s" label regsub {00s$} $label "" label } else { regsub {X.*$} $label "" label } } elseif {$xTickScal=="log"} { set label [eval $xLabelFmt [expr pow(10.0,$val)] ] } else { set label [eval $xLabelFmt $val ] } } elseif {$axis=="y"} { if {$yTickScal=="dec"} { set label [powDegDec $val $yLabelFmt] if { [llength $yValues]<2 } { # string will be of format xx:xx:xx.xxxx regsub {(:00)?\.*0*$} $label "" label } else { regsub {X.*$} $label "" label } } elseif {$yTickScal=="log"} { set label [eval $yLabelFmt [expr pow(10.0,$val)] ] } else { set label [eval $yLabelFmt $val ] } } switch $side { lft { set tckLen [eval lindex \$${axis}TickLength 0] set tckLab [eval lindex \$${axis}LabelTicks 0] if { $tckLen != 0 } { $canvas create line $x $y [expr $x - $tckLen] $y \ -tags "$gn ${gn}line ${gn}ticks ${gn}lftticks ${gn}${axis}ticks" \ -fill black } if { $tckLab } { $canvas create text [expr $x - 5 - ($tckLen>0?$tckLen:0)] $y \ -text $label -anchor e -font [powGetFontList $gn tick] \ -fill $powFontParam(tickColor,$gn) \ -tags "$gn ${gn}text ${gn}nums ${gn}lftnums ${gn}${gn}nums" } } rgt { set tckLen [eval lindex \$${axis}TickLength 1] set tckLab [eval lindex \$${axis}LabelTicks 1] if { $tckLen != 0 } { $canvas create line $x $y [expr $x + $tckLen] $y \ -tags "$gn ${gn}line ${gn}ticks ${gn}rgtticks ${gn}${axis}ticks" \ -fill black } if { $tckLab } { $canvas create text [expr $x + 5 + ($tckLen>0?$tckLen:0)] $y \ -text $label -anchor w -font [powGetFontList $gn tick] \ -fill $powFontParam(tickColor,$gn) \ -tags "$gn ${gn}text ${gn}nums ${gn}rgtnums ${gn}${gn}nums" } } top { set tckLen [eval lindex \$${axis}TickLength 2] set tckLab [eval lindex \$${axis}LabelTicks 2] if { $tckLen != 0 } { $canvas create line $x $y $x [expr $y - $tckLen] \ -tags "$gn ${gn}line ${gn}ticks ${gn}topticks ${gn}${axis}ticks" \ -fill black } if { $tckLab } { $canvas create text $x [expr $y - 5 - ($tckLen>0?$tckLen:0)] \ -text $label -anchor s -font [powGetFontList $gn tick] \ -fill $powFontParam(tickColor,$gn) \ -tags "$gn ${gn}text ${gn}nums ${gn}topnums ${gn}${gn}nums" } } bot { set tckLen [eval lindex \$${axis}TickLength 3] set tckLab [eval lindex \$${axis}LabelTicks 3] if { $tckLen != 0 } { $canvas create line $x $y $x [expr $y + $tckLen] \ -tags "$gn ${gn}line ${gn}ticks ${gn}botticks ${gn}${axis}ticks" \ -fill black } if { $tckLab } { $canvas create text $x [expr $y + 5 + ($tckLen>0?$tckLen:0)] \ -text $label -anchor n -font [powGetFontList $gn tick] \ -fill $powFontParam(tickColor,$gn) \ -tags "$gn ${gn}text ${gn}nums ${gn}botnums ${gn}${axis}nums" } } } } # .pow.pow bind ${gn}nums \ # ".pow.pow itemconfigure ${gn}nums -fill yellow" # .pow.pow bind ${gn}nums \ # ".pow.pow itemconfigure ${gn}nums -fill black" .pow.pow bind ${gn}nums <> \ "powEditGraphDlg $gn; powEditSelectPage Ticks" } proc powMakeGraphLabels { gn {canvas ".pow.pow"} } { global powPlotParam powFontParam global powTicksPerAxis foreach par [list xTickLength xLabelTicks yTickLength yLabelTicks \ xlabel ylabel xunits yunits titleString titlePosition titleAnchor \ xmargin xTickScal yTickScal tickLabels] { set $par $powPlotParam($par,$gn) } foreach [list lft top rgt bot] [$canvas coords ${gn}box] {} # put the X and Y labels if { $xunits=="" || [regexp -nocase NULL $xunits] } { set xString "$xlabel" } else { set xString "$xlabel ($xunits)" } if { $yunits=="" || [regexp -nocase NULL $yunits] } { set yString "$ylabel" } else { set yString "$ylabel ($yunits)" } # Should we swap the Axis labels? if { [powWCSisSwapped $gn] && \ $powTicksPerAxis(xlft,$gn) < $powTicksPerAxis(xbot,$gn) && \ $powTicksPerAxis(ylft,$gn) > $powTicksPerAxis(ybot,$gn) } { set tmp $xString set xString $yString set yString $tmp } elseif { ![powWCSisSwapped $gn] && \ $powTicksPerAxis(xlft,$gn) > $powTicksPerAxis(xbot,$gn) && \ $powTicksPerAxis(ylft,$gn) < $powTicksPerAxis(ybot,$gn) } { set tmp $xString set xString $yString set yString $tmp } set lineSpace [font metrics [powGetFontList $gn axis] -linespace] incr lineSpace 5 set topMarg [powMax [lindex $xTickLength 2] [lindex $yTickLength 2]] set botMarg [powMax [lindex $xTickLength 3] [lindex $yTickLength 3]] if { $botMarg<0 } {set botMarg 0} if { $topMarg<0 } {set topMarg 0} if [regexp {[^ ]} $xString] { $canvas create text [expr ($lft + $rgt)/2 ] \ [expr $bot + $botMarg + $lineSpace] -text $xString -anchor n \ -tags "$gn ${gn}label ${gn}xlabel ${gn}text" \ -font [powGetFontList $gn axis] \ -fill $powFontParam(axisColor,$gn) } if [regexp {[^ ]} $yString] { $canvas create text [expr $lft - $xmargin/2] \ [expr $top - $topMarg] -text $yString -anchor sw \ -justify left -tags "$gn ${gn}label ${gn}ylabel ${gn}text"\ -font [powGetFontList $gn axis] \ -fill $powFontParam(axisColor,$gn) } # Now do the titleString # identical file name handler set titleStrToken [split $titleString "_"] if { [llength $titleStrToken] > 1 } { set titleStrToken [lreplace $titleStrToken end end] set titleString [lindex $titleStrToken 0] for {set i 1} {$i < [llength $titleStrToken]} {incr i} { set titleString [format "%s_%s" $titleString [lindex $titleStrToken $i]] } } if [regexp {[^ ]} $titleString] { if [string match "*w*" $titlePosition] { set x $lft } elseif [string match "*e*" $titlePosition] { set x $rgt } else { set x [expr ($lft + $rgt)*0.5] } if [string match "*n*" $titlePosition] { set y [expr $top - $topMarg] if { [lindex $xLabelTicks 2] || [lindex $yLabelTicks 2] } { set y [expr $y - $lineSpace] } if [regexp {[^ ]} $yString] { set y [expr $y - $lineSpace] } } elseif [string match "*s*" $titlePosition] { set y [expr $bot + $botMarg] if { [lindex $xLabelTicks 3] || [lindex $yLabelTicks 3] } { set y [expr $y + $lineSpace] } if [regexp {[^ ]} $xString] { set y [expr $y + $lineSpace] } } else { set y [expr ($top + $bot)*0.5] } $canvas create text $x $y -anchor $titleAnchor -text $titleString \ -tags "$gn graphDragable ${gn}label ${gn}tlabel ${gn}text" \ -font [powGetFontList $gn title] \ -fill $powFontParam(titleColor,$gn) } # $canvas bind ${gn}label \ # "$canvas itemconfigure ${gn}label -fill yellow" # $canvas bind ${gn}label \ # "$canvas itemconfigure ${gn}label -fill black" $canvas bind ${gn}label <> \ "powEditGraphDlg $gn; powEditSelectPage Graph" # Now do any extra graph labels powRedrawNotes $gn } proc powDummyRangeCallback { gn x0 x1} { #puts "powDummyRangeCallback start" puts "You have selected the ordered pair: ( $x0 , $x1) on the graph $gn" } proc powDragRange { x_or_y {tag highlight} {color red} {callback powDummyRangeCallback}} { #puts "powDragRange start" global currgn powRangeX0 powRangeX1 powRangeX0C powRangeXC global powRangeY0 powRangeY1 powRangeY0C powRangeYC powRangeTag powRangeColor global powRangeCallback powRangeSaveBinding set powRangeCallback $callback set powRangeTag $tag set powRangeColor $color set powRangeSaveBinding(ButtonPress-1) [bind .pow.pow ] set powRangeSaveBinding(B1-Motion) [bind .pow.pow ] set powRangeSaveBinding(ButtonRelease-1) [bind .pow.pow ] bind .pow.pow { set gn [powWhereAmI %x %y]; if {$gn == $currgn} { set powRangeX0C [.pow.pow canvasx %x]; set powRangeY0C [.pow.pow canvasy %y]; set gcoords [powCanvasToGraph $currgn $powRangeX0C $powRangeY0C \ .pow.pow]; set powRangeX0 [lindex gcoords 0] set powRangeY0 [lindex gcoords 1] .pow.pow create line $powRangeX0C $powRangeY0C $powRangeX0C $powRangeY0C \ -tags Range -fill $powRangeColor } } bind .pow.pow { set gn [powWhereAmI %x %y]; if {$gn == $currgn} { if {![info exists powRangeX0C]} { set powRangeX0C [.pow.pow canvasx %x]; set powRangeY0C [.pow.pow canvasy %y]; set gcoords [powCanvasToGraph $currgn $powRangeX0C $powRangeY0C \ .pow.pow]; set powRangeX0 [lindex gcoords 0] set powRangeY0 [lindex gcoords 1] } else { .pow.pow delete Range; } set powRangeXC [.pow.pow canvasx %x]; set powRangeYC [.pow.pow canvasy %y]; .pow.pow create line $powRangeX0C $powRangeY0C $powRangeXC $powRangeYC \ -tags Range -fill $powRangeColor } } if {$x_or_y == "X"} { bind .pow.pow { if {[info exists powRangeX0C]} { set range_coords [.pow.pow coords Range] .pow.pow delete Range set powRangeXC [lindex $range_coords 0]; set powRangeYC [lindex $range_coords 1]; set powRangeCoords [powCanvasToGraph $currgn \ $powRangeXC $powRangeYC .pow.pow] set powRangeX0 [lindex $powRangeCoords 0] set powRangeY0 [lindex $powRangeCoords 1] set powRangeXC [lindex $range_coords 2]; set powRangeYC [lindex $range_coords 3]; set powRangeCoords [powCanvasToGraph $currgn \ $powRangeXC $powRangeYC .pow.pow] set powRangeX1 [lindex $powRangeCoords 0] set powRangeY1 [lindex $powRangeCoords 1] powColorRange $currgn X $powRangeX0 $powRangeX1 $powRangeY0 $powRangeY1 $powRangeTag $powRangeColor 0; $powRangeCallback $currgn $powRangeX0 $powRangeX1; bind .pow.pow \ "$powRangeSaveBinding(ButtonPress-1)"; bind .pow.pow \ "$powRangeSaveBinding(B1-Motion)"; bind .pow.pow \ "$powRangeSaveBinding(ButtonRelease-1)"; #clear start point for next Drag unset powRangeX0C } } } else { bind .pow.pow { if {[info exists powRangeX0C]} { set range_coords [.pow.pow coords Range] .pow.pow delete Range set powRangeXC [lindex $range_coords 0]; set powRangeYC [lindex $range_coords 1]; set powRangeCoords [powCanvasToGraph $currgn \ $powRangeXC $powRangeYC .pow.pow] set powRangeX0 [lindex $powRangeCoords 0] set powRangeY0 [lindex $powRangeCoords 1] set powRangeXC [lindex $range_coords 2]; set powRangeYC [lindex $range_coords 3]; set powRangeCoords [powCanvasToGraph $currgn \ $powRangeXC $powRangeYC .pow.pow] set powRangeX1 [lindex $powRangeCoords 0] set powRangeY1 [lindex $powRangeCoords 1] powColorRange $currgn Y $powRangeX0 $powRangeX1 $powRangeY0 $powRangeY1 $powRangeTag $powRangeColor 0; $powRangeCallback $currgn $powRangeY0 $powRangeY1; bind .pow.pow \ "$powRangeSaveBinding(ButtonPress-1)"; bind .pow.pow \ "$powRangeSaveBinding(B1-Motion)"; bind .pow.pow \ "$powRangeSaveBinding(ButtonRelease-1)"; #clear start point for next Drag unset powRangeX0C } } } } proc powColorRange { gn x_or_y x0 x1 y0 y1 {tag highlight} {color red} {redrawing 0}} { #puts "powColorRange start" global powGraphsTagRangeList powTagsColorMap global chainToAxisHash axisToChainHash # puts "powColorRange: $gn $x_or_y $x0 $x1 $y0 $y1 $tag $color $redrawing" if {$x_or_y == "X"} { set a0 $x0 set a1 $x1 } else { set a0 $y0 set a1 $y1 } if {$a0 > $a1} { set tmp $a0 set a0 $a1 set a1 $tmp } if {!$redrawing} { set powTagsColorMap($tag) $color lappend powGraphsTagRangeList($gn) "$x_or_y $a0 $a1 $tag" } set graphlist ${gn}$x_or_y if {$x_or_y =="X"} { if {[array names axisToChainHash ${gn}X] != ""} { set graphlist [concat $graphlist $chainToAxisHash($axisToChainHash(${gn}X))] } } else { if {[array names axisToChainHash ${gn}Y] != ""} { set graphlist [concat $graphlist $chainToAxisHash($axisToChainHash(${gn}Y))] } } foreach graph [concat $graphlist] { set axis [chopped $graph] set graph [chop $graph] powTagRange $graph $x_or_y $x0 $x1 $y0 $y1 $tag } .pow.pow itemconfigure $tag -fill $color } proc powTagRange { gn x_or_y x0 x1 y0 y1 tag } { #puts "powTagRange start" # puts "powTagRange: $gn $x_or_y $x0 $x1 $tag" set gbox [.pow.pow coords ${gn}box] set gx0 [lindex $gbox 0] set gx1 [lindex $gbox 2] set gy0 [lindex $gbox 1] set gy1 [lindex $gbox 3] if {$x_or_y == "X"} { set xa [lindex [powGraphToCanvas $gn $x0 $y0 .pow.pow] 0] set xb [lindex [powGraphToCanvas $gn $x1 $y1 .pow.pow] 0] if {($xa < $gx0 && $xb < $gx0) || ($xa > $gx1 && $xb > $gx1)} { #range is entirely off the graph return } if {$xa < $gx0} {set xa $gx0 } if {$xb > $gx1} {set xb $gx1 } set ya $gy0 set yb $gy1 } else { set xa $gx0 set xb $gx1 set ya [lindex [powGraphToCanvas $gn $x1 $y1 .pow.pow] 1] set yb [lindex [powGraphToCanvas $gn $x0 $y0 .pow.pow] 1] if {($ya < $gy0 && $yb < $gy0) || ($ya > $gy1 && $yb > $gy1)} { #range is entirely off the graph return } if {$ya < $gy0} {set ya $gy0 } if {$yb > $gy1} {set yb $gy1 } } .pow.pow addtag $tag enclosed $xa $ya $xb $yb } proc powTagRect { gn x0 y0 x1 y1 tag } { #puts "powTagRect start" if {$x0 > $x1} { set tmp $x0 set x0 $x1 set x1 $tmp } if {$y0 > $y1} { set tmp $y0 set y0 $y1 set y1 $tmp } set ccoords [powGraphToCanvas $gn $x0 $y0 .pow.pow] set xa [lindex $ccoords 0] set yb [lindex $ccoords 1] set ccoords [powGraphToCanvas $gn $x1 $y1 .pow.pow] set xb [lindex $ccoords 0] set ya [lindex $ccoords 1] set gbox [.pow.pow coords ${gn}box] set gx0 [lindex $gbox 0] set gx1 [lindex $gbox 2] set gy0 [lindex $gbox 1] set gy1 [lindex $gbox 3] if {($xa < $gx0 && $xb < $gx0) || ($xa > $gx1 && $xb > $gx1) || \ ($ya < $gy0 && $yb < $gy0) || ($ya > $gy1 && $yb > $gy1)} { #rect is entirely off the displayed graph return } if {$xa < $gx0} {set xa $gx0 } if {$xb > $gx1} {set xb $gx1 } if {$ya < $gy0} {set ya $gy0 } if {$yb > $gy1} {set yb $gy1 } .pow.pow addtag $tag enclosed $xa $ya $xb $yb } proc powDummyRectCallback { gn x0 y0 x1 y1} { #puts "powDummyRectCallback start" puts "You have selected the rectangle: ( $x0 , $y0 , $x1, $y1) on the graph " } proc powDragRect { {tag highlight} {color red} {callback powDummyRectCallback}} { #puts "powDragRect start" global currgn powRectX0 powRectX1 powRectX0C powRectXC global powRectY0 powRectY1 powRectY0C powRectYC powRectTag powRectColor global powRectCallback powRectSaveBinding set powRectCallback $callback set powRectTag $tag set powRectColor $color set powRectSaveBinding(ButtonPress-1) [bind .pow.pow ] set powRectSaveBinding(B1-Motion) [bind .pow.pow ] set powRectSaveBinding(ButtonRelease-1) [bind .pow.pow ] bind .pow.pow { set gn [powWhereAmI %x %y]; if {$gn == $currgn} { set powRectX0C [.pow.pow canvasx %x]; set powRectY0C [.pow.pow canvasy %y]; set gcoords [powCanvasToGraph $currgn $powRectX0C $powRectY0C .pow.pow]; set powRectX0 [lindex $gcoords 0] set powRectY0 [lindex $gcoords 1] .pow.pow create rectangle $powRectX0C $powRectY0C $powRectX0C $powRectY0C \ -tags Rect -outline $powRectColor } } bind .pow.pow { set gn [powWhereAmI %x %y]; if {$gn == $currgn} { if {![info exists powRectX0C]} { set powRectX0C [.pow.pow canvasx %x]; set powRectX0 [powCanvasToGraph $currgn X $powRectX0C .pow.pow]; set powRectY0C [.pow.pow canvasy %y]; set powRectY0 [powCanvasToGraph $currgn Y $powRectY0C .pow.pow]; } else { .pow.pow delete Rect; } set powRectXC [.pow.pow canvasx %x]; set powRectYC [.pow.pow canvasy %y]; .pow.pow create rectangle $powRectX0C $powRectY0C $powRectXC $powRectYC \ -tags Rect -outline $powRectColor } } bind .pow.pow { if {[info exists powRectX0C]} { set rect_coords [.pow.pow coords Rect] .pow.pow delete Rect set powRectXC [lindex $rect_coords 0] set powRectYC [lindex $rect_coords 1]; set gcoords [powCanvasToGraph $currgn $powRectXC $powRectYC .pow.pow]; set powRectX0 [lindex $gcoords 0] set powRectY0 [lindex $gcoords 1] set powRectXC [lindex $rect_coords 2] set powRectYC [lindex $rect_coords 3]; set gcoords [powCanvasToGraph $currgn $powRectXC $powRectYC .pow.pow] set powRectX1 [lindex $gcoords 0] set powRectY1 [lindex $gcoords 1] powColorRect $currgn $powRectX0 $powRectY0 $powRectX1 $powRectY1 $powRectTag $powRectColor 0; bind .pow.pow \ "$powRectSaveBinding(ButtonPress-1)"; bind .pow.pow \ "$powRectSaveBinding(B1-Motion)"; bind .pow.pow \ "$powRectSaveBinding(ButtonRelease-1)"; $powRectCallback $currgn $powRectX0 $powRectY0 $powRectX1 $powRectY1; } } } proc powColorRect { gn x0 y0 x1 y1 {tag highlight} {color red} {redrawing 0}} { #puts "powColorRect start" global powGraphsTagRectList powTagsColorMap # puts "powColorRect: $gn $x_or_y $x0 $x1 $tag $color $redrawing" if {$x0 > $x1} { set tmp $x0 set x0 $x1 set x1 $tmp } if {!$redrawing} { set powTagsColorMap($tag) $color lappend powGraphsTagRectList($gn) "$x0 $y0 $x1 $y1 $tag" } powTagRect $gn $x0 $y0 $x1 $y1 $tag # Unless someone can come up with a good reason, powColorRect doesn't follow # linked axes because it's unclear what to do with the unlinked axis .pow.pow itemconfigure $tag -fill $color } proc powColorbar { } { global currimg currgn powResizeMain global powPlotParam powImageParam global powFitsHeader powFitsHeaderCnt powWCS xCount yCount global powWCSList powWCSLabel powWCSName if { [regexp {_colorbar$} $currgn] } { tk_messageBox -icon warning \ -message "Cannot create colorbar of\nanother colorbar" \ -parent .pow -title "Colorbar Warning" -type ok return } if { ![info exists currimg] || $currimg == "" } { tk_messageBox -icon warning \ -message "Select an image first." \ -parent .pow -title "Colorbar Warning" -type ok return } set saveimg $currimg set savegn $currgn if {[.pow.pow find withtag ${currimg}disp${currgn}] == ""} { puts "Your selected image must be on the selected graph to make a colorbar" return } set colorbarGn ${currgn}_colorbar set colorbarImg ${currimg}_colorbar set width 2048.0 set min $powImageParam(RBmin${currimg},$currgn) set max $powImageParam(RBmax${currimg},$currgn) set width [expr $max - $min] if { $min==$max } { if { $min==0.0 } { set min -1 set max 1 } else { set min [expr $min-abs(0.1*$min)] set max [expr $max+abs(0.1*$max)] } } set increment [expr ($max - $min) / ($width-1)] set x $min for {set j 0} {$j < $width} {incr j} { lappend color_list $x set x [expr $x + $increment] } powCreateDataFromList $colorbarImg $color_list set zunits [powGetImageUnits $currimg Z] set powPlotParam(zoomed,$colorbarImg) 0 set powWCS($colorbarImg) {{0.0 0.0} {0.0 0.0} {1.0 -0.0 0.0 1.0} {{} {}} {{} {}}} set powPlotParam(graphType,$colorbarImg) "image" set powFitsHeader($colorbarImg) "" set powFitsHeaderCnt($colorbarImg) 0 set xCount($colorbarImg) 0 set yCount($colorbarImg) 0 set powPlotParam(zoomed,${colorbarImg}scope) 0 set powWCS(${colorbarImg}scope) {{0.0 0.0} {0.0 0.0} {1.0 -0.0 0.0 1.0} {{} {}} {{} {}}} set powPlotParam(graphType,${colorbarImg}scope) "image" set powFitsHeader(${colorbarImg}scope) "" set powFitsHeaderCnt(${colorbarImg}scope) 0 set xCount(${colorbarImg}scope) 0 set yCount(${colorbarImg}scope) 0 set powWCSName($colorbarImg) 0 powCreateImage $colorbarImg $colorbarImg 0 0 \ [expr int($width)] 1 $min $increment 0.5 1.0 \ $zunits " " $zunits if [info exists powWCSList($colorbarImg)] { foreach name [lindex $powWCSList($colorbarImg) 1] { $fFile assembleWcsLabel $colorbarImg $name } } else { set powWCSList($colorbarImg) {} lappend powWCSList($colorbarImg) 1 lappend powWCSList($colorbarImg) {} } set powWCSList(${colorbarImg}scope) $powWCSList($colorbarImg) set powPlotParam(xo,$colorbarGn) [lindex [.pow.pow bbox ${savegn}box] 0] set powPlotParam(yo,$colorbarGn) \ [expr 20 + [lindex [.pow.pow bbox $savegn] 3] ] set powPlotParam(Colorbar${colorbarImg},$colorbarGn) ${currimg}disp${currgn} set powPlotParam(FixedAspect,$colorbarGn) No set powPlotParam(FixedAspect,${colorbarGn}scope) No set powPlotParam(handletext,$colorbarGn) "$savegn Colorbar" set powPlotParam(handleposition,$colorbarGn) bl set powPlotParam(handleanchor,$colorbarGn) nw set powPlotParam(titleString,$colorbarGn) "$savegn Colorbar" set powPlotParam(titlePosition,$colorbarGn) sw set powPlotParam(titleAnchor,$colorbarGn) nw set powPlotParam(GridLines,$colorbarGn) No set powPlotParam(yTickLength,$colorbarGn) [list 0 0 0 0] set powPlotParam(yLabelTicks,$colorbarGn) [list No No No No] set powPlotParam(zoomed,$colorbarGn) 0 set powPlotParam(graphType,$colorbarGn) "binary" set powFitsHeader($colorbarGn) "" set powFitsHeaderCnt($colorbarGn) 0 set powWCS($colorbarGn) "" set powWCS($colorbarGn) {{0.0 0.0} {0.0 0.0} {1.0 -0.0 0.0 1.0} {{} {}} {{} {}}} set xCount($colorbarGn) 0 set yCount($colorbarGn) 0 powCreateGraph $colorbarGn NULL $colorbarImg $zunits NULL " " " " \ [tagXdim .pow.pow ${currgn}box] 20 powReconfigureToplevel $powResizeMain #reselect original image powSelectGraph $savegn powSelectImage $savegn $saveimg } # axisValues need to contain unique values in ascending order proc powBuildAxisFormat { axisValues axisScale defaultFmt } { #puts "powBuildAxisFormat start" if { [llength $axisValues]<2 } { set axisDiff 0 } else { set axisDiff [expr [lindex $axisValues 1] - [lindex $axisValues 0]] for { set i 2 } { $i<[llength $axisValues] } { incr i } { set j [expr $i-1] set diff [expr [lindex $axisValues $i] - [lindex $axisValues $j]] if { $diff < $axisDiff } { set axisDiff $diff } } } switch $axisScale { "ra" { set labelFmt "%dh" if { $axisDiff==0 } { append labelFmt "%02dm%07.4fs" } else { set axisDiff [expr $axisDiff * 3600.0 / 15.0] if { $axisDiff < 3600.0 } { # Need Minutes append labelFmt "%02dm" if { $axisDiff < 59.99 } { # Need Seconds if { $axisDiff < .99 } { set axisDiffPrec [expr int(-log10($axisDiff)+1)] set axisDiffWidth [expr 3+$axisDiffPrec] append labelFmt "%0${axisDiffWidth}.${axisDiffPrec}fs" } else { append labelFmt "%02.0fs" } } else { append labelFmt "X%02fs" } } else { append labelFmt "X%02dm%02fs" } } } "dec" { set labelFmt "%d:%02d" if { $axisDiff==0 } { append labelFmt ":%07.4f" } else { set axisDiff [expr $axisDiff * 3600.0] if { $axisDiff < 59.99 } { # Need Seconds if { $axisDiff < 0.99 } { set axisDiffPrec [expr int(-log10($axisDiff)+1)] set axisDiffWidth [expr 3+$axisDiffPrec] append labelFmt ":%0${axisDiffWidth}.${axisDiffPrec}f" } else { append labelFmt ":%02.0f" } } else { append labelFmt "X:%02.0f" } } } "log" { set labelFmt $defaultFmt } default { set labelFmt $defaultFmt } } return $labelFmt } # convert a decimal degree to HH MM SS.S # the optional fmtStr needs to have 3 value placeholders (%'s) in h m s order proc powHourRA { deciValue {fmtStr "%dh%02dm%05.2fs"} } { #puts "powHourRA start" #Written by J. Xu if { $deciValue < 0} { set deciValue [expr $deciValue + 360] } set hourValue [expr $deciValue/15.0 + 1e-13] set hour [expr int($hourValue)] set minuValue [expr ($hourValue - $hour)*60.0] set minu [expr int($minuValue)] set scndValue [expr ($minuValue - $minu)*60.0] set scnd $scndValue while {$hour >= 24} {set hour [expr $hour - 24]} while {$hour < 0} {set hour [expr $hour + 24]} # Check if we are rounding seconds to next value set scndFmt [lindex [split $fmtStr %] 3] set scndStr [format %$scndFmt $scnd] if { [regexp {^ *60} $scndStr] } { set scnd 0 incr minu if {$minu == 60} { set minu 0 incr hour if { $hour==24 } { set hour 0 } } } return [format $fmtStr $hour $minu $scnd] } # convert a decimal degree to DD MM SS.S # the optional fmtStr needs to have 3 value placeholders (%'s) in h m s order proc powDegDec { deciValue {fmtStr "%d:%02d:%05.2f"} } { #puts "powDegDec start" #Written by J. Xu if { $deciValue < 0} { set isNeg 1 } else { set isNeg 0 } set deciValue [expr abs($deciValue) + 1e-13] set deg [expr int($deciValue)] while {$deg > 360} {set deg [expr $deg - 360]} while {$deg < -360} {set deg [expr $deg + 360]} set minuValue [expr ($deciValue - $deg)*60.0] set minu [expr int($minuValue)] set scndValue [expr ($minuValue - $minu)*60.0] set scnd $scndValue # Check if we are rounding seconds to next value set scndFmt [lindex [split $fmtStr %] 3] set scndStr [format %$scndFmt $scnd] if { [regexp {^ *60} $scndStr] } { set scnd 0 incr minu if {$minu == 60} { set minu 0 incr deg if { $deg==360 } { set deg 0 } } } if { $isNeg } { return [format "-$fmtStr" $deg $minu $scnd] } else { return [format $fmtStr $deg $minu $scnd] } } proc powSwitch2NewWCSHeader {} { global powFitsHeader powPlotParam powWCSInfo powWCS global currgn coordSel powWCSList powWCSName global powWCSLabel set powPlotParam(wcsName,$currgn) $powPlotParam(wcsName,powDef) set selection $powPlotParam(wcsName,$currgn) set dest "DEFAULT" if { $selection == "WCS" } { set powWCSName($currgn) 0 #set powFitsHeader($currgn) [assembleWcsHeader $currgn] set powWCS($currgn) $powWCSInfo($currgn,DEFAULT) } else { set dest [string toupper [string range $selection 3 end]] set coordList [lindex $powWCSList($currgn) 1] set powWCSName($currgn) "[lsearch -exact $coordList [string toupper $dest]]" #set powFitsHeader($currgn) [assembleWcsHeader $currgn $dest] set powWCS($currgn) $powWCSInfo($currgn,$dest) } if [info exist powWCSName(imgobj_$currgn)] { set powWCSName(imgobj_$currgn) $powWCSName($currgn) set powWCS(imgobj_$currgn) $powWCS($currgn) } # next to initialize the pow wcs structure in C set tokenNew [lindex $powWCSInfo($currgn,$dest) 1] set tokenNewX [lindex $tokenNew 0] set tokenNewY [lindex $tokenNew 1] powResetWcsStructure -g $currgn $tokenNewX $tokenNewY catch { powEndROI 1 } powAdornGraph $currgn .pow.pow powRedrawGraphHandles $currgn powRedrawScopebox } proc assembleWcsHeader { img {selection "default"} } { global powHeaderWcsKeyWord # regular header return [format "%s%s%s" $powHeaderWcsKeyWord($img,NONE) \ $powHeaderWcsKeyWord($img,[string toupper $selection]) \ $powHeaderWcsKeyWord($img,END)] } proc powLoadFitsImage {url imagename} { #puts "powLoadFitsImage start" global powWCS #While POW, technically, should not know anything about FITS files, #loading an image using fitsTcl is *way* too complicated at the moment #so this routine is provided as a public service #This routine takes a url or filename and creates the POW Image object #with the requested name. The POW Data object is available under the #name ${imagename}_data #fitsTcl must be loaded to use this routine and an error will be thrown #if it isn't if {[lsearch [info loaded] *Fitstcl*] == -1} { # error "You must load fitsTcl to use powLoadFitsImage" } #if you're running under Windows or MacOS, you can't use #a URL, just a local file name because cfitsio's network drivers don't work #outside of UNIX. #open the fits file (readonly) if [catch {set infilehandle [fits open $url 0]}] { error "Couldn't open file: $url" } #load the image data into memory set imghandle [$infilehandle load image] #get the dimensions of the image set dims [$infilehandle info imgdim] set n1 [lindex $dims 0] set n2 [lindex $dims 1] #get the data type of the image set data_type [lindex [lindex [$infilehandle get keyword BITPIX] 0] 1] #Now a bit of Voodoo to deal with possible wierd file types: #If the image has BZERO or BSCALE keywords in the header, fitsTcl will #do the appropriate thing with them automatically, but the datatype returned #will be floating point doubles (isn't FITS fun:) if { ([catch {$infilehandle get keyword BZERO}] == 0) || ([catch {$infilehandle get keyword BSCALE}] == 0) } { set data_type 4 } #make a POW DATA object powCreateData ${imagename}_data $imghandle $data_type [expr $n1 * $n2] 0 # powCreateDataFlip ${imagename}_data $imghandle $data_type [expr $n1 * $n2] 1 X $n1 $n2 #make a POW IMAGE object; the units (pixels, intensity) are arbitrary; since #this is a general application, we don't know what they are powCreateImage $imagename ${imagename}_data 0 0 $n1 $n2 0 1 0 1 pixels pixels intensity powCreateGraph $imagename NULL $imagename NULL NULL x_label y_label $n1 $n2 #This will setup POW to use the Astronomical coordinate information #in the file (if there is any) global powWCS #puts "wcsString: $wcsString" if { ! [catch {$infilehandle get imgwcs} wcsString] } { set powWCS($imagename) $wcsString } #we're done reading the file now $infilehandle close } proc powReplotReset {} { #puts "powReplotReset start" global currgn global powPlotParam set powPlotParam(g_magnification,$currgn) 1.0 set powPlotParam(g_multiplier,$currgn) 0.5 powEndROI 1 } proc powSetMagnification {} { #puts "powReplotReset start" global g_magnification global currgn set powPlotParam(g_magnification,$currgn) $g_magnification } proc powExpr { outDataName inputExpression } { #puts "powExpr start" # Make sure fitsTcl is loaded first if {[lsearch [info loaded] *Fitstcl*] == -1} { # Pan Chai: comment out error message # error "You must load fitsTcl to use powExpr" } # Evaluate the expression set res [vexpr -ptr -use powExprGetData $inputExpression] # Create the powData item; have it create its own copy of the data eval powCreateData $outDataName $res 1 # Don't forget to free the pointer returned by vexpr fits free [lindex $res 0] } proc powDeleteMenuBarItem {} { #puts "powDeleteMenuBarItem start" global menuBarDeleteFlag if { $menuBarDeleteFlag == "false" } { # .pow.mbar delete "Zoom" .pow.mbar delete "Replot" set menuBarDeleteFlag "true" } } proc _changeWinDirectoryToUnixFormat { dir } { #puts "_changeWinDirectoryToUnixFormat start" set result "" for { set i 0 } { $i < [string length $dir] } {incr i} { set currentChar [string range $dir $i $i] if { $currentChar == "\\" } { set currentChar "/" } set result [format "%s%s" $result $currentChar] } return $result } ################## # # Button Selection # ################## proc powButtonSelection { wndw1 wndw2 option { saveOp "SAVE" } } { global powLutButton global powROIButton global powbg if { $option == "Left" } { catch { ${wndw1} configure -bg $powbg } catch { ${wndw2} configure -bg yellow } set powLutButton 1 set powROIButton 3 } else { catch { ${wndw1} configure -bg yellow } err catch { ${wndw2} configure -bg $powbg } set powLutButton 3 set powROIButton 1 } if { $saveOp == "SAVE" } { powSaveConfig } } namespace eval powEvents { variable lastEventWndw "" proc generate { evt {evtWndw ""} } { variable lastEventWndw global CpowXRangeY0 # This evtWndw messiness is necessary due to LinuxPPC's (and others?) problems # in tracking the focus when selecting menu items. Can't tell if it is a # Window Manager problem or Tk problem. if { $evt == "<>" } { set whn "now" set lastEventWndw $evtWndw catch { unset CpowXRangeY0 } } else { set whn "tail" } if { $evtWndw=="" } { if { $lastEventWndw=="" } { set evtWndw [focus] } else { set evtWndw $lastEventWndw } } #puts "Evt: $evt in $evtWndw" if { $evtWndw != "" && [winfo exists $evtWndw] } { event generate $evtWndw $evt -when $whn } else { event generate . $evt -when $whn } } proc postMenus { w } { #puts "Posting menus for $w" if { $w == ".pow" } { .pow.mbar.file entryconfig "Close*" -label "Close POW" } else { .pow.mbar.file entryconfig "Close*" -label "Close Window" } } proc ExitPOW { } { set tempList [::powListGraphs] foreach name $tempList { catch { powDeleteGraph $name NOPROMPT} err } set Pow_Done 1 catch { destroy .pow.pow } catch { destroy .pow.scope } catch { event generate .pow <> } } } fv5.5/tcltk/pow/powEdit.tcl0000644000220700000360000025513613224715130014574 0ustar birbylhea########################################################################### # # # Routines for new edit graph motif # # # ########################################################################### proc powEditGraphDlg { gn } { global powbg currgn global powDWP global g_titleFont global powEditPlotParam #puts "powEditGraphDlg gn: <$gn>" set w ${powDWP}gEdit if {[winfo exists $w]} { raise $w focus $w $w.btns.reset invoke return } powToplevel $w .pow "-bg $powbg" bind $w <> "powEditExitDlg" catch {wm title $w "Edit Graph"} label $w.graphCont -text "Graph Contents:" -fg black -bg yellow -font g_titleFont frame $w.graphList -bg $powbg scrollbar $w.graphList.scrolly -orient vertical -takefocus 0\ -command {${powDWP}gEdit.graphList.lst yview} -bg $powbg listbox $w.graphList.lst -bg $powbg -width 25 -height 6 \ -selectmode browse -exportselection 0 -takefocus 0 \ -yscrollcommand "$w.graphList.scrolly set " -font g_titleFont bind $w.graphList.lst \ { powEditBuildOptions } grid $w.graphList.lst -in $w.graphList \ -row 1 -column 1 -sticky news grid $w.graphList.scrolly -in $w.graphList \ -row 1 -column 2 -sticky news grid rowconfigure $w.graphList 1 -weight 1 grid columnconfigure $w.graphList 1 -weight 1 label $w.elemCont -text "Available Objects:" \ -fg black -bg yellow -font g_titleFont frame $w.elemList -bg $powbg scrollbar $w.elemList.scrolly -orient vertical -takefocus 0 \ -command {${powDWP}gEdit.elemList.lst yview} -bg $powbg listbox $w.elemList.lst -bg $powbg -width 25 -height 6 \ -selectmode browse -exportselection 0 -takefocus 0 \ -yscrollcommand "$w.elemList.scrolly set " -font g_titleFont grid $w.elemList.lst -row 1 -column 1 -sticky news grid $w.elemList.scrolly -row 1 -column 2 -sticky news grid rowconfigure $w.elemList 1 -weight 1 grid columnconfigure $w.elemList 1 -weight 1 button $w.help -bg $powbg -text "Help" \ -command {powHelp EditGraphs.html} -takefocus 0 -font g_titleFont grid $w.graphCont -row 1 -column 1 -sticky w -padx 5 -pady 5 grid $w.graphList -row 2 -column 1 -sticky news grid $w.help -row 1 -column 2 grid $w.elemCont -row 1 -column 3 -sticky w -padx 5 -pady 5 grid $w.elemList -row 2 -column 3 -sticky news frame $w.elemButt -bg $powbg button $w.elemButt.add -text "<-- Add" -bg $powbg -takefocus 0 \ -command {powEditAddElems} -font g_titleFont button $w.elemButt.remove -text "--> Remove" -bg $powbg -takefocus 0 \ -command {powEditRemoveElems} -font g_titleFont pack $w.elemButt.add -fill x -padx 5 -pady 2 pack $w.elemButt.remove -fill x -padx 5 -pady 2 grid $w.elemButt -row 2 -column 2 button $w.editObj -text "Edit Objects" -bg $powbg -takefocus 0 \ -command {powEditObjectDlg} -font g_titleFont grid $w.editObj -row 3 -column 3 -padx 5 -pady 5 frame $w.btns -bg $powbg button $w.btns.apply -text "Apply" -bg $powbg \ -command { powEditApplyToGraph } -font g_titleFont button $w.btns.reset -text "Reset" -bg $powbg \ -command { powEditResetDialog } -font g_titleFont button $w.btns.exit -text "Exit" -bg $powbg \ -command "powEditExitDlg" -font g_titleFont pack $w.btns.apply -side left -padx 5 -pady 2 pack $w.btns.reset -side left -padx 5 -pady 2 pack $w.btns.exit -side left -padx 5 -pady 2 grid $w.btns -row 6 -column 1 -columnspan 3 -pady 5 grid rowconfigure $w 2 -weight 1 grid rowconfigure $w 5 -weight 1 grid columnconfigure $w 1 -weight 1 grid columnconfigure $w 3 -weight 1 powEditResetDialog init } proc powEditExitDlg { } { global powDWP destroy ${powDWP}gEdit } proc powEditApplyToGraph { } { global powEditGraphName powPlotParam powEditGraphName global powLutButton powROIButton powEditUpdateVariables set gn $powEditGraphName powEraseGraph $gn 1 powCreateGraph $gn $powPlotParam(curves,$gn) $powPlotParam(images,$gn) \ $powPlotParam(xunits,$gn) $powPlotParam(yunits,$gn) \ $powPlotParam(xlabel,$gn) $powPlotParam(ylabel,$gn) \ $powPlotParam(xdimdisp,$gn) $powPlotParam(ydimdisp,$gn) \ $powPlotParam(xBot,$gn) $powPlotParam(yBot,$gn) \ $powPlotParam(xTop,$gn) $powPlotParam(yTop,$gn) # this is for Mouse. Will not be saved in POW preference event delete <> event delete <> event delete <> event delete <> event delete <> event delete <> event add <> event add <> event add <> event add <> if { $powROIButton != 0 && $powROIButton != "NULL" } { # Must delete BtnPress sequence to prevent it from hiding the ROI event event delete <> event add <> event add <> } } proc powEditResetDialog { {flag "reset" }} { global currgn powDWP powEditGraphName powEditPlotParam powPlotParam #puts "powEditResetDialog: currgn: $currgn" set xdimdisp $powPlotParam(xdimdisp,powDef) set ydimdisp $powPlotParam(ydimdisp,powDef) if { [info exists powEditPlotParam(xdimdisp,new)] && $flag == "init" } { set xdimdisp $powEditPlotParam(xdimdisp,new) set ydimdisp $powEditPlotParam(ydimdisp,new) } if { [winfo exists ${powDWP}gEdit] } { set powEditGraphName $currgn # -------> FIX of selection of current graph powEditInitVariables init #set powEditPlotParam(xdimdisp,new) $xdimdisp #set powEditPlotParam(ydimdisp,new) $ydimdisp if { $currgn=="powDef" } { set powEditGraphName [powEditCreateNewGraphName] } powEditBuildOptions } } proc powEditCreateNewGraphName { } { set i 1 set gn "powGraph_$i" while { [powListGraphs $gn] } { incr i set gn "powGraph_$i" } return $gn } proc powEditCreateNewGraph { gn } { global powPlotParam powEditGraphName global powWCS powFitsHeader powFitsHeaderCnt xCount yCount if { $gn!="" } { set powEditGraphName $gn } else { set powEditGraphName "powDef" } powEditInitVariables set powEditGraphName [powEditCreateNewGraphName] set powWCS($powEditGraphName) $powWCS($gn) set powFitsHeader($powEditGraphName) $powFitsHeader($gn) set powFitsHeaderCnt($powEditGraphName) $powFitsHeaderCnt($gn) set powWCS(${powEditGraphName}scope) $powWCS($gn) set powFitsHeader(${powEditGraphName}scope) $powFitsHeader($gn) set powFitsHeaderCnt(${powEditGraphName}scope) $powFitsHeaderCnt($gn) set xCount($powEditGraphName) 0 set yCount($powEditGraphName) 0 set xCount(${powEditGraphName}scope) 0 set yCount(${powEditGraphName}scope) 0 powEditApplyToGraph } proc powEditSelectPage { p } { global powDWP set note ${powDWP}gEdit.nBook Notebook:raise $note $p } ######################################################################## # # Build Option Pages # ######################################################################## proc powEditBuildOptions { } { global powDWP powbg set note ${powDWP}gEdit.nBook if { ![winfo exists $note] } { Notebook:create $note -pages {Graph Fonts Ticks Points Lines Image} \ -pad 4 -bg $powbg grid $note -in ${powDWP}gEdit -row 5 -column 1 \ -padx 15 -pady 0 -columnspan 3 -sticky nwes } set w [Notebook:frame $note Graph] powEditBuildGraphOptions $w set w [Notebook:frame $note Fonts] powEditBuildFontOptions $w set w [Notebook:frame $note Ticks] powEditBuildTickOptions $w set w [Notebook:frame $note Points] set itemNo [${powDWP}gEdit.graphList.lst curselection] #puts "itemNo: $itemNo" if { $itemNo == "" } { set item "none none" } else { set item [${powDWP}gEdit.graphList.lst get $itemNo] } foreach {name type} [split $item { }] {} if { $type == "(curve)" } { powEditBuildCurveOptions1 $w $name set w [Notebook:frame $note Lines] powEditBuildCurveOptions2 $w $name } else { powEditBuildEmptyOptions $w "Curve Not Selected" set w [Notebook:frame $note Lines] powEditBuildEmptyOptions $w "Curve Not Selected" } set w [Notebook:frame $note Image] if { $type == "(image)" } { powEditBuildImageOptions $w $name } else { powEditBuildEmptyOptions $w "Image Not Selected" } Notebook:resize $note } ################## # # Setup Page: Empty # ################## proc powEditBuildEmptyOptions { frame str } { global powbg global g_titleFont if {[winfo exists $frame]} { foreach i [winfo children $frame] { destroy $i } } else { frame $frame -bg $powbg } label $frame.lab -bg $powbg -text $str -font g_titleFont # Use pack instead of grid to destroy any pre-existing grid # configuration from nonEmpty frames pack $frame.lab -side top -fill both -anchor center -expand 1 } ################## # # Setup Page: POW # ################## proc powEditBuildPOWOptions { frame } { global powEditAppParam powbg global g_titleFont if {[winfo exists $frame]} { foreach i [winfo children $frame] { destroy $i } } else { frame $frame -bg $powbg } set row 1 grid rowconfigure $frame $row -minsize 5 incr row # Setup POW Application Options # # Cursor: # label $frame.cursor -bg $powbg -text "Cursor:" -font g_titleFont grid $frame.cursor -row $row -column 2 -sticky ne set col 3 foreach [list lab val] [list "Cross Hairs" crosshair \ "Left Arrow" top_left_arrow "Right Arrow" right_ptr \ "Gumby" gumby "Star Trek" trek] { if {$col==6} {set col 3; incr row} radiobutton $frame.cStyle$val -bg $powbg -text $lab \ -variable powEditAppParam(cursor,new) -value $val \ -highlightthickness 0 -takefocus 0 \ -command "$frame configure -cursor $val" -font g_titleFont grid $frame.cStyle$val -row $row -column $col -sticky nw -padx 4 incr col } incr row grid rowconfigure $frame $row -minsize 7 incr row # # GUI position: # label $frame.gui -bg $powbg -text "GUI Position:" -font g_titleFont grid $frame.gui -row $row -column 2 -sticky ne set col 3 foreach [list lab val] [list Top top Left left Right right Bottom bottom \ "Hidden" none] { if {$col==6} {set col 3; incr row} radiobutton $frame.gPos$val -bg $powbg -text $lab \ -variable powEditAppParam(GUIposition,new) -value $val \ -highlightthickness 0 -takefocus 0 -font g_titleFont grid $frame.gPos$val -row $row -column $col -sticky nw -padx 4 incr col } incr row grid rowconfigure $frame $row -minsize 7 incr row # # Scopebox Size: # label $frame.scope -bg $powbg -text "Scopebox Size:" -font g_titleFont grid $frame.scope -row $row -column 2 -sticky ne set col 3 foreach [list lab val] [list None [list 0 0] 100x100 [list 100 100] 150x150 [list 150 150]\ 200x200 [list 200 200] ] { if {$col==6} {set col 3; incr row} radiobutton $frame.sb$lab -bg $powbg -text $lab \ -variable powEditAppParam(ScopeSize,new) -value $val \ -highlightthickness 0 -takefocus 0 -font g_titleFont grid $frame.sb$lab -row $row -column $col -sticky nw -padx 4 incr col } incr row grid rowconfigure $frame $row -minsize 7 incr row # # Resize Main: # label $frame.rszMain -bg $powbg -text "Resize Window:" -font g_titleFont grid $frame.rszMain -row $row -column 2 -sticky ne set col 3 foreach [list lab val] [list "To Fit Contents" 1 "Never" 0] { if {$col==6} {set col 3; incr row} radiobutton $frame.rs$val -bg $powbg -text $lab \ -variable powEditAppParam(ResizeMain,new) -value $val \ -highlightthickness 0 -takefocus 0 -font g_titleFont grid $frame.rs$val -row $row -column $col -sticky nw -padx 4 incr col } incr row grid rowconfigure $frame $row -minsize 7 incr row # # Background Color: # label $frame.bg -bg $powbg -text "Background Color:" -font g_titleFont grid $frame.bg -row $row -column 2 -sticky e powColorFrame $frame.bgColors powEditAppParam(bg,new) grid $frame.bgColors -row $row -column 3 -columnspan 3 \ -sticky w -padx 8 incr row grid rowconfigure $frame $row -minsize 7 incr row grid columnconfigure $frame 0 -minsize 5 grid columnconfigure $frame [list 3 4 5 6] -weight 1 } ################## # # Setup Page: Graph # ################## proc powEditBuildGraphOptions { frame } { global powbg powEditPlotParam powEditCurveParam powEditGraphName global powPlotParam global currgn global g_titleFont global powLutButton global powROIButton global buttonWndw global buttonSelection if {[winfo exists $frame]} { foreach i [winfo children $frame] { destroy $i } } else { frame $frame -bg $powbg } set buttonWndw $frame set row 1 grid rowconfigure $frame $row -minsize 5 incr row if { $powEditGraphName != "powDef" } { # Don't do this if we are editting defaults... # ... these data are not relvnt label $frame.title -bg $powbg -text "Graph Title:" -font g_titleFont entry $frame.etitle -bg $powbg \ -textvariable powEditPlotParam(titleString,new) -takefocus 1 -font g_titleFont grid $frame.title -in $frame -row $row -column 1 -sticky e \ -padx 5 grid $frame.etitle -in $frame -row $row -column 2 -sticky ew \ -padx 5 -columnspan 2 incr row grid rowconfigure $frame $row -minsize 5 incr row } # Setup Bbox options label $frame.x -bg $powbg -text "X Axis" -font g_titleFont label $frame.y -bg $powbg -text "Y Axis" -font g_titleFont grid $frame.x -in $frame -row $row -column 2 -sticky ew grid $frame.y -in $frame -row $row -column 3 -sticky ew incr row if { $powEditGraphName == "powDef" } { set labelsAndValues [list Size: dimdisp] } else { # Don't do this if we are editting defaults... # ... these data are not relvnt set labelsAndValues [list Label: label Min: Bot Max: Top \ Units: units Size: dimdisp ] } if { $powEditGraphName != "powDef" } { foreach {lbl val} $labelsAndValues { label $frame.l$val -bg $powbg -text $lbl -font g_titleFont entry $frame.ex$val -bg $powbg \ -textvariable powEditPlotParam(x$val,new) -takefocus 1 -font g_titleFont entry $frame.ey$val -bg $powbg \ -textvariable powEditPlotParam(y$val,new) -takefocus 1 -font g_titleFont grid $frame.l$val -in $frame -row $row -column 1 -sticky e \ -padx 5 grid $frame.ex$val -in $frame -row $row -column 2 -sticky w \ -padx 5 grid $frame.ey$val -in $frame -row $row -column 3 -sticky w \ -padx 5 incr row } } # Axis Scaling label $frame.tickScale -bg $powbg -text "Scaling:" -font g_titleFont grid $frame.tickScale -in $frame -row $row -column 1 -sticky ne -padx 5 frame $frame.scaleX -bg $powbg frame $frame.scaleY -bg $powbg radiobutton $frame.scaleX.log -bg $powbg -text Log \ -variable powEditPlotParam(xTickScal,new) -value log \ -highlightthickness 0 -takefocus 0 -font g_titleFont radiobutton $frame.scaleX.lin -bg $powbg -text Linear \ -variable powEditPlotParam(xTickScal,new) -value linear \ -highlightthickness 0 -takefocus 0 -font g_titleFont radiobutton $frame.scaleY.log -bg $powbg -text Log \ -variable powEditPlotParam(yTickScal,new) -value log \ -highlightthickness 0 -takefocus 0 -font g_titleFont radiobutton $frame.scaleY.lin -bg $powbg -text Linear \ -variable powEditPlotParam(yTickScal,new) -value linear \ -highlightthickness 0 -takefocus 0 -font g_titleFont pack $frame.scaleX.lin -padx 5 -side left -anchor w pack $frame.scaleX.log -padx 5 -side left -anchor w pack $frame.scaleY.lin -padx 5 -side left -anchor w pack $frame.scaleY.log -padx 5 -side left -anchor w grid $frame.scaleX -row $row -column 2 -sticky we -padx 5 grid $frame.scaleY -row $row -column 3 -sticky we -padx 5 incr row label $frame.mouse -bg $powbg -text "Mouse:" -font g_titleFont grid $frame.mouse -in $frame -row $row -column 1 -sticky ne -padx 5 frame $frame.buttonSelection -bg $powbg set buttonWndw $frame.buttonSelection radiobutton $frame.buttonSelection.leftZoom \ -font g_titleFont \ -text "Normal: left zoom, right brightnesss/contrast" \ -variable buttonSelection -value leftZoom \ -command {powButtonSelection ${buttonWndw}.leftZoom ${buttonWndw}.leftBright Right DONT_SAVE} radiobutton $frame.buttonSelection.leftBright \ -font g_titleFont \ -text "Reversed: left brightnesss/contrast, right zoom" \ -variable buttonSelection -value leftBright \ -command {powButtonSelection ${buttonWndw}.leftZoom ${buttonWndw}.leftBright Left DONT_SAVE} grid $frame.buttonSelection.leftZoom -row 0 -column 1 -sticky w -padx 5 grid $frame.buttonSelection.leftBright -row 1 -column 1 -sticky w -padx 5 grid $frame.buttonSelection -row $row -column 2 -sticky w -padx 5 -rowspan 3 -columnspan 2 grid rowconfigure $frame $row -minsize 5 incr row 3 if { $powLutButton == 3 } { $frame.buttonSelection.leftZoom select powButtonSelection ${buttonWndw}.leftZoom ${buttonWndw}.leftBright Right DONT_SAVE } else { $frame.buttonSelection.leftBright select powButtonSelection ${buttonWndw}.leftZoom ${buttonWndw}.leftBright Left DONT_SAVE } if { $powEditGraphName != "powDef" } { # Don't do this if we are editting defaults... # ... these data are not relvnt checkbutton $frame.scaleData -bg $powbg -text "Scale curve data to axes" \ -variable powEditPlotParam(scalData,new) -onvalue Yes -offvalue No \ -highlightthickness 0 -takefocus 0 -font g_titleFont grid $frame.scaleData -row $row -column 2 -columnspan 2 -sticky we -padx 5 incr row grid rowconfigure $frame $row -minsize 7 incr row } # Reset Button if { $powEditGraphName != "powDef" } { # Don't do this if we are editting defaults... # ... these data are not relvnt button $frame.reset -bg $powbg -text "Reset Min/Max" -takefocus 0 \ -command { foreach par [list xBot yBot xTop yTop] { set powEditPlotParam($par,new) NULL } } -font g_titleFont grid $frame.reset -in $frame -row $row -column 2 \ -columnspan 2 -sticky {} -padx 5 -pady 5 incr row } grid rowconfigure $frame $row -minsize 5 incr row grid columnconfigure $frame [list 0 4] -weight 1 -minsize 5 } ################## # # Setup Page: Fonts # ################## proc powEditBuildFontOptions { frame } { global powbg powEditFontParam powEditGraphName powFontParam global g_titleFont if {[winfo exists $frame]} { foreach i [winfo children $frame] { destroy $i } } else { frame $frame -bg $powbg } set row 1 grid rowconfigure $frame $row -minsize 5 incr row label $frame.family -text "Font Family" -bg $powbg -font g_titleFont label $frame.size -text "Size (pt)" -bg $powbg -font g_titleFont label $frame.style -text "Style" -bg $powbg -font g_titleFont label $frame.color -text "Color" -bg $powbg -font g_titleFont grid $frame.family -row $row -column 2 -sticky s grid $frame.size -row $row -column 3 -sticky s grid $frame.style -row $row -column 4 -sticky s -columnspan 2 grid $frame.color -row $row -column 6 -sticky s incr row grid rowconfigure $frame $row -minsize 5 incr row foreach {tLbl lbl} [list \ "Title:" title "Axis Labels:" axis \ "Tick Labels:" tick "Text Labels:" note] { label $frame.lbl$lbl -text $tLbl -bg $powbg -font g_titleFont checkbutton $frame.bld$lbl -text Bold -onvalue bold -offvalue normal \ -bg $powbg -variable powEditFontParam(${lbl}Weight,new) \ -highlightthickness 0 -font g_titleFont checkbutton $frame.itl$lbl -text Italic -onvalue italic -offvalue roman \ -bg $powbg -variable powEditFontParam(${lbl}Slant,new) \ -highlightthickness 0 -font g_titleFont set mnu [eval tk_optionMenu $frame.fnt$lbl \ powEditFontParam(${lbl}Font,new) $powFontParam(allFonts,powDef)] $frame.fnt$lbl configure -bg $powbg -highlightthickness 0 -width 20 -font g_titleFont $mnu configure -bg $powbg -font g_titleFont set mnu [tk_optionMenu $frame.siz$lbl powEditFontParam(${lbl}Size,new) \ 7 9 12 14 16 18 24 32 40] $frame.siz$lbl configure -bg $powbg -highlightthickness 0 -width 3 -font g_titleFont $mnu configure -bg $powbg -font g_titleFont button $frame.clr$lbl -textvariable powEditFontParam(${lbl}Color,new) \ -bg $powbg -highlightthickness 0 -width 7 \ -command "powSelectColor powEditFontParam(${lbl}Color,new)" -font g_titleFont grid $frame.lbl$lbl -row $row -column 1 -padx 3 -sticky e grid $frame.fnt$lbl -row $row -column 2 -padx 3 grid $frame.siz$lbl -row $row -column 3 -padx 3 grid $frame.bld$lbl -row $row -column 4 -padx 3 grid $frame.itl$lbl -row $row -column 5 -padx 3 grid $frame.clr$lbl -row $row -column 6 -padx 3 incr row grid rowconfigure $frame $row -minsize 5 incr row } } ################## # # Setup Page: Tick # ################## proc powEditBuildTickOptions { frame } { global powbg powEditPlotParam global g_titleFont if {[winfo exists $frame]} { foreach i [winfo children $frame] { destroy $i } } else { frame $frame -bg $powbg } set row 1 grid rowconfigure $frame $row -minsize 5 incr row # Setup Tick Options label $frame.nXTicks -bg $powbg -text "# of X Ticks:" -font g_titleFont grid $frame.nXTicks -in $frame -row $row -column 2 -sticky ne frame $frame.xTickSlide -bg $powbg label $frame.xTickSlide.few -text "None" -bg $powbg -font g_titleFont label $frame.xTickSlide.lots -text "Many" -bg $powbg -font g_titleFont scale $frame.xTickSlide.slide -from 0 -to 12 \ -orient horizontal -variable powEditPlotParam(xNumTicks,new) \ -highlightbackground $powbg -bg $powbg \ -showvalue 0 -takefocus 0 -font g_titleFont pack $frame.xTickSlide.few -in $frame.xTickSlide -side left pack $frame.xTickSlide.slide -in $frame.xTickSlide -side left \ -expand 1 -fill x pack $frame.xTickSlide.lots -in $frame.xTickSlide -side right grid $frame.xTickSlide -in $frame -row $row -column 3 -columnspan 3 \ -sticky ew -padx 5 incr row label $frame.nYTicks -bg $powbg -text "# of Y Ticks:" -font g_titleFont grid $frame.nYTicks -in $frame -row $row -column 2 -sticky ne frame $frame.yTickSlide -bg $powbg label $frame.yTickSlide.few -text "None" -bg $powbg -font g_titleFont label $frame.yTickSlide.lots -text "Many" -bg $powbg -font g_titleFont scale $frame.yTickSlide.slide -from 0 -to 12 \ -orient horizontal -variable powEditPlotParam(yNumTicks,new) \ -highlightbackground $powbg -bg $powbg \ -showvalue 0 -takefocus 0 -font g_titleFont pack $frame.yTickSlide.few -in $frame.yTickSlide -side left pack $frame.yTickSlide.slide -in $frame.yTickSlide -side left \ -expand 1 -fill x pack $frame.yTickSlide.lots -in $frame.yTickSlide -side right grid $frame.yTickSlide -in $frame -row $row -column 3 -columnspan 3 \ -sticky ew -padx 5 incr row label $frame.xTicks -bg $powbg -text "X Ticks:" -font g_titleFont grid $frame.xTicks -in $frame -row $row -column 2 -sticky ne frame $frame.xTickButt -bg $powbg radiobutton $frame.xTickButt.in -bg $powbg -text In \ -variable powEditPlotParam(xTickLength,new) \ -value [list -10 -10 -10 -10] \ -highlightthickness 0 -takefocus 0 -font g_titleFont radiobutton $frame.xTickButt.out -bg $powbg -text Out \ -variable powEditPlotParam(xTickLength,new) \ -value [list 10 10 10 10] \ -highlightthickness 0 -takefocus 0 -font g_titleFont checkbutton $frame.xTickButt.lab -bg $powbg -text "Labeled?"\ -variable powEditPlotParam(xLabelTicks,new) \ -onvalue [list Yes No No Yes] \ -offvalue [list No No No No] \ -highlightthickness 0 -takefocus 0 -font g_titleFont pack $frame.xTickButt.in -side left -padx 4 pack $frame.xTickButt.out -side left -padx 4 pack $frame.xTickButt.lab -side left -padx 20 grid $frame.xTickButt -row $row -column 3 -sticky w -padx 0 -columnspan 3 incr row label $frame.yTicks -bg $powbg -text "Y Ticks:" -font g_titleFont grid $frame.yTicks -in $frame -row $row -column 2 -sticky ne frame $frame.yTickButt -bg $powbg radiobutton $frame.yTickButt.in -bg $powbg -text In \ -variable powEditPlotParam(yTickLength,new) \ -value [list -10 -10 -10 -10] \ -highlightthickness 0 -takefocus 0 -font g_titleFont radiobutton $frame.yTickButt.out -bg $powbg -text Out \ -variable powEditPlotParam(yTickLength,new) \ -value [list 10 10 10 10] \ -highlightthickness 0 -takefocus 0 -font g_titleFont checkbutton $frame.yTickButt.lab -bg $powbg -text "Labeled?"\ -variable powEditPlotParam(yLabelTicks,new) \ -onvalue [list Yes No No Yes] \ -offvalue [list No No No No] \ -highlightthickness 0 -takefocus 0 -font g_titleFont pack $frame.yTickButt.in -side left -padx 4 pack $frame.yTickButt.out -side left -padx 4 pack $frame.yTickButt.lab -side left -padx 20 grid $frame.yTickButt -row $row -column 3 -sticky w -padx 0 -columnspan 3 incr row # Tick Labeling label $frame.tickLabel -bg $powbg -text "Tick Labels:" -font g_titleFont grid $frame.tickLabel -in $frame -row $row -column 2 -sticky ne set col 3 foreach {lab val} [list Decimal decimal "Base 60 (deg)" degrees] { if {$col==5} {set col 3; incr row} radiobutton $frame.label$val -bg $powbg -text $lab \ -variable powEditPlotParam(tickLabels,new) -value $val \ -highlightthickness 0 -takefocus 0 -font g_titleFont grid $frame.label$val -in $frame \ -row $row -column $col -sticky nw -padx 5 incr col } incr row grid rowconfigure $frame $row -minsize 7 incr row # Add a separator line frame $frame.sep -bg $powbg -relief ridge -height 2 -bd 2 grid $frame.sep -row $row -column 3 -columnspan 3 -sticky ew grid rowconfigure $frame $row -minsize 10 -weight 1 incr row # Setup Grid Options checkbutton $frame.grid -bg $powbg -text "Grid Lines -" \ -variable powEditPlotParam(GridLines,new) \ -highlightthickness 0 -onvalue Yes -offvalue No -font g_titleFont grid $frame.grid -in $frame -row $row -column 1 -sticky w -columnspan 6 incr row # Line Style label $frame.style -bg $powbg -text "Style:" -font g_titleFont grid $frame.style -in $frame -row $row -column 2 -sticky ne set col 3 foreach {style val} \ {Solid " " "Sm Dash" 10 "Lg Dash" 20 \ "Dotted" "4 4" "Dot Dash" "15 10 4 10"} { regsub -all { } $style {_} cln if {$col==6} {set col 3; incr row} radiobutton $frame.lStyle$cln -bg $powbg -text $style \ -variable powEditPlotParam(GridDash,new) -value $val \ -highlightthickness 0 -takefocus 0 -font g_titleFont grid $frame.lStyle$cln -in $frame \ -row $row -column $col -sticky nw -padx 4 incr col } incr row grid rowconfigure $frame $row -minsize 7 incr row # Color label $frame.gridColor -bg $powbg -text "Color:" -font g_titleFont grid $frame.gridColor -in $frame -row $row -column 2 -sticky e powColorFrame $frame.gColors powEditPlotParam(GridColor,new) grid $frame.gColors -in $frame -row $row -column 3 -columnspan 3 \ -sticky w -padx 8 incr row grid rowconfigure $frame $row -minsize 5 incr row grid columnconfigure $frame 0 -minsize 5 grid columnconfigure $frame [list 3 4 5 6] -weight 1 } ################## # # Setup Page: Points # ################## proc powEditBuildCurveOptions1 { frame curve } { global powbg powEditCurveParam global g_titleFont # If frame already exists delete its contents if {[winfo exists $frame]} { foreach i [winfo children $frame] { destroy $i } } else { frame $frame -bg $powbg } # Set default values if not defined for this curve #puts "call powEditCurveDefOptions 1" powEditCurveDefOptions $curve # Build widgets set row 1 grid rowconfigure $frame $row -minsize 5 incr row # # Setup Points Options # # Point Display checkbutton $frame.pDisp -bg $powbg -text "Points -" \ -variable powEditCurveParam(pDisp${curve},new) \ -highlightthickness 0 -onvalue Yes -offvalue No -font g_titleFont grid $frame.pDisp -in $frame -row $row -column 1 -sticky w -columnspan 2 incr row grid rowconfigure $frame $row -minsize 10 incr row # Shape label $frame.shape -bg $powbg -text "Shape:" -font g_titleFont grid $frame.shape -in $frame -row $row -column 2 -sticky ne set col 3 set cnt 1 foreach shape {Dot Cross Diamond Box Octagon Triangle "Inv. Triangle"} { if {$col>=7} {set col 3; incr row} radiobutton $frame.pShape$cnt -bg $powbg -text $shape \ -variable powEditCurveParam(pShape${curve},new) -value $shape \ -highlightthickness 0 -takefocus 0 -font g_titleFont grid $frame.pShape$cnt -in $frame \ -row $row -column $col -sticky nw -padx 4 if { $shape=="Inv. Triangle" } { grid configure $frame.pShape$cnt -columnspan 2 incr col } incr col incr cnt } incr row grid rowconfigure $frame $row -minsize 7 incr row # Size label $frame.size -bg $powbg -text "Size:" -font g_titleFont grid $frame.size -in $frame -row $row -column 2 -sticky ne frame $frame.pSize -bg $powbg radiobutton $frame.pSize.fixed -bg $powbg -text "Fixed... " \ -variable powEditCurveParam(pSizeErr${curve},new) -value No \ -highlightthickness 0 -takefocus 0 -font g_titleFont label $frame.pSize.text -bg $powbg -width 2 \ -textvariable powEditCurveParam(pSize${curve},new) -font g_titleFont label $frame.pSize.pt -bg $powbg -width 2 -text pt -font g_titleFont scale $frame.pSize.slide -from 2 -to 12 -orient horizontal \ -variable powEditCurveParam(pSize${curve},new) \ -highlightbackground $powbg -bg $powbg \ -showvalue 0 -takefocus 0 -font g_titleFont grid $frame.pSize.fixed -in $frame.pSize -row 1 -column 1 -sticky nw -padx 3 grid $frame.pSize.text -in $frame.pSize -row 1 -column 2 -sticky ne grid $frame.pSize.pt -in $frame.pSize -row 1 -column 3 -sticky nw grid $frame.pSize.slide -in $frame.pSize -row 1 -column 4 -sticky new \ -padx 4 grid columnconfigure $frame.pSize 4 -weight 1 grid $frame.pSize -in $frame -row $row -column 3 -columnspan 3 \ -sticky new incr row radiobutton $frame.pSizeError -bg $powbg -text Errorbars \ -variable powEditCurveParam(pSizeErr${curve},new) -value Yes \ -highlightthickness 0 -takefocus 0 -font g_titleFont grid $frame.pSizeError -in $frame \ -row $row -column 3 -sticky nw -padx 4 incr row grid rowconfigure $frame $row -minsize 7 incr row # Point Filling label $frame.fill -bg $powbg -text "Fill:" -font g_titleFont grid $frame.fill -in $frame -row $row -column 2 -sticky ne set col 3 foreach {lab val} {Yes Yes No No} { if {$col==7} {set col 3; incr row} radiobutton $frame.pFill$val -bg $powbg -text $lab \ -variable powEditCurveParam(pFill${curve},new) -value $val \ -highlightthickness 0 -takefocus 0 -font g_titleFont grid $frame.pFill$val -in $frame \ -row $row -column $col -sticky nw -padx 4 incr col } incr row grid rowconfigure $frame $row -minsize 7 incr row # Colors label $frame.pcolor -bg $powbg -text "Color:" -font g_titleFont grid $frame.pcolor -in $frame -row $row -column 1 -sticky e -columnspan 2 powColorFrame $frame.pColors powEditCurveParam(pColor${curve},new) grid $frame.pColors -in $frame -row $row -column 3 -columnspan 3 \ -sticky w -padx 8 incr row # Add a separator line frame $frame.sep -bg $powbg -relief ridge -height 2 -bd 2 grid $frame.sep -row $row -column 3 -columnspan 4 -sticky ew grid rowconfigure $frame $row -minsize 10 -weight 1 incr row # Data Transform label $frame.lLog -bg $powbg -text "Transform:" -font g_titleFont grid $frame.lLog -in $frame -row $row -column 2 -sticky ne checkbutton $frame.xLog -bg $powbg -text "Log X" \ -variable powEditCurveParam(logX${curve},new) \ -highlightthickness 0 -onvalue Yes -offvalue No -font g_titleFont checkbutton $frame.yLog -bg $powbg -text "Log Y" \ -variable powEditCurveParam(logY${curve},new) \ -highlightthickness 0 -onvalue Yes -offvalue No -font g_titleFont grid $frame.xLog -in $frame -row $row -column 3 -sticky w -padx 4 grid $frame.yLog -in $frame -row $row -column 4 -sticky w -padx 4 incr row grid rowconfigure $frame $row -minsize 5 incr row grid columnconfigure $frame 1 -minsize 10 grid columnconfigure $frame 0 -minsize 5 grid columnconfigure $frame [list 3 4 5 6] -weight 1 } ################## # # Setup Page: Lines # ################## proc powEditBuildCurveOptions2 { frame curve } { global powbg powEditCurveParam global g_titleFont # If frame already exists delete its contents if {[winfo exists $frame]} { foreach i [winfo children $frame] { destroy $i } } else { frame $frame -bg $powbg } # Set default values if not defined for this curve #puts "powEditCurveDefOptions 2" powEditCurveDefOptions $curve # Build widgets set row 1 grid rowconfigure $frame $row -minsize 5 incr row # # Setup Lines Options # # Line Display checkbutton $frame.lDisp -bg $powbg -text "Lines -" \ -variable powEditCurveParam(lDisp${curve},new) \ -highlightthickness 0 -onvalue Yes -offvalue No -font g_titleFont grid $frame.lDisp -in $frame -row $row -column 1 -sticky w -columnspan 2 incr row grid rowconfigure $frame $row -minsize 10 incr row # Style label $frame.style -bg $powbg -text "Style:" -font g_titleFont grid $frame.style -in $frame -row $row -column 2 -sticky ne set col 3 foreach {style val} \ {Solid " " "Sm Dash" 10 "Lg Dash" 20 \ "Dotted" "4 4" "Dot Dash" "15 10 4 10"} { regsub -all { } $style {_} cln if {$col==6} {set col 3; incr row} radiobutton $frame.lStyle$cln -bg $powbg -text $style \ -variable powEditCurveParam(lStyle${curve},new) -value $val \ -highlightthickness 0 -takefocus 0 -font g_titleFont grid $frame.lStyle$cln -in $frame \ -row $row -column $col -sticky nw -padx 4 incr col } incr row grid rowconfigure $frame $row -minsize 7 incr row # Line Width label $frame.width -bg $powbg -text "Width:" -font g_titleFont grid $frame.width -in $frame -row $row -column 2 -sticky ne set col 3 foreach {size val} {Thin 1 Medium 2 Thick 3} { if {$col==6} {set col 3; incr row} radiobutton $frame.lWidth$size -bg $powbg -text $size \ -variable powEditCurveParam(lWidth${curve},new) -value $val \ -highlightthickness 0 -takefocus 0 -font g_titleFont grid $frame.lWidth$size -in $frame \ -row $row -column $col -sticky nw -padx 4 incr col } incr row grid rowconfigure $frame $row -minsize 7 incr row # Histogram??? label $frame.step -bg $powbg -text "Connect:" -font g_titleFont grid $frame.step -in $frame -row $row -column 2 -sticky ne set col 3 foreach {style val} {"Normal" No "Histogram" Yes} { if {$col==6} {set col 3; incr row} radiobutton $frame.lStep$val -bg $powbg -text $style \ -variable powEditCurveParam(lStep${curve},new) -value $val \ -highlightthickness 0 -takefocus 0 -font g_titleFont grid $frame.lStep$val -in $frame \ -row $row -column $col -sticky nw -padx 4 incr col } checkbutton $frame.lBoxFill -bg $powbg -text "Fill Boxes" \ -variable powEditCurveParam(lBoxFill${curve},new) \ -onvalue Yes -offvalue No \ -highlightthickness 0 -takefocus 0 -font g_titleFont grid $frame.lBoxFill -row $row -column $col -sticky nw -padx 4 incr row grid rowconfigure $frame $row -minsize 7 incr row # Color label $frame.color -bg $powbg -text "Color:" -font g_titleFont grid $frame.color -in $frame -row $row -column 1 -sticky e -columnspan 2 powColorFrame $frame.lColors powEditCurveParam(lColor${curve},new) grid $frame.lColors -in $frame -row $row -column 3 -columnspan 3 \ -sticky w -padx 8 incr row # Add a separator line frame $frame.sep -bg $powbg -relief ridge -height 2 -bd 2 grid $frame.sep -row $row -column 3 -columnspan 3 -sticky ew grid rowconfigure $frame $row -minsize 10 -weight 1 incr row # Data Transform label $frame.lLog -bg $powbg -text "Transform:" -font g_titleFont grid $frame.lLog -in $frame -row $row -column 2 -sticky ne checkbutton $frame.xLog -bg $powbg -text "Log X" \ -variable powEditCurveParam(logX${curve},new) \ -highlightthickness 0 -onvalue Yes -offvalue No -font g_titleFont checkbutton $frame.yLog -bg $powbg -text "Log Y" \ -variable powEditCurveParam(logY${curve},new) \ -highlightthickness 0 -onvalue Yes -offvalue No -font g_titleFont grid $frame.xLog -in $frame -row $row -column 3 -sticky w -padx 4 grid $frame.yLog -in $frame -row $row -column 4 -sticky w -padx 4 incr row grid rowconfigure $frame $row -minsize 5 incr row grid columnconfigure $frame 1 -minsize 10 grid columnconfigure $frame 0 -minsize 5 grid columnconfigure $frame [list 3 4 5] -weight 1 } ################## # # Setup Page: Images # ################## proc powEditBuildImageOptions { frame image } { global powbg powEditImageParam powImageParam powRBmin powRBmax global g_titleFont # If frame already exists delete its contents if {[winfo exists $frame]} { foreach i [winfo children $frame] { destroy $i } } else { frame $frame -bg $powbg } # Set default values if not defined for this curve powEditImageDefOptions $image # Build widgets set row 1 grid rowconfigure $frame $row -minsize 5 incr row # # Setup Image Options # # Colormap label $frame.cmap -bg $powbg -text "Colormap:" -font g_titleFont grid $frame.cmap -in $frame -row $row -column 2 -sticky ne foreach colorGrp $powImageParam(allMaps,powDef) { set col 3 foreach cmap [lrange $colorGrp 1 end] { if {$col>=7} {set col 3; incr row} radiobutton $frame.cmap$cmap -bg $powbg -text $cmap \ -variable powEditImageParam(colormap${image},new) -value $cmap \ -highlightthickness 0 -takefocus 0 -font g_titleFont grid $frame.cmap$cmap -in $frame \ -row $row -column $col -sticky nw -padx 4 incr col } incr row } grid rowconfigure $frame $row -minsize 7 incr row # Inverted? label $frame.inv -bg $powbg -text "Invert:" -font g_titleFont grid $frame.inv -in $frame -row $row -column 2 -sticky ne radiobutton $frame.invOn -bg $powbg -text Yes \ -variable powEditImageParam(invert${image},new) -value Yes \ -highlightthickness 0 -takefocus 0 -font g_titleFont radiobutton $frame.invOff -bg $powbg -text No \ -variable powEditImageParam(invert${image},new) -value No \ -highlightthickness 0 -takefocus 0 -font g_titleFont grid $frame.invOn -in $frame \ -row $row -column 3 -sticky nw -padx 4 grid $frame.invOff -in $frame \ -row $row -column 4 -sticky nw -padx 4 incr row grid rowconfigure $frame $row -minsize 7 incr row # Scaling label $frame.scale -bg $powbg -text "Scaling:" -font g_titleFont grid $frame.scale -in $frame -row $row -column 2 -sticky ne set col 3 foreach {lab val} [list Linear linear Square-Root sqrt Logarithmic log \ "Histo Equalize" histo] { if {$col>=7} {set col 3; incr row} radiobutton $frame.scale$val -bg $powbg -text $lab \ -variable powEditImageParam(scale${image},new) -value $val \ -highlightthickness 0 -takefocus 0 -font g_titleFont grid $frame.scale$val -in $frame \ -row $row -column $col -sticky nw -padx 4 incr col } incr row if { $image != "" } { grid rowconfigure $frame $row -minsize 7 incr row # Intensity range label $frame.range -bg $powbg -text "Range:" -font g_titleFont grid $frame.range -in $frame -row $row -column 2 -sticky e frame $frame.rng -bg $powbg entry $frame.rng.min -relief sunken -bg $powbg -width 12 \ -textvariable powEditImageParam(RBmin${image},new) -font g_titleFont label $frame.rng.to -bg $powbg -text "-" -font g_titleFont entry $frame.rng.max -relief sunken -bg $powbg -width 12 \ -textvariable powEditImageParam(RBmax${image},new) -font g_titleFont button $frame.rng.reset -bg $powbg \ -text "Reset to [format "%.6g-%.6g" $powRBmin($image) \ $powRBmax($image)]" \ -command " set powEditImageParam(RBmin${image},new) $powRBmin($image) set powEditImageParam(RBmax${image},new) $powRBmax($image) " -font g_titleFont # label $frame.rng.orig -bg $powbg \ # -text "Orig: pack $frame.rng.min -side left pack $frame.rng.to -side left pack $frame.rng.max -side left pack $frame.rng.reset -side left -padx 10 grid $frame.rng -in $frame -row $row -column 3 -columnspan 4\ -sticky news -padx 4 } grid rowconfigure $frame $row -minsize 5 incr row grid columnconfigure $frame 1 -minsize 10 grid columnconfigure $frame 0 -minsize 5 grid columnconfigure $frame [list 3 4 5 6] -weight 1 } ######################################################################## # # Listbox manipulation # proc powEditAddElems { } { global powEditGraphName global powEditPlotParam powEditCurveParam global powDWP set elemNo [${powDWP}gEdit.elemList.lst curselection] if { $elemNo != "" } { set item [${powDWP}gEdit.elemList.lst get $elemNo] ${powDWP}gEdit.elemList.lst delete $elemNo if { [${powDWP}gEdit.elemList.lst size]<=$elemNo } { ${powDWP}gEdit.elemList.lst selection set end } else { ${powDWP}gEdit.elemList.lst selection set $elemNo } ${powDWP}gEdit.graphList.lst insert end $item ${powDWP}gEdit.graphList.lst selection clear 0 end ${powDWP}gEdit.graphList.lst selection set end foreach {name type} [split $item { }] {} if { $type=="(curve)" } { if { $powEditPlotParam(curves,new)=="NULL" } { set powEditPlotParam(curves,new) $name } else { lappend powEditPlotParam(curves,new) $name } } else { if { $powEditPlotParam(images,new)=="NULL" } { set powEditPlotParam(images,new) $name } else { lappend powEditPlotParam(images,new) $name } } } powEditBuildOptions } proc powEditRemoveElems { } { global powEditGraphName global powEditPlotParam powEditCurveParam global powDWP set graphNo [${powDWP}gEdit.graphList.lst curselection] if { $graphNo=="" } return if { $graphNo != "" } { set item [${powDWP}gEdit.graphList.lst get $graphNo] ${powDWP}gEdit.graphList.lst delete $graphNo if { [${powDWP}gEdit.graphList.lst size]<=$graphNo } { ${powDWP}gEdit.graphList.lst selection set end } else { ${powDWP}gEdit.graphList.lst selection set $graphNo } ${powDWP}gEdit.elemList.lst insert end $item ${powDWP}gEdit.elemList.lst selection clear 0 end ${powDWP}gEdit.elemList.lst selection set end foreach {name type} [split $item { }] {} if { $type=="(curve)" } { set i [lsearch -exact $powEditPlotParam(curves,new) $name] if { [llength $powEditPlotParam(curves,new)]==1 } { set powEditPlotParam(curves,new) NULL } else { set powEditPlotParam(curves,new) \ [lreplace $powEditPlotParam(curves,new) $i $i] } } else { set i [lsearch -exact $powEditPlotParam(images,new) $name] if { [llength $powEditPlotParam(images,new)]==1 } { set powEditPlotParam(images,new) NULL } else { set powEditPlotParam(images,new) \ [lreplace $powEditPlotParam(images,new) $i $i] } } } powEditBuildOptions } proc powEditUpdateListboxes { } { global powEditGraphName global powEditPlotParam powEditCurveParam global powDWP #puts "call powEditUpdateListboxes" ${powDWP}gEdit.graphList.lst delete 0 end ${powDWP}gEdit.elemList.lst delete 0 end set curves "" set images "" foreach item $powEditPlotParam(curves,new) { if {$item!="NULL"} { ${powDWP}gEdit.graphList.lst insert end "${item} (curve)" lappend curves $item } } foreach item $powEditPlotParam(images,new) { if {$item!="NULL"} { ${powDWP}gEdit.graphList.lst insert end "${item} (image)" lappend images $item } } foreach item [powListCurves] { if { [lsearch -exact $curves $item]==-1 } { ${powDWP}gEdit.elemList.lst insert end "${item} (curve)" } } foreach item [powListImages] { if { [lsearch -exact $images $item]==-1 } { ${powDWP}gEdit.elemList.lst insert end "${item} (image)" } } if { [${powDWP}gEdit.elemList.lst size]>0 } { ${powDWP}gEdit.elemList.lst selection set 0 } if { [${powDWP}gEdit.graphList.lst size]>0 } { ${powDWP}gEdit.graphList.lst selection set 0 } } ######################################################################## # # Variable management # proc powEditInitVariables { {flag "init"} } { global powEditGraphName powDWP global powPlotParam powCurveParam powImageParam powFontParam global powEditPlotParam powEditCurveParam powEditImageParam global powEditFontParam #puts "flag: $flag, powEditGraphName: $powEditGraphName" if { $flag == "reset" } { foreach el [array names powPlotParam] { set p1 [lindex [split $el ,] 0] set p2 [lindex [split $el ,] 1] if { $p2 == $powEditGraphName } { if { $flag == "reset" } { if [info exists powEditPlotParam($p1,powDef)] { set powPlotParam($p1,$p2) $powEditPlotParam($p1,powDef) } } } } } # Start fresh catch {unset powEditPlotParam} catch {unset powEditCurveParam} catch {unset powEditImageParam} catch {unset powEditFontParam} foreach el [array names powPlotParam] { set p1 [lindex [split $el ,] 0] set p2 [lindex [split $el ,] 1] if { $p2 == $powEditGraphName } { set powEditPlotParam($p1,old) $powPlotParam($p1,$p2) set powEditPlotParam($p1,new) $powPlotParam($p1,$p2) } } set powEditPlotParam(scalData,new) No # Hide some plot parameters foreach el [list xo yo handletext FixedAspect regions] { catch {unset powEditPlotParam($el,new)} } foreach el [array names powCurveParam] { set p1 [lindex [split $el ,] 0] set p2 [lindex [split $el ,] 1] if { $p2 == $powEditGraphName } { set powEditCurveParam($p1,old) $powCurveParam($p1,$p2) set powEditCurveParam($p1,new) $powCurveParam($p1,$p2) } } foreach el [array names powImageParam] { set p1 [lindex [split $el ,] 0] set p2 [lindex [split $el ,] 1] if { $p2 == $powEditGraphName } { set powEditImageParam($p1,old) $powImageParam($p1,$p2) set powEditImageParam($p1,new) $powImageParam($p1,$p2) } } foreach el [array names powFontParam] { set p1 [lindex [split $el ,] 0] set p2 [lindex [split $el ,] 1] if { $p2 == $powEditGraphName } { set powEditFontParam($p1,old) $powFontParam($p1,$p2) set powEditFontParam($p1,new) $powFontParam($p1,$p2) } } if { [winfo exists ${powDWP}gEdit] } { powEditUpdateListboxes } } proc powEditUpdateVariables { } { global powEditGraphName global powPlotParam powCurveParam powImageParam powFontParam global powEditPlotParam powEditCurveParam powEditImageParam global powEditFontParam global powWCSLabel powEditObject # Set default values of graph's curves if not already defined # Must do this before updating powPlotParam # because powEditCurveDefOptions references it #puts "powEditPlotParam(curves,new): $powEditPlotParam(curves,new)" foreach crv $powEditPlotParam(curves,new) { #puts " call powEditCurveDefOptions: $crv" powEditCurveDefOptions $crv } foreach img $powEditPlotParam(images,new) { powEditImageDefOptions $img } #### # Now update the global hashes for the modified graph #### foreach el [array names powEditFontParam] { set p1 [lindex [split $el ,] 0] set p2 [lindex [split $el ,] 1] if { $p2 == "new" } { set powFontParam($p1,$powEditGraphName) $powEditFontParam($p1,new) } } powEditConvertToAxes foreach el [array names powEditPlotParam] { set p1 [lindex [split $el ,] 0] set p2 [lindex [split $el ,] 1] if { $p2 == "new" } { if { ![info exists powEditPlotParam($p1,powDef)] && \ [info exists powPlotParam($p1,$powEditGraphName)] } { set powEditPlotParam($p1,powDef) $powPlotParam($p1,$powEditGraphName) } if { $p1 == "xdimdisp" } { #puts " B powPlotParam($p1,$powEditGraphName): $powPlotParam($p1,$powEditGraphName)" } set powPlotParam($p1,$powEditGraphName) $powEditPlotParam($p1,new) set powPlotParam($p1,${powEditGraphName}scope) $powEditPlotParam($p1,new) if { $p1 == "xdimdisp" } { #puts " A powPlotParam($p1,$powEditGraphName): $powPlotParam($p1,$powEditGraphName)" } switch $p1 { "xunits" - "yunits" - "xlabel" - "ylabel" { set target $p1 if { [string first "unit" $p1] >= 0 } { set target [string range $p1 0 4] } set powWCSLabel($target,$powEditGraphName,DEFAULT) $powEditPlotParam($p1,new) } } } } unset powPlotParam(scalData,$powEditGraphName) foreach el [array names powEditCurveParam] { set p1 [lindex [split $el ,] 0] set p2 [lindex [split $el ,] 1] if { $p2 == "new" } { set powCurveParam($p1,$powEditGraphName) $powEditCurveParam($p1,new) set powCurveParam($p1,${powEditGraphName}scope) \ $powEditCurveParam($p1,new) } } foreach img $powEditPlotParam(images,new) { if { $img == "NULL" } continue # Check for new colormap scaling if { [info exists powImageParam(lut$img,$powEditGraphName)] \ && $powImageParam(scale$img,$powEditGraphName) \ != $powEditImageParam(scale$img,new) } { unset powImageParam(lut$img,$powEditGraphName) } foreach {gn2 img2} [powGetColorbarLink $powEditGraphName $img] {} foreach opt [eval list $powImageParam(allOpts,powDef) RBmin RBmax] { set powImageParam(${opt}${img},$powEditGraphName) \ $powEditImageParam(${opt}${img},new) set powImageParam(${opt}${img},${powEditGraphName}scope) \ $powEditImageParam(${opt}${img},new) if { $gn2 != "" } { set powImageParam(${opt}${img2},${gn2}) \ $powEditImageParam(${opt}${img},new) set powImageParam(${opt}${img2},${gn2}scope) \ $powEditImageParam(${opt}${img},new) } } if { $gn2 != "" } { powSetColorTable $gn2 $img2 powReditherImage $gn2 $img2 } } } ######################################################################## proc powEditConvertToAxes {} { global powEditPlotParam powEditCurveParam if { $powEditPlotParam(scalData,new) } { foreach crv $powEditPlotParam(curves,new) { if { $crv=="NULL" } continue if { $powEditPlotParam(xTickScal,new)=="log" } { set powEditCurveParam(logX${crv},new) Yes } else { set powEditCurveParam(logX${crv},new) No } if { $powEditPlotParam(yTickScal,new)=="log" } { set powEditCurveParam(logY${crv},new) Yes } else { set powEditCurveParam(logY${crv},new) No } } } } ######################################################################## proc powEditCurveDefOptions { curve } { global powEditCurveParam powCurveParam powPlotParam #puts "curve: $curve" if { $curve == "NULL" || $curve == "" } return set crvGraph "" foreach opt $powCurveParam(allOpts,powDef) { if {! [info exists powEditCurveParam(${opt}${curve},new)]} { if { $crvGraph=="" } { set crvGraph powDef foreach grph [powListGraphs] { if { [regexp "scope$" $grph] } continue if { [lsearch -exact $powPlotParam(curves,$grph) $curve] \ != -1 } { set crvGraph $grph } } } if { $crvGraph=="powDef" } { set powEditCurveParam(${opt}${curve},new) \ $powCurveParam(${opt},powDef) set powEditCurveParam(${opt}${curve},old) \ $powCurveParam(${opt},powDef) } else { set powEditCurveParam(${opt}${curve},new) \ $powCurveParam(${opt}${curve},$crvGraph) set powEditCurveParam(${opt}${curve},old) \ $powCurveParam(${opt}${curve},$crvGraph) } } } } proc powEditImageDefOptions { image } { global powEditImageParam powImageParam powPlotParam global powRBmin powRBmax if { $image == "NULL" || $image == "" } return set imgGraph "" foreach opt $powImageParam(allOpts,powDef) { if {! [info exists powEditImageParam(${opt}${image},new)]} { if { $imgGraph=="" } { set imgGraph powDef foreach grph [powListGraphs] { if { [regexp "scope$" $grph] } continue if { [lsearch -exact $powPlotParam(images,$grph) $image] \ != -1 } { set imgGraph $grph } } } if { $imgGraph=="powDef" } { set powEditImageParam(${opt}${image},new) \ $powImageParam(${opt},powDef) set powEditImageParam(${opt}${image},old) \ $powImageParam(${opt},powDef) } else { set powEditImageParam(${opt}${image},new) \ $powImageParam(${opt}${image},$imgGraph) set powEditImageParam(${opt}${image},old) \ $powImageParam(${opt}${image},$imgGraph) } } } # Must also worry about RBmin and RBmax which don't have powDef defaults if {! [info exists powEditImageParam(RBmin${image},new)]} { if { $imgGraph=="" || $imgGraph=="powDef" } { set powEditImageParam(RBmin${image},new) \ $powRBmin($image) set powEditImageParam(RBmin${image},old) \ $powRBmin($image) set powEditImageParam(RBmax${image},new) \ $powRBmax($image) set powEditImageParam(RBmax${image},old) \ $powRBmax($image) } else { set powEditImageParam(RBmin${image},new) \ $powImageParam(RBmin${image},$imgGraph) set powEditImageParam(RBmin${image},old) \ $powImageParam(RBmin${image},$imgGraph) set powEditImageParam(RBmax${image},new) \ $powImageParam(RBmax${image},$imgGraph) set powEditImageParam(RBmax${image},old) \ $powImageParam(RBmax${image},$imgGraph) } } } ########################################################################### # # # Routines for editting Objects # # # ########################################################################### proc powEditObjectDlg { } { global powPlotParam powCurveParam powbg global powEditObject global powDWP global g_titleFont if {[winfo exists ${powDWP}object]} {destroy ${powDWP}object} powToplevel ${powDWP}object .pow "-bg $powbg" bind ${powDWP}object <> "powEditExitObjDlg" catch {wm title ${powDWP}object "Edit Objects"} label ${powDWP}object.objectCont -text "All Objects:" -fg black -bg yellow -font g_titleFont frame ${powDWP}object.objectList -bg $powbg scrollbar ${powDWP}object.objectList.scrolly -orient vertical -takefocus 0 \ -command {global powDWP ; ${powDWP}object.objectList.lst yview} -bg $powbg listbox ${powDWP}object.objectList.lst -bg $powbg -width 25 -height 6 \ -selectmode browse -exportselection 0 -takefocus 0 \ -yscrollcommand {global powDWP ; ${powDWP}object.objectList.scrolly set } -font g_titleFont bind ${powDWP}object.objectList.lst \ { powEditUpdateObject } grid ${powDWP}object.objectList.lst -in ${powDWP}object.objectList \ -row 1 -column 1 -sticky news grid ${powDWP}object.objectList.scrolly -in ${powDWP}object.objectList \ -row 1 -column 2 -sticky news grid rowconfigure ${powDWP}object.objectList 1 -weight 1 grid columnconfigure ${powDWP}object.objectList 1 -weight 1 label ${powDWP}object.dataCont -text "All Data:" -fg black -bg yellow -font g_titleFont frame ${powDWP}object.dataList -bg $powbg scrollbar ${powDWP}object.dataList.scrolly -orient vertical -takefocus 0 \ -command {global powDWP ; ${powDWP}object.dataList.lst yview} -bg $powbg listbox ${powDWP}object.dataList.lst -bg $powbg -width 25 -height 6 \ -selectmode browse -exportselection 0 -takefocus 0 \ -yscrollcommand {global powDWP ; ${powDWP}object.dataList.scrolly set } -font g_titleFont grid ${powDWP}object.dataList.lst -in ${powDWP}object.dataList -row 1 -column 1 \ -sticky news grid ${powDWP}object.dataList.scrolly -in ${powDWP}object.dataList -row 1 -column 2 \ -sticky news grid rowconfigure ${powDWP}object.dataList 1 -weight 1 grid columnconfigure ${powDWP}object.dataList 1 -weight 1 button ${powDWP}object.help -bg $powbg -text "Help" \ -command {powHelp EditObjects.html} -takefocus 0 -font g_titleFont grid ${powDWP}object.objectCont -in ${powDWP}object -row 1 -column 1 -sticky w \ -padx 5 -pady 5 grid ${powDWP}object.objectList -in ${powDWP}object -row 2 -column 1 -sticky news grid ${powDWP}object.help -in ${powDWP}object -row 1 -column 2 grid ${powDWP}object.dataCont -in ${powDWP}object -row 1 -column 3 -sticky w \ -padx 5 -pady 5 grid ${powDWP}object.dataList -in ${powDWP}object -row 2 -column 3 -sticky news button ${powDWP}object.editData -text "Edit Data" -bg $powbg -takefocus 0 \ -command { if { [info exists powDontPush] } { puts "I told you not to push that button again." } else { puts "Don't push that button again." set powDontPush 1 } } -font g_titleFont #grid ${powDWP}object.editData -in ${powDWP}object -row 3 -column 3 -sticky n -pady 2 frame ${powDWP}object.objectName -bg $powbg label ${powDWP}object.objectName.lab -bg yellow -fg black -text "Object Name:" -font g_titleFont entry ${powDWP}object.objectName.ent -textvariable powEditObject(name) \ -bg $powbg -font g_titleFont pack ${powDWP}object.objectName.lab -in ${powDWP}object.objectName -side left pack ${powDWP}object.objectName.ent -in ${powDWP}object.objectName -side left -padx 5 grid ${powDWP}object.objectName -in ${powDWP}object -row 3 -column 1 \ -columnspan 2 -sticky w -padx 18 frame ${powDWP}object.objectType -bg $powbg -relief ridge -bd 3 label ${powDWP}object.objectType.lab -bg yellow -fg black -text "Object Type:" -font g_titleFont radiobutton ${powDWP}object.objectType.curve -bg $powbg -text Curve \ -variable powEditObject(type) -value "(curve)" \ -highlightthickness 0 -takefocus 0 -font g_titleFont radiobutton ${powDWP}object.objectType.image -bg $powbg -text Image \ -variable powEditObject(type) -value "(image)" \ -highlightthickness 0 -takefocus 0 -font g_titleFont set powEditObject(type) "(curve)" pack ${powDWP}object.objectType.lab -in ${powDWP}object.objectType -side left pack ${powDWP}object.objectType.curve -in ${powDWP}object.objectType \ -side left -padx 10 pack ${powDWP}object.objectType.image -in ${powDWP}object.objectType \ -side left -padx 10 grid ${powDWP}object.objectType -in ${powDWP}object -row 4 -column 1 -sticky sew \ -columnspan 3 -padx 15 frame ${powDWP}object.btns -bg $powbg button ${powDWP}object.btns.create -text "Create Object" -bg $powbg \ -command {powEditCreateObject} -font g_titleFont button ${powDWP}object.btns.reload -text "Reload Info" -bg $powbg \ -command {powEditLoadObjects; powEditBuildObject} -font g_titleFont button ${powDWP}object.btns.exit -text "Exit" -bg $powbg \ -command powEditExitObjDlg -font g_titleFont pack ${powDWP}object.btns.create -in ${powDWP}object.btns -side left \ -padx 5 -pady 2 pack ${powDWP}object.btns.reload -in ${powDWP}object.btns -side left \ -padx 5 -pady 2 pack ${powDWP}object.btns.exit -in ${powDWP}object.btns -side left \ -padx 5 -pady 2 grid ${powDWP}object.btns -in ${powDWP}object -row 6 -column 1 -columnspan 3 \ -pady 5 grid rowconfigure ${powDWP}object 2 -weight 1 grid rowconfigure ${powDWP}object 5 -weight 1 grid columnconfigure ${powDWP}object 1 -weight 1 grid columnconfigure ${powDWP}object 3 -weight 1 powEditLoadObjects powEditBuildObject trace variable powEditObject(type) w powChangeBuildObject } proc powEditExitObjDlg { } { global powDWP destroy ${powDWP}object } proc powEditLoadObjects { {init 1} } { global powDWP ${powDWP}object.objectList.lst delete 0 end ${powDWP}object.dataList.lst delete 0 end set last "NULL (curve)" foreach itm [powListCurves] { set last "$itm (curve)" ${powDWP}object.objectList.lst insert end $last } foreach itm [powListImages] { set last "$itm (image)" ${powDWP}object.objectList.lst insert end $last } foreach itm [powListData] { ${powDWP}object.dataList.lst insert end "$itm ([powFetchDataLength $itm])" } ${powDWP}object.dataList.lst insert end "NULL (0)" ${powDWP}object.dataList.lst selection set 0 if {$init} { ${powDWP}object.objectList.lst selection set end eval [concat powEditInitObject $last] } } proc powEditInitObject { obj typ } { global powEditObject powWCS global powRotation if {$typ == "(curve)"} { set loc [lsearch -exact [powListCurves] $obj] } else { set loc [lsearch -exact [powListImages] $obj] } set powEditObject(name) $obj set powEditObject(type) $typ # Initialize all the entries to standard default NULLS or values foreach el [list xdata xedata xunits ydata yedata yunits \ zdata zedata zunits] { set powEditObject($el) NULL } foreach el [list xdim ydim xorigin yorigin xinc yinc] { set powEditObject($el) 1 } set powEditObject(wcs) 0 foreach el [list xref yref xrefpix yrefpix xinc yinc rot ctype] { set powEditObject(wcs$el) " " } if ![info exists powRotation($obj)] { set powRotation($obj) 0.0 #powChangeFitsHeaderKeyWordValue $obj {"CROAT2"} "X" $powRotation($obj) } set powEditObject(wcsrot) $powRotation($obj) # Now fill in the known quantities if { $obj!="NULL" && $loc!=-1 } { if { $typ=="(image)" } { array set powEditObject [powFetchImageInfoHash $obj] set powEditObject(xdata) $powEditObject(data) set powEditObject(xdim) $powEditObject(width) set powEditObject(ydim) $powEditObject(height) } else { array set powEditObject [powFetchCurveInfoHash $obj] foreach {vec lc} {X x Y y XE xe YE ye} { if { $powEditObject($vec) != "NULL" } { array set tmpArray \ [powFetchVectorInfoHash $powEditObject($vec)] set powEditObject(${lc}data) $tmpArray(data) set powEditObject(${lc}units) $tmpArray(units) } else { set powEditObject(${lc}data) NULL set powEditObject(${lc}units) NULL } } } if {[info exists powWCS($obj)] && $powWCS($obj) != "" } { set powEditObject(wcs) 1 set wcslist $powWCS($obj) # wcsinfo : {xrefvalue yrefvalue} {xrefpix yrefpix} {cdelt} {unit} {type} set powEditObject(wcsxref) [lindex [lindex $wcslist 0] 0] set powEditObject(wcsyref) [lindex [lindex $wcslist 0] 1] set powEditObject(wcsxrefpix) [lindex [lindex $wcslist 1] 0] set powEditObject(wcsyrefpix) [lindex [lindex $wcslist 1] 1] set powEditObject(wcsxinc) [lindex [lindex $wcslist 2] 0] set powEditObject(wcsxrot_cal) [lindex [lindex $wcslist 2] 1] set powEditObject(wcsyrot_cal) [lindex [lindex $wcslist 2] 2] set powEditObject(wcsyinc) [lindex [lindex $wcslist 2] 3] set powEditObject(wcsxunit) [lindex [lindex $wcslist 3] 0] set powEditObject(wcsyunit) [lindex [lindex $wcslist 3] 1] set powEditObject(wcsctype) [lindex [lindex $wcslist 4] 0] } } } proc powEditCreateObject { } { global powEditObject powWCS powFitsHeader powFitsHeaderCnt global powDWP g_magification powPlotParam powRotation global xCount yCount set obj $powEditObject(name) set wcslist {} if { $powEditObject(wcs) } { set wcsxinc $powEditObject(wcsxinc) set wcsyinc $powEditObject(wcsyinc) if { $powRotation($obj) != 0.0 } { # restore xinc yinc back to rotation 0.0 degree set wcsxinc [expr $powEditObject(wcsxrot_cal) / cos($powRotation($obj))] set wcsyinc [expr $powEditObject(wcsyrot_cal) / sin($powRotation($obj))] } # get user input rotation set powRotation($obj) $powEditObject(wcsrot) set powEditObject(wcsxrot_cal) [expr $wcsxinc * cos($powRotation($obj))] set powEditObject(wcsyrot_cal) [expr $wcsyinc * sin($powRotation($obj))] lappend wcslist [list $powEditObject(wcsxref) $powEditObject(wcsyref)] lappend wcslist [list $powEditObject(wcsxrefpix) $powEditObject(wcsyrefpix)] lappend wcslist [list $powEditObject(wcsxinc) $powEditObject(wcsxrot_cal) \ $powEditObject(wcsyrot_cal) $powEditObject(wcsyinc)] lappend wcslist [list $powEditObject(wcsxunit) $powEditObject(wcsyunit)] lappend wcslist [list $powEditObject(wcsctype) $powEditObject(wcsctype)] set graphHandle $obj if { $powEditObject(type)=="(curve)" } { # get rid of "c1_" for curve set graphHandle [string range $obj 3 end] } powChangeFitsHeaderKeyWordValue $graphHandle {"CTYPE1" "CTYPE2" "CDELT1" "CDELT2" "CROTA2" } \ "X" \ [list [format "RA--%s" $powEditObject(wcsctype)] \ [format "DEC-%s" $powEditObject(wcsctype)] \ $powEditObject(wcsxinc) \ $powEditObject(wcsyinc) \ $powRotation($obj)] \ [list $powEditObject(wcsxref) $powEditObject(wcsyref)] set powFitsHeader($obj) $powFitsHeader($graphHandle) set powFitsHeaderCnt($obj) $powFitsHeaderCnt($graphHandle) } set powFitsHeader(${obj}scope) $powFitsHeader($obj) set powFitsHeaderCnt(${obj}scope) $powFitsHeaderCnt($obj) set powWCS($obj) $wcslist set powWCS(${obj}scope) $wcslist if { $powEditObject(type)=="(curve)" } { set powFitsHeaderStr $powFitsHeader($obj) set powFitsHeaderCntValue $powFitsHeaderCnt($obj) catch { powDeleteGraph $graphHandle NOPROMPT powDeleteImage $graphHandle $graphHandle powDeleteCurve $graphHandle curve } set powWCS($obj) $wcslist set powWCS($graphHandle) $wcslist set powWCS(${graphHandle}scope) $wcslist set powFitsHeader($obj) $powFitsHeaderStr set powFitsHeaderCnt($obj) $powFitsHeaderCntValue set powFitsHeader(${graphHandle}scope) $powFitsHeaderStr set powFitsHeaderCnt(${graphHandle}scope) $powFitsHeaderCntValue set powFitsHeader($graphHandle) $powFitsHeader($obj) set powFitsHeaderCnt($graphHandle) $powFitsHeaderCnt($obj) set powPlotParam(graphType,$obj) "binary" set powPlotParam(graphType,${obj}scope) "binary" set powPlotParam(graphType,$graphHandle) "binary" set powPlotParam(graphType,${graphHandle}scope) "binary" set powPlotParam(zoomed,${graphHandle}) 0 set powPlotParam(zoomed,${graphHandle}scope) 0 set powPlotParam(zoomed,${obj}) 0 set powPlotParam(zoomed,${obj}scope) 0 set xCount(${obj}) 0 set yCount(${obj}) 0 set xCount(${obj}scope) 0 set yCount(${obj}scope) 0 set xCount(${graphHandle}) 0 set yCount(${graphHandle}) 0 set xCount(${graphHandle}scope) 0 set yCount(${graphHandle}scope) 0 set vectors "" foreach vec { x xe y ye } { if { $powEditObject(${vec}data) == "NULL" } { lappend vectors NULL } else { powCreateVector ${obj}_${vec}data $powEditObject(${vec}data) 0 \ NULL $powEditObject(${vec}units) lappend vectors ${obj}_${vec}data } } eval [concat powCreateCurve $obj $vectors] eval [concat powCreateGraph $graphHandle $obj NULL \ NULL NULL \ $powPlotParam(xlabel,$graphHandle) \ $powPlotParam(ylabel,$graphHandle) \ [lindex $fvPref::graphDispSize 0] \ [lindex $fvPref::graphDispSize 1]] } else { if { $powEditObject(wcs) } { powCreateImage $obj $powEditObject(xdata) \ 0 0 \ $powEditObject(xdim) $powEditObject(ydim) \ 1 1 1 1 \ $powEditObject(xunits) $powEditObject(yunits) \ $powEditObject(zunits) } else { powCreateImage $obj $powEditObject(xdata) \ 0 0 \ $powEditObject(xdim) $powEditObject(ydim) \ $powEditObject(xorigin) $powEditObject(xinc) \ $powEditObject(yorigin) $powEditObject(yinc) \ $powEditObject(xunits) $powEditObject(yunits) \ $powEditObject(zunits) } powEndROI 1 } powEditLoadObjects 0 set elem "$obj $powEditObject(type)" set num [lsearch -exact [${powDWP}object.objectList.lst get 0 end] $elem] ${powDWP}object.objectList.lst selection set $num eval [concat powEditInitObject $elem] } proc powEditUpdateObject { } { global powDWP set itm [${powDWP}object.objectList.lst curselection] if {$itm==""} { powEditInitObject NULL "(curve)" } else { eval [concat powEditInitObject [${powDWP}object.objectList.lst get $itm]] } powEditBuildObject } proc powChangeBuildObject { a b c } { powEditBuildObject } proc powEditBuildObject { } { global powEditObject powbg global powDWP if { $powEditObject(type)=="(curve)" } { powEditBuildCurve ${powDWP}object.curveFrame ${powDWP}object.curveFrame configure -borderwidth 3 -relief ridge grid ${powDWP}object.curveFrame -in ${powDWP}object -row 5 -column 1 \ -padx 15 -pady 5 -columnspan 3 -sticky news catch {grid remove ${powDWP}object.imageFrame} } else { powEditBuildImage ${powDWP}object.imageFrame ${powDWP}object.imageFrame configure -borderwidth 3 -relief ridge grid ${powDWP}object.imageFrame -in ${powDWP}object -row 5 -column 1 \ -padx 15 -pady 5 -columnspan 3 -sticky news catch {grid remove ${powDWP}object.curveFrame} } } proc powEditUpdateDataButton { btn var } { global powEditObject global powDWP set elem [${powDWP}object.dataList.lst curselection] if { $elem=="" } return set data [lindex [${powDWP}object.dataList.lst get $elem] 0] set powEditObject($var) $data $btn configure -text $data } proc powEditBuildCurve { frame } { global powEditObject powbg global g_titleFont if { [winfo exists $frame] } { foreach {lbl var} [list Data: data Error: edata] { $frame.bx$var configure -text $powEditObject(x$var) $frame.by$var configure -text $powEditObject(y$var) } return } frame $frame -bg $powbg set row 1 grid columnconfigure $frame 1 -minsize 10 grid columnconfigure $frame 4 -minsize 10 label $frame.x -bg $powbg -text X -font g_titleFont label $frame.y -bg $powbg -text Y -font g_titleFont grid $frame.x -in $frame -row $row -column 3 -sticky s grid $frame.y -in $frame -row $row -column 5 -sticky s incr row # Create data buttons foreach {lbl var} [list Data: data Error: edata] { label $frame.l$var -bg $powbg -text $lbl -font g_titleFont grid $frame.l$var -in $frame -row $row -column 2 -sticky e -padx 10 button $frame.bx$var -bg $powbg -text $powEditObject(x$var) \ -command "powEditUpdateDataButton $frame.bx$var x$var" -font g_titleFont button $frame.by$var -bg $powbg -text $powEditObject(y$var) \ -command "powEditUpdateDataButton $frame.by$var y$var" -font g_titleFont grid $frame.bx$var -in $frame -row $row -column 3 -sticky news grid $frame.by$var -in $frame -row $row -column 5 -sticky news incr row } foreach {lbl var} [list Units: units] { label $frame.l$var -bg $powbg -text $lbl -font g_titleFont grid $frame.l$var -in $frame -row $row -column 2 -sticky e -padx 10 entry $frame.ex$var -bg $powbg -textvariable powEditObject(x$var) \ -takefocus 1 -font g_titleFont entry $frame.ey$var -bg $powbg -textvariable powEditObject(y$var) \ -takefocus 1 -font g_titleFont grid $frame.ex$var -in $frame -row $row -column 3 -sticky news grid $frame.ey$var -in $frame -row $row -column 5 -sticky news incr row } grid rowconfigure $frame $row -minsize 10 incr row powEditBuildWCS $frame $row } proc powEditBuildImage { frame } { global powEditObject powbg global g_titleFont if { [winfo exists $frame] } { $frame.bdata configure -text $powEditObject(xdata) return } frame $frame -bg $powbg set row 1 grid columnconfigure $frame 1 -minsize 10 grid columnconfigure $frame 4 -minsize 10 label $frame.ldata -bg $powbg -text "Data:" -font g_titleFont grid $frame.ldata -in $frame -row $row -column 2 -sticky e -padx 10 button $frame.bdata -bg $powbg -text $powEditObject(xdata) \ -command "powEditUpdateDataButton $frame.bdata xdata; set powEditObject(ydim) 1; set powEditObject(xdim) \ \[powFetchDataLength \$powEditObject(xdata)\]" -font g_titleFont grid $frame.bdata -in $frame -row $row -column 3 -sticky w -columnspan 3 incr row label $frame.lzunits -bg $powbg -text "Units:" -font g_titleFont grid $frame.lzunits -in $frame -row $row -column 2 -sticky e -padx 10 entry $frame.ezunits -bg $powbg -textvariable powEditObject(zunits) \ -takefocus 1 -font g_titleFont grid $frame.ezunits -in $frame -row $row -column 3 -sticky w incr row grid rowconfigure $frame $row -minsize 10 incr row label $frame.x -bg $powbg -text X -font g_titleFont label $frame.y -bg $powbg -text Y -font g_titleFont grid $frame.x -in $frame -row $row -column 3 -sticky s grid $frame.y -in $frame -row $row -column 5 -sticky s incr row foreach {lbl var} \ [list Dimensions: dim Origin: origin "Pixel Size:" inc Units: units] { label $frame.l$var -bg $powbg -text $lbl -font g_titleFont grid $frame.l$var -in $frame -row $row -column 2 -sticky e -padx 10 entry $frame.ex$var -bg $powbg -textvariable powEditObject(x$var) \ -takefocus 1 -font g_titleFont entry $frame.ey$var -bg $powbg -textvariable powEditObject(y$var) \ -takefocus 1 -font g_titleFont grid $frame.ex$var -in $frame -row $row -column 3 -sticky news grid $frame.ey$var -in $frame -row $row -column 5 -sticky news incr row } grid rowconfigure $frame $row -minsize 10 incr row powEditBuildWCS $frame $row } proc powEditBuildWCS { frame row } { global powEditObject powbg global g_titleFont # Build WCS entries checkbutton $frame.wcs -bg $powbg -text "WCS Info -" \ -highlightthickness 0 -takefocus 0 \ -variable powEditObject(wcs) -font g_titleFont grid $frame.wcs -in $frame -row $row -column 1 -columnspan 2 -sticky w incr row foreach {lbl var} \ [list "Ref Value:" ref "Ref Pixel:" refpix "Pixel Scale:" inc] { label $frame.lw$var -bg $powbg -text $lbl -font g_titleFont grid $frame.lw$var -in $frame -row $row -column 2 -sticky e -padx 10 entry $frame.ewx$var -bg $powbg -textvariable powEditObject(wcsx$var) \ -takefocus 1 -font g_titleFont entry $frame.ewy$var -bg $powbg -textvariable powEditObject(wcsy$var) \ -takefocus 1 -font g_titleFont grid $frame.ewx$var -in $frame -row $row -column 3 -sticky news grid $frame.ewy$var -in $frame -row $row -column 5 -sticky news incr row } label $frame.lrot -bg $powbg -text "Rotation:" -font g_titleFont grid $frame.lrot -in $frame -row $row -column 2 -sticky e -padx 10 entry $frame.erot -bg $powbg -textvariable powEditObject(wcsrot) \ -takefocus 1 -font g_titleFont grid $frame.erot -in $frame -row $row -column 3 -sticky news incr row label $frame.lproj -bg $powbg -text "Projection:" -font g_titleFont grid $frame.lproj -in $frame -row $row -column 2 -sticky ne -padx 10 set pcol 1 set prow 1 frame $frame.projType -bg $powbg foreach {lbl val} \ {AZP "-AZP" SZP "-SZP" TAN "-TAN" STG "-STG" SIN "-SIN" ARC "-ARC" ZPN "-ZPN" \ ZEA "-ZEA" AIR "-AIR" CYP "-CYP" CEA "-CEA" CAR "-CAR" MER "-MER" COP "-COP" \ COE "-COE" COD "-COD" COO "-COO" SFL "-SFL" PAR "-PAR" MOL "-MOL" AIT "-AIT" \ BON "-BON" PCO "-PCO" TSC "-TSC" CSC "-CSC" QSC "-QSC" HPX "-HPX" NCP "-NCP"} { if {$pcol==5} {set pcol 1; incr prow} radiobutton $frame.projType.p$lbl -bg $powbg -text $lbl \ -variable powEditObject(wcsctype) -value $val \ -highlightthickness 0 -takefocus 0 -font g_titleFont grid $frame.projType.p$lbl -in $frame.projType \ -row $prow -column $pcol -sticky nw -padx 6 incr pcol } grid $frame.projType -in $frame -row $row -column 3 -columnspan 3 -sticky w incr row } ######################################################################## # # # Functions to set Default Display Options # # # ######################################################################## proc powDefaultOptions { } { global currgn powbg global powPlotParam powEditPlotParam powEditGraphName global powCurveParam powEditCurveParam global powImageParam powEditImageParam global powDWP global g_titleFont if {[winfo exists ${powDWP}default]} {destroy ${powDWP}default} powToplevel ${powDWP}default .pow "-bg $powbg" bind ${powDWP}default <> "powEditExitDefDlg" catch {wm title ${powDWP}default "POW Preferences"} set powEditGraphName powDef powEditInitDefVariables set note ${powDWP}default.nBook Notebook:create $note -pages {POW Graph Fonts Ticks Points Lines Images} \ -pad 4 -bg $powbg set w [Notebook:frame $note POW] powEditBuildPOWOptions $w set w [Notebook:frame $note Graph] powEditBuildGraphOptions $w set w [Notebook:frame $note Fonts] powEditBuildFontOptions $w set w [Notebook:frame $note Ticks] powEditBuildTickOptions $w set w [Notebook:frame $note Points] powEditBuildCurveOptions1 $w "" set w [Notebook:frame $note Lines] powEditBuildCurveOptions2 $w "" set w [Notebook:frame $note Images] powEditBuildImageOptions $w "" # Setup Buttons button ${powDWP}default.help -text "Help" \ -command {powHelp DefaultOptions.html} \ -bg $powbg -takefocus 0 -font g_titleFont frame ${powDWP}default.buttons -bg $powbg button ${powDWP}default.buttons.save -text "Save" -bg $powbg \ -command {powEditUpdateDefVariables; powSaveConfig} -font g_titleFont button ${powDWP}default.buttons.curr -text "Get Current" -bg $powbg \ -command {powEditGetCurrVariables} -font g_titleFont button ${powDWP}default.buttons.reset -text "Reset" -bg $powbg \ -command powEditInitDefVariables -font g_titleFont button ${powDWP}default.buttons.exit -text "Exit" -bg $powbg \ -command { powEditExitDefDlg } -font g_titleFont pack ${powDWP}default.buttons.save -side left -padx 4 -pady 3 pack ${powDWP}default.buttons.curr -side left -padx 4 -pady 3 pack ${powDWP}default.buttons.reset -side left -padx 4 -pady 3 pack ${powDWP}default.buttons.exit -side left -padx 4 -pady 3 label ${powDWP}default.lab -bg $powbg \ -text "Default options for new graphs:" -font g_titleFont # Place everything into dialog grid ${powDWP}default.help -in ${powDWP}default -row 1 -column 1 -sticky ne grid ${powDWP}default.lab -in ${powDWP}default -row 2 -column 1 grid ${powDWP}default.nBook -in ${powDWP}default -row 3 -column 1 \ -sticky news -padx 15 -pady 10 grid ${powDWP}default.buttons -in ${powDWP}default -row 4 -column 1 -pady 8 Notebook:resize $note } proc powEditExitDefDlg { } { global powDWP powEditUpdateDefVariables destroy ${powDWP}default } proc powEditInitDefVariables {} { global powPlotParam powEditPlotParam global powCurveParam powEditCurveParam global powImageParam powEditImageParam global powFontParam powEditFontParam global powEditAppParam #puts "call powEditInitDefVariables" foreach opt $powPlotParam(allOpts,powDef) { set powEditPlotParam(${opt},new) $powPlotParam(${opt},powDef) } foreach opt $powCurveParam(allOpts,powDef) { set powEditCurveParam(${opt},new) $powCurveParam(${opt},powDef) } foreach opt $powImageParam(allOpts,powDef) { set powEditImageParam(${opt},new) $powImageParam(${opt},powDef) } foreach opt $powFontParam(allOpts,powDef) { foreach lbl $powFontParam(allTypes,powDef) { set powEditFontParam(${lbl}${opt},new) \ $powFontParam(${lbl}${opt},powDef) } } foreach opt [list bg cursor ResizeMain GUIposition ScopeSize ] { set powEditAppParam(${opt},new) [subst \$::pow$opt] } } proc powEditGetCurrVariables {} { global powPlotParam powEditPlotParam currgn currimg global powCurveParam powEditCurveParam global powImageParam powEditImageParam global powFontParam powEditFontParam #puts "call powEditGetCurrVariables, currgn: <$currgn>" if { ![info exists currgn] || $currgn=="powDef" } return foreach opt $powPlotParam(allOpts,powDef) { set powEditPlotParam(${opt},new) $powPlotParam(${opt},$currgn) } if { [info exists currimg] && $currimg != "" } { foreach opt $powImageParam(allOpts,powDef) { set powEditImageParam(${opt},new) \ $powImageParam(${opt}${currimg},$currgn) } } set crv [lindex $powPlotParam(curves,$currgn) 0] if { $crv != "NULL" } { foreach opt $powCurveParam(allOpts,powDef) { set powEditCurveParam(${opt},new) \ $powCurveParam(${opt}${crv},$currgn) } } foreach opt $powFontParam(allOpts,powDef) { foreach lbl $powFontParam(allTypes,powDef) { set powEditFontParam(${lbl}${opt},new) \ $powFontParam(${lbl}${opt},$currgn) } } } proc powEditUpdateDefVariables {} { global powPlotParam powEditPlotParam global powCurveParam powEditCurveParam global powImageParam powEditImageParam global powFontParam powEditFontParam global powEditAppParam foreach opt $powPlotParam(allOpts,powDef) { set powPlotParam(${opt},powDef) $powEditPlotParam(${opt},new) } foreach opt $powCurveParam(allOpts,powDef) { set powCurveParam(${opt},powDef) $powEditCurveParam(${opt},new) } foreach opt $powImageParam(allOpts,powDef) { set powImageParam(${opt},powDef) $powEditImageParam(${opt},new) } foreach opt $powFontParam(allOpts,powDef) { foreach lbl $powFontParam(allTypes,powDef) { set powFontParam(${lbl}${opt},powDef) \ $powEditFontParam(${lbl}${opt},new) } } foreach opt [list bg cursor ResizeMain GUIposition ScopeSize ] { if { [subst \$::pow$opt] != $powEditAppParam(${opt},new) } { powSetGlobal_$opt $powEditAppParam(${opt},new) } } } ######################################################################## #### #### Color Frame "Widget" #### ######################################################################## proc powColorFrame { frame varName } { global powbg global g_titleFont upvar #0 $varName var set hex [list "00" "99" "FF"] set nClr [llength $hex] frame $frame -bg $powbg frame $frame.grid -relief ridge -bd 3 -bg $powbg for { set i 0 } { $i<$nClr } { incr i 1 } { for { set j 0 } { $j<$nClr } { incr j 1 } { for { set k 0 } { $k<$nClr } { incr k 1 } { set color "[lindex $hex $i][lindex $hex $j][lindex $hex $k]" frame $frame.grid.c$color -width 24 -height 24 -bg "#$color" \ -bd 4 -relief flat -takefocus 0 grid $frame.grid.c$color -row $k -column [expr $j + $i*$nClr] bind $frame.grid.c$color \ "powUpdateColorFrame $frame #$color $varName" } } } button $frame.clrbtn -textvariable $varName \ -bg $powbg -highlightthickness 0 -width 7 \ -font g_titleFont \ -command "powUpdateColorFrame $frame \ \[powSelectAndReturnColor \$$varName\] $varName" if { ![info exists var] } { # Set initial value to black set var "#000000" } grid $frame.grid -row 1 -column 1 grid $frame.clrbtn -row 1 -column 2 -padx 7 powUpdateColorFrame $frame $var $varName trace variable ::$varName w "powColorVarHasChanged $frame" } proc powColorVarHasChanged { f varName varIndex op } { if { $varName=="var" } return if { $varIndex != "" } { set varName ${varName}($varIndex) } if { [winfo exists $f.grid] } { foreach c [winfo child $f.grid] { $c configure -relief flat } } powUpdateColorFrame $f [subst \$::$varName] $varName } proc powSelectAndReturnColor { c } { set newClr [tk_chooseColor -initialcolor $c] if { $newClr != "" } { set c $newClr } return $c } proc powUpdateColorFrame { f color varName } { upvar #0 $varName var set lvar [string range $var 1 end] if { [winfo exists $f.grid.c$lvar] } { $f.grid.c$lvar configure -relief flat } set var "$color" set lvar [string range $var 1 end] if { [winfo exists $f.grid.c$lvar] } { $f.grid.c$lvar configure -relief raised } if { [winfo exists $f.clrbtn] } { $f.clrbtn configure -bg $color } } fv5.5/tcltk/pow/powImgProbe.tcl0000644000220700000360000003277113224715130015411 0ustar birbylheaproc gImgProbe { args } { return [uplevel #0 ImgProbe #auto $args] } itcl::class ImgProbe { constructor {args} {} destructor {} private variable probeRegion private variable probeCentX private variable probeCentY private variable probeStdX private variable probeStdY private variable probeFlux private variable probeNPix private variable probeFormat private variable probeMean private variable probeDMean private variable probeFile private variable graphx private variable graphy private variable probeNewFile private variable imgprobe public method openProbe {} public method updateProbe {} public method setShape { } public method setUnit {} public method saveProbe {} public method closeProbeFile {} } itcl::body ImgProbe::constructor {args} { global currgn global powDWP global powDrawOriginalFlag set powDrawOriginalFlag "false" set probeRegion [gRegionList $currgn .pow.pow] $probeRegion setOwner imgProbeCallback $probeRegion setAllowsMultiple 0 $probeRegion setDefault "+" Circle set probeCentX 0.0 set probeCentY 0.0 set probeStdX 0.0 set probeStdY 0.0 set probeFlux 0.0 set probeNPix 0.0 set probeMean 0.0 set probeFormat decimal set probeNewFile 0 set imgprobe ${powDWP}probe } itcl::body ImgProbe::destructor {} { itcl::delete object $probeRegion } itcl::body ImgProbe::setShape { } { set probeSelected [$probeRegion rgnAtIndex 0 ] if {$probeSelected == ""} { return } set oldshape [$probeSelected getShape ] set descr [$probeSelected getFunction "pixels" ] set rotation [$probeSelected getRotation ] set shape [$imgprobe.options.shape get] if {$oldshape == $shape } { return; } if {$oldshape == "Circle" && $shape != "Circle" } { if {$shape == "Box"} { set a [lindex $descr 2] set descr [lreplace $descr 2 2 [expr 2.0*$a] ] } lappend descr [lindex $descr 2] lappend descr 0 } if {$oldshape != "Circle" && $shape == "Circle"} { set a [lindex $descr 2] set b [lindex $descr 3] if {$oldshape == "Box"} { set descr [lreplace $descr 2 2 [expr 0.25*$a + 0.25 * $b ] ] } else { set descr [lreplace $descr 2 2 [expr 0.5*$a + 0.5 * $b ] ] } set descr [lrange $descr 0 2 ] } if {$oldshape == "Ellipse" && $shape == "Box"} { set a [lindex $descr 2] set descr [lreplace $descr 2 2 [expr 2.0*$a] ] set a [lindex $descr 3] set descr [lreplace $descr 3 3 [expr 2.0*$a] ] } if {$oldshape == "Box" && $shape == "Ellipse"} { set a [lindex $descr 2] set descr [lreplace $descr 2 2 [expr 0.5*$a] ] set a [lindex $descr 3] set descr [lreplace $descr 3 3 [expr 0.5*$a] ] } $probeRegion deleteAll $probeRegion setDefault "+" $shape $probeRegion addRegion + $shape $descr pixels updateProbe } itcl::body ImgProbe::setUnit { } { set probeFormat [$imgprobe.options.unit get] updateProbe } itcl::body ImgProbe::updateProbe {} { global currimg # Use SAO Format set probeSelected [$probeRegion rgnAtIndex 0 ] if {$probeSelected == ""} { return } set shape [$probeSelected getShape ] set descr [$probeSelected getFunction "pixels" ] set results [powGetRegionStatistics $currimg NONE $descr $shape + ] set good [lindex $results 0] if {$good == 1} { set probeCentX [lindex $results 1] set probeCentY [lindex $results 2] set probeStdX [lindex $results 3] set probeStdY [lindex $results 4] set probeFlux [lindex $results 5] set probeNPix [lindex $results 6] set probeMean [ format "%.10g" [lindex $results 7] ] set probeDMean [ format "%.10g" [lindex $results 8] ] set pixel [format "(%.2f, %.2f) +- (%.2f, %.2f)" \ $probeCentX $probeCentY $probeStdX $probeStdY ] foreach {graphx graphy} [powPixelToGraph $currimg \ [expr $probeCentX - 1] [expr $probeCentY - 1] ] {} foreach {gx1 gy1} [powPixelToGraph $currimg \ [expr $probeCentX - 1 - $probeStdX ] \ [expr $probeCentY - 1 - $probeStdY ] ] {} foreach {gx2 gy2} [powPixelToGraph $currimg \ [expr $probeCentX - 1 + $probeStdX ] \ [expr $probeCentY - 1 + $probeStdY ] ] {} set graphdx [expr abs($gx2 - $gx1)/2.0 ] set graphdy [expr abs($gy2 - $gy1)/2.0 ] if {$probeFormat == "decimal" } { set graphx [format %.6g $graphx] set graphy [format %.6g $graphy] set graphdx [format %.3g $graphdx] set graphdy [format %.3g $graphdy] } else { set graphx [powHourRA $graphx "%02d:%02d:%05.2f"] set graphy [powDegDec $graphy] set graphdx [powHourRA $graphdx "%02d:%02d:%05.2f"] set graphdy [powDegDec $graphdy] } set coord "($graphx, $graphy) +- ($graphdx, $graphdy)" } else { set probeCentX X set probeCentY Y set probeStdX "" set probeStdY "" set probeFlux 0 set probeNPix 0 set pixel "(X,Y) +- (dX,dY)" set coord "(X,Y) +- (dX,dY)" set probeMean 0 set probeDMean 0 } # Update the readout in dialog box. set cen $imgprobe.centroid set childsite [$cen.pixel childsite] $childsite.c configure -text $pixel set childsite [$cen.coord childsite] $childsite.c configure -text $coord set sta $imgprobe.info.statistics set childsite [$sta.pixels childsite] $childsite.c configure -text $probeNPix set childsite [$sta.flux childsite] $childsite.c configure -text $probeFlux set childsite [$sta.mean childsite] $childsite.c configure -text "$probeMean +- $probeDMean" } itcl::body ImgProbe::saveProbe {} { global currimg if {$probeCentX == "X"} return if ![info exists probeFile ] { set probeFile [tk_getSaveFile -initialfile "pow.stat"] if [file exists $probeFile] { file delete -force $probeFile } } if {$probeFile == "" } { unset probeFile return } set probeNewFile [file exists $probeFile] set fprob [open $probeFile a] if {$probeNewFile == 0 } { set probeNewFile 1 set title \ "Xpix Ypix Xgraph Ygraph Npix Flux Mean" puts $fprob $title } if {$probeFormat == "decimal" } { set temp [ format \ "%-8.2f %-8.2f %-12.6g %-12.6g %-8.0f %-12.6g %-12.6g" \ $probeCentX $probeCentY $graphx $graphy $probeNPix $probeFlux \ $probeMean ] puts $fprob $temp } else { set temp [ format \ "%-8.2f %-8.2f %-12s %-12s %-8.0f %-12.6g %-12.6g" \ $probeCentX $probeCentY $graphx $graphy $probeNPix $probeFlux \ $probeMean ] puts $fprob $temp } close $fprob } itcl::body ImgProbe::closeProbeFile {} { if [info exist probeFile] { unset probeFile } } itcl::body ImgProbe::openProbe {} { global powbg global currgn global currimg global g_titleFont global ROIbbox powPlotParam global roi_xo roi_yo global roi_xn roi_yn global roi_pixelxo roi_pixelyo global roi_pixelxn roi_pixelyn global powImgProbe global ROIunits powToplevel $imgprobe .pow "-width 200 -bg $powbg" wm title $imgprobe "Image Probe" frame $imgprobe.title label $imgprobe.title.label -text "Image Probe" -bg yellow -font g_titleFont button $imgprobe.title.help -text Help \ -command {powHelp Probe.html} -font g_titleFont pack $imgprobe.title.label -side left pack $imgprobe.title.help -side right frame $imgprobe.options set opt $imgprobe.options iwidgets::optionmenu $opt.shape -labeltext "Probe Shape" \ -command [itcl::code $this setShape] \ -font g_titleFont \ -labelfont g_titleFont $opt.shape insert end "Circle" $opt.shape insert end "Ellipse" $opt.shape insert end "Box" # $opt.shape insert end "Polygon" iwidgets::optionmenu $opt.unit -labeltext "Coord. Format" \ -command [itcl::code $this setUnit] \ -font g_titleFont \ -labelfont g_titleFont $opt.unit insert end "decimal" if [ powWCSexists $currgn ] { $opt.unit insert end "hms" } pack $opt.shape -side left pack $opt.unit -side right frame $imgprobe.centroid set cen $imgprobe.centroid label $cen.label -text "Centroid:" -anchor w -font g_titleFont iwidgets::labeledwidget $cen.pixel -labeltext "Pixel:" \ -labelfont g_titleFont set childsite [$cen.pixel childsite] label $childsite.c -width 55 -relief sunken -font g_titleFont pack $childsite.c iwidgets::labeledwidget $cen.coord -labeltext "Coordinate:" \ -labelfont g_titleFont set childsite [$cen.coord childsite] label $childsite.c -width 55 -relief sunken -font g_titleFont pack $childsite.c iwidgets::Labeledwidget::alignlabels $cen.pixel $cen.coord pack $cen.label -fill x -anchor w pack $cen.pixel -fill x pack $cen.coord -fill x frame $imgprobe.info frame $imgprobe.info.statistics set sta $imgprobe.info.statistics label $sta.label -text "Statistics:" -anchor w -font g_titleFont iwidgets::labeledwidget $sta.pixels -labeltext "N pixels:" \ -labelfont g_titleFont set childsite [$sta.pixels childsite] label $childsite.c -width 30 -relief sunken -font g_titleFont pack $childsite.c iwidgets::labeledwidget $sta.flux -labeltext "Total Flux:" \ -labelfont g_titleFont set childsite [$sta.flux childsite] label $childsite.c -width 30 -relief sunken -font g_titleFont pack $childsite.c iwidgets::labeledwidget $sta.mean -labeltext "Mean Flux:" \ -labelfont g_titleFont set childsite [$sta.mean childsite] label $childsite.c -width 30 -relief sunken -font g_titleFont pack $childsite.c iwidgets::Labeledwidget::alignlabels $sta.pixels $sta.flux $sta.mean pack $sta.label -fill x -anchor w pack $sta.pixels -fill x pack $sta.flux -fill x pack $sta.mean -fill x frame $imgprobe.info.log set sta $imgprobe.info.log set cmd $imgprobe.info.log button $cmd.record -text Record -command [itcl::code $this saveProbe] \ -width 8 -font g_titleFont button $cmd.close -text "Close Log" -command [itcl::code $this closeProbeFile] \ -width 8 -font g_titleFont button $cmd.exit -text Exit -width 8 -command { global powImgProbe destroy ${powDWP}probe if [info exists powImgProbe] { itcl::delete object $powImgProbe unset powImgProbe } } -font g_titleFont pack $cmd.record -side top -padx 40 pack $cmd.close -side top -padx 40 pack $cmd.exit -side top -padx 40 pack $imgprobe.info.statistics -side left -anchor nw pack $imgprobe.info.log -side right -anchor nw pack $imgprobe.title -side top -fill x -pady 2 pack $imgprobe.options -side top -fill x -pady 2 pack $imgprobe.centroid -side top -anchor nw -pady 2 pack $imgprobe.info -side top -fill x -pady 2 bind $imgprobe <> { global powImgProbe destroy ${powDWP}probe if [info exists powImgProbe] { itcl::delete object $powImgProbe unset powImgProbe } } bind $imgprobe { global powImgProbe destroy ${powDWP}probe if [info exists powImgProbe] { itcl::delete object $powImgProbe unset powImgProbe } } set temp [ powFetchImageInfoHash $currimg ] set temp [split $temp ] if { $powPlotParam(zoomed,$currimg) == 1 } { # image is zoom set imgWidth [expr $roi_pixelxn - $roi_pixelxo] set imgHeight [expr $roi_pixelyo - $roi_pixelyn] } else { set imgWidth [lindex $temp 3] set imgHeight [lindex $temp 5] } set imgMin $imgHeight if {$imgMin < $imgHeight} { set $imgMin $imgHeight } if { $powPlotParam(zoomed,$currimg) == 1 } { set halfx [expr round($imgWidth*0.5) + 1 + round($roi_pixelxo)] set halfy [expr round($roi_pixelyo) - round($imgHeight*0.5) + 1] } else { set halfx [expr round($imgWidth*0.5)+1 ] set halfy [expr round($imgHeight*0.5)+1 ] } set r [expr round($imgMin/10.0)] if {$r < 1 } { set r 1 } set descr [list $halfx $halfy $r ] $probeRegion addRegion + Circle $descr pixels update idletasks scan [winfo geometry .pow] "%dx%d+%d+%d" Pw Ph Px Py set width [expr [winfo reqwidth $imgprobe] + 2] scan [winfo geometry $imgprobe] "%dx%d+%d+%d" Rw Rh Rx Ry catch { wm geometry $imgprobe ${width}x$Rh+[expr $Px + $Pw - 15 ]+$Py } err tkwait window $imgprobe } proc imgProbeDialog {} { global currimg global powDWP global powImgProbe if ![info exists currimg ] { tk_messageBox -type ok -icon error \ -message "Select an image first." return } if [winfo exists ${powDWP}probe ] { focus ${powDWP}probe raise ${powDWP}probe return } if [winfo exists ${powDWP}probe] { catch { destroy ${powDWP}probe itcl::delete object $powImgProbe unset powImgProbe } } set powImgProbe [gImgProbe] $powImgProbe openProbe } proc imgProbeCallback {obj msg} { global powImgProbe if {$msg == "shapeIsBeingModified" || $msg == "shapeHasChanged"} { $powImgProbe updateProbe } } fv5.5/tcltk/pow/powMacResource.r0000644000220700000360000000076013224715130015565 0ustar birbylhea#define POW_LIBRARY_RESOURCES 4000 read 'TEXT' (POW_LIBRARY_RESOURCES+1, "pow", purgeable) ":pow.tcl"; read 'TEXT' (POW_LIBRARY_RESOURCES+2, "powEdit", purgeable) ":powEdit.tcl"; read 'TEXT' (POW_LIBRARY_RESOURCES+3, "powRgn", purgeable) ":powRgn.tcl"; read 'TEXT' (POW_LIBRARY_RESOURCES+4, "notebook", purgeable) ":notebook.tcl"; read 'TEXT' (POW_LIBRARY_RESOURCES+5, "html_library", purgeable) ":html_library.tcl"; read 'TEXT' (POW_LIBRARY_RESOURCES+6, "powMovie", purgeable) ":powMovie.tcl"; fv5.5/tcltk/pow/powMovie.tcl0000644000220700000360000005310613224715130014757 0ustar birbylhea######################################################### # All the routines relating to Animation... # Blink Graphs # Blink Images ######################################################### proc powMovie { } { global powPlotParam movieParam powbg currgn global powDWP global g_titleFont if { $powPlotParam(images,$currgn)=="NULL" } { tk_messageBox -icon warning \ -message "Select a graph with images first." \ -parent .pow -title "Blink Warning" -type ok return } if {[winfo exists ${powDWP}movie]} {destroy ${powDWP}movie} powToplevel ${powDWP}movie .pow "-bg $powbg" bind ${powDWP}movie <> "powMovieExitDlg" catch {wm title ${powDWP}movie "Blink Images"} powMovieLoadInfo set movieParam(playing) 0 set movieParam(speed) 11 set movieParam(all) 1 set movieParam(loop) 1 set movieParam(direction) 1 set movieParam(list) "" set movieParam(update) 0 label ${powDWP}movie.title -textvariable movieParam(title) \ -bg yellow -fg black -font g_titleFont frame ${powDWP}movie.step -bg $powbg button ${powDWP}movie.step.forward -text "Next" -command {powMovieNext 1} \ -bg $powbg -font g_titleFont button ${powDWP}movie.step.addtolist -text "Add to list" \ -command {powMovieAddtoList} -bg $powbg -font g_titleFont button ${powDWP}movie.step.backward -text "Prev" -command {powMovieNext -1} \ -bg $powbg -font g_titleFont button ${powDWP}movie.step.help -text "Help" \ -command {powHelp Blinking.html} \ -bg $powbg -font g_titleFont pack ${powDWP}movie.step.addtolist -in ${powDWP}movie.step -side left -padx 7 pack ${powDWP}movie.step.backward -in ${powDWP}movie.step -side left pack ${powDWP}movie.step.forward -in ${powDWP}movie.step -side left pack ${powDWP}movie.step.help -in ${powDWP}movie.step -side left \ -padx 12 label ${powDWP}movie.play -text "Play:" -bg $powbg -fg black -font g_titleFont radiobutton ${powDWP}movie.all -text "All Frames" -variable movieParam(all) \ -value 1 -bg $powbg -highlightthickness 0 \ -command {set movieParam(update) 1} -font g_titleFont frame ${powDWP}movie.list -bg $powbg radiobutton ${powDWP}movie.list.lab -text "List " -variable movieParam(all) \ -value 0 -bg $powbg -highlightthickness 0 \ -command {set movieParam(update) 1} -font g_titleFont entry ${powDWP}movie.list.txt -width 15 -bg $powbg \ -textvariable movieParam(list) -font g_titleFont pack ${powDWP}movie.list.lab -in ${powDWP}movie.list -side left pack ${powDWP}movie.list.txt -in ${powDWP}movie.list -side left \ -expand 1 -fill x label ${powDWP}movie.speed -text "Speed:" -bg $powbg -fg black -font g_titleFont frame ${powDWP}movie.speedslide -bg $powbg label ${powDWP}movie.speedslide.fast -text "Fast" -bg $powbg -font g_titleFont label ${powDWP}movie.speedslide.slow -text "Slow" -bg $powbg -font g_titleFont scale ${powDWP}movie.speedslide.slide -from 0 -to 20 \ -orient horizontal -variable movieParam(speed) \ -highlightbackground $powbg -bg $powbg \ -showvalue 0 -font g_titleFont pack ${powDWP}movie.speedslide.fast -in ${powDWP}movie.speedslide -side left pack ${powDWP}movie.speedslide.slide -in ${powDWP}movie.speedslide \ -side left -expand 1 -fill x pack ${powDWP}movie.speedslide.slow -in ${powDWP}movie.speedslide -side right checkbutton ${powDWP}movie.loop -variable movieParam(loop) -text Loop \ -bg $powbg -highlightthickness 0 -font g_titleFont checkbutton ${powDWP}movie.reverse -variable movieParam(direction) \ -text Reverse -bg $powbg -highlightthickness 0 \ -offvalue 1 -onvalue -1 -font g_titleFont frame ${powDWP}movie.buttons -bg $powbg button ${powDWP}movie.buttons.reload -text "Reload Info" -bg $powbg \ -command {powMovieLoadInfo} -font g_titleFont button ${powDWP}movie.buttons.play -text "Blink Images" -bg $powbg \ -command {powPlayMovie} -width 12 -font g_titleFont button ${powDWP}movie.buttons.exit -text "Exit" -bg $powbg \ -command {powMovieExitDlg} -font g_titleFont pack ${powDWP}movie.buttons.reload -in ${powDWP}movie.buttons -side left \ -padx 4 -pady 3 pack ${powDWP}movie.buttons.play -in ${powDWP}movie.buttons -side left \ -padx 4 -pady 3 pack ${powDWP}movie.buttons.exit -in ${powDWP}movie.buttons -side left \ -padx 4 -pady 3 grid ${powDWP}movie.title -in ${powDWP}movie -row 0 -column 0 -columnspan 3 grid ${powDWP}movie.step -in ${powDWP}movie -row 1 -column 0 -columnspan 3 \ -pady 5 grid ${powDWP}movie.play -in ${powDWP}movie -row 2 -column 0 -sticky e grid ${powDWP}movie.all -in ${powDWP}movie -row 2 -column 1 -sticky w grid ${powDWP}movie.loop -in ${powDWP}movie -row 2 -column 2 -sticky w \ -padx 10 grid ${powDWP}movie.list -in ${powDWP}movie -row 3 -column 1 -sticky ew grid ${powDWP}movie.reverse -in ${powDWP}movie -row 3 -column 2 -sticky w \ -padx 10 grid ${powDWP}movie.speed -in ${powDWP}movie -row 4 -column 0 -sticky e \ -pady 3 grid ${powDWP}movie.speedslide -in ${powDWP}movie -row 4 -column 1 \ -sticky ew -pady 3 grid ${powDWP}movie.buttons -in ${powDWP}movie -row 5 -column 0 \ -columnspan 3 -pady 8 grid columnconfigure ${powDWP}movie 1 -weight 1 grid rowconfigure ${powDWP}movie 0 -weight 1 grid rowconfigure ${powDWP}movie 1 -weight 1 grid rowconfigure ${powDWP}movie 5 -weight 1 } proc powMovieExitDlg { } { global movieParam powDWP set movieParam(playing) 0 destroy ${powDWP}movie } proc powMovieLoadInfo { } { global movieParam currgn powPlotParam set movieParam(gn) $currgn set images $powPlotParam(images,$currgn) if { [lindex $images 0] == "NULL" } { set nFrames 0 set fNum 0 } else { set nFrames [llength $images] set img [powMovieGetTopImg] if { $img == "" } { set fNum 0 } else { set fNum [lsearch -exact $images $img] incr fNum } } set movieParam(nframes) $nFrames set movieParam(title) "$currgn: $fNum of $nFrames frames" } proc powMovieGetTopImg { } { global movieParam set gn $movieParam(gn) set visFrames [.pow.pow find withtag disp$gn] if { [llength $visFrames]==0 } { set img "" } else { set top [lindex $visFrames end] regexp "(\[^ \]+)disp$gn" [.pow.pow gettags $top] tag img } return $img } proc powMovieNext { step } { global movieParam currgn powPlotParam set gn $movieParam(gn) set images $powPlotParam(images,$gn) set img [powMovieGetTopImg] if { [lindex $images 0] == "NULL" || $img=="" } return set fNum [lsearch -exact $images $img] if { $fNum < 0 } { puts "Something went wrong! $img not in $images" return } # Locate next displayed image set nframes [llength $images] while { 1 } { incr fNum $step if { $fNum >= $nframes } { set fNum 0 } elseif { $fNum < 0 } { set fNum [expr $nframes-1] } set newimg [lindex $images $fNum] set newid [.pow.pow find withtag ${newimg}disp${gn}] if { $newid != "" } break } .pow.pow raise $newid ${img}disp${gn} set movieParam(title) "$gn: [expr $fNum+1] of $nframes frames" incr movieParam(Fidx) $movieParam(direction) if { $gn == $currgn } { powSelectImage $gn $newimg } } proc powMovieAddtoList { } { global movieParam powPlotParam set gn $movieParam(gn) set fNum [lsearch -exact $powPlotParam(images,$gn) [powMovieGetTopImg] ] incr fNum if {$movieParam(list)==""} {set movieParam(list) $fNum} \ else {set movieParam(list) "$movieParam(list),$fNum"} set movieParam(all) 0 } proc powPlayMovie { } { global movieParam powPlotParam global powDWP set gn $movieParam(gn) set images $powPlotParam(images,$gn) if { [lindex $images 0] == "NULL" } return set nframes [llength $images] set movieParam(playing) 1 if { [winfo exists ${powDWP}movie] } { ${powDWP}movie.buttons.play configure -text "Stop Movie" \ -command {set movieParam(playing) 0} } set movieParam(expdlist) [powUpdateMovieList $nframes] set ndisp [llength $movieParam(expdlist)] if {$movieParam(direction)>0} { if ![info exists movieParam(Fidx)] { set movieParam(Fidx) 0 } } else { if ![info exists movieParam(Fidx)] { set movieParam(Fidx) [expr $ndisp - 1] } } powPlayNextFrame } proc powPlayNextFrame { } { global movieParam powPlotParam global powDWP currimg set gn $movieParam(gn) set images $powPlotParam(images,$gn) if { [lindex $images 0] == "NULL" } return set nframes [llength $images] if { $movieParam(update) } { set movieParam(expdlist) [powUpdateMovieList $nframes] } set ndisp [llength $movieParam(expdlist)] set nextframe [expr [lindex $movieParam(expdlist) $movieParam(Fidx)]-1] if {$nextframe<$nframes && $nextframe>=0} { set img [lindex $images $nextframe] set currimg $img set next ${img}disp$gn if { [winfo exists .pow.pow] && [.pow.pow find withtag $next] != "" } { powSelectImage $gn $img set movieParam(title) \ "$gn: [expr $nextframe+1] of $movieParam(nframes) frames" } } incr movieParam(Fidx) $movieParam(direction) if {$movieParam(Fidx)<0} { set movieParam(Fidx) [expr $ndisp-1] if {!$movieParam(loop)} { set movieParam(playing) 0 } } elseif {$movieParam(Fidx)>=$ndisp} { set movieParam(Fidx) 0 if {!$movieParam(loop)} { set movieParam(playing) 0 } } if { ![winfo exists .pow.pow] } { set movieParam(playing) 0 } if { $movieParam(playing) } { # Setup delay... top speed ~30 fps set speed 33 for {set j 0} {$j<$movieParam(speed)} {incr j} { set speed [expr $speed*1.33] } set speed [expr int($speed)] after $speed powPlayNextFrame } else { # Check that dialog box is still around before trying to change # one of its objects if {[winfo exists ${powDWP}movie.buttons.play]} { ${powDWP}movie.buttons.play configure -text "Blink Images" \ -command {powPlayMovie} } } update idletasks } proc powUpdateMovieList { nframes } { global movieParam set expdlist {} if {$movieParam(all)} { for {set i 1} {$i<=$nframes} {incr i} { lappend expdlist $i } } else { set list [split $movieParam(list) " ,"] while { [llength $list] } { set elem [lindex $list 0] set list [lreplace $list 0 0] if {$elem==""} continue if { [regexp -- - $elem] } { set elem [split $elem "-"] set a1 [lindex $elem 0] set a2 [lindex $elem 1] if { $a1 <= $a2 } { for {set i $a1} {$i<=$a2} {incr i} \ {lappend expdlist $i} } else { for {set i $a1} {$i>=$a2} {incr i -1} \ {lappend expdlist $i} } } elseif { [expr $elem] > 0 && [expr $elem] <= $nframes} { lappend expdlist [expr $elem] } } } set movieParam(update) 0 return $expdlist } ############################ ### Blink Graphs ### ############################ proc powBlinkGraphDlg { } { global powPlotParam powbg currgn movieParam global powDWP global g_titleFont if {[winfo exists ${powDWP}blink]} {destroy ${powDWP}blink} powToplevel ${powDWP}blink .pow "-bg $powbg" bind ${powDWP}blink <> "powBlinkExitDlg" catch {wm title ${powDWP}blink "Blink Graphs"} set movieParam(playing) 0 listbox ${powDWP}blink.listall -width 20 -height 10 \ -selectmode extended -bg $powbg -exportselection 0 -font g_titleFont label ${powDWP}blink.titleall -text "Available Graphs:" -fg black -bg yellow -font g_titleFont listbox ${powDWP}blink.listblnk -width 20 -height 10 \ -selectmode extended -bg $powbg -exportselection 0 -font g_titleFont label ${powDWP}blink.titleblnk -text "Blink Order:" -fg black -bg yellow -font g_titleFont button ${powDWP}blink.help -text "Help" \ -command {powHelp Blinking.html} \ -bg $powbg -font g_titleFont grid ${powDWP}blink.titleall -in ${powDWP}blink -row 1 -column 1 -sticky w \ -padx 5 -pady 5 grid ${powDWP}blink.listall -in ${powDWP}blink -row 2 -column 1 -sticky news grid ${powDWP}blink.help -in ${powDWP}blink -row 1 -column 2 grid ${powDWP}blink.titleblnk -in ${powDWP}blink -row 1 -column 3 -sticky w \ -padx 5 -pady 5 grid ${powDWP}blink.listblnk -in ${powDWP}blink -row 2 -column 3 -sticky news frame ${powDWP}blink.grphbtns -bg $powbg button ${powDWP}blink.grphbtns.add -text "Add -->" -bg $powbg \ -command {powBlinkAdd} -font g_titleFont button ${powDWP}blink.grphbtns.insert -text "Insert -->" -bg $powbg \ -command {powBlinkInsert} -font g_titleFont button ${powDWP}blink.grphbtns.delete -text "Delete <--" -bg $powbg \ -command {powBlinkDelete} -font g_titleFont frame ${powDWP}blink.grphbtns.shft -bg $powbg label ${powDWP}blink.grphbtns.shft.lab -text "Shift\n& Align\nGraphs" \ -bg $powbg -font g_titleFont canvas ${powDWP}blink.grphbtns.shft.but -width 56 -height 56 -bg $powbg \ -highlightthickness 0 ${powDWP}blink.grphbtns.shft.but create polygon 3 30 18 22 18 38 \ -fill grey -outline black -tag "blinkShftLeft btn" ${powDWP}blink.grphbtns.shft.but create polygon 30 3 22 18 38 18 \ -fill grey -outline black -tag "blinkShftUp btn" ${powDWP}blink.grphbtns.shft.but create polygon 57 30 42 22 42 38 \ -fill grey -outline black -tag "blinkShftRght btn" ${powDWP}blink.grphbtns.shft.but create polygon 30 57 22 42 38 42 \ -fill grey -outline black -tag "blinkShftDown btn" ${powDWP}blink.grphbtns.shft.but create rectangle 23 23 37 37 \ -fill grey -outline black -tag "blinkShftCntr btn" pack ${powDWP}blink.grphbtns.shft.lab -in ${powDWP}blink.grphbtns.shft \ -side left -padx 5 pack ${powDWP}blink.grphbtns.shft.but -in ${powDWP}blink.grphbtns.shft \ -side left -padx 5 bind ${powDWP}blink.grphbtns.shft.but {powBlinkShift 10} bind ${powDWP}blink.grphbtns.shft.but {powBlinkShift 1} bind ${powDWP}blink.grphbtns.shft.but {set powShiftLoop 0} bind ${powDWP}blink.grphbtns.shft.but {powBlinkShiftHilight %x %y} bind ${powDWP}blink.grphbtns.shft.but {powBlinkShiftHilight %x %y} pack ${powDWP}blink.grphbtns.add -in ${powDWP}blink.grphbtns -fill x \ -padx 5 -pady 2 pack ${powDWP}blink.grphbtns.insert -in ${powDWP}blink.grphbtns -fill x \ -padx 5 -pady 2 pack ${powDWP}blink.grphbtns.shft -in ${powDWP}blink.grphbtns \ -fill none -padx 5 -pady 2 pack ${powDWP}blink.grphbtns.delete -in ${powDWP}blink.grphbtns -fill x \ -padx 5 -pady 2 grid ${powDWP}blink.grphbtns -in ${powDWP}blink -row 2 -column 2 set movieParam(speed) 11 label ${powDWP}blink.speedfast -text "Speed: Fast" -bg $powbg -font g_titleFont label ${powDWP}blink.speedslow -text "Slow" -bg $powbg -font g_titleFont scale ${powDWP}blink.speedslide -from 0 -to 20 \ -orient horizontal -variable movieParam(speed) \ -highlightbackground $powbg -bg $powbg \ -showvalue 0 -font g_titleFont grid ${powDWP}blink.speedfast -in ${powDWP}blink -row 3 -column 1 \ -sticky e -pady 5 grid ${powDWP}blink.speedslide -in ${powDWP}blink -row 3 -column 2 \ -sticky ew -pady 5 grid ${powDWP}blink.speedslow -in ${powDWP}blink -row 3 -column 3 \ -sticky w -pady 5 frame ${powDWP}blink.blnkbtns -bg $powbg button ${powDWP}blink.blink -text "Blink Graphs" -bg $powbg \ -command {powBlinkBlink} -font g_titleFont button ${powDWP}blink.reload -text "Reload Info" -bg $powbg \ -command {powBlinkReload} -font g_titleFont button ${powDWP}blink.exit -text "Exit" -bg $powbg \ -command {powBlinkExitDlg} -font g_titleFont grid ${powDWP}blink.reload -in ${powDWP}blink -row 4 -column 1 -sticky e \ -pady 7 -padx 10 grid ${powDWP}blink.blink -in ${powDWP}blink -row 4 -column 2 -sticky ew \ -pady 7 grid ${powDWP}blink.exit -in ${powDWP}blink -row 4 -column 3 -sticky w \ -pady 7 -padx 10 grid columnconfigure ${powDWP}blink 1 -weight 1 grid columnconfigure ${powDWP}blink 3 -weight 1 grid rowconfigure ${powDWP}blink 2 -weight 1 powBlinkReload } proc powBlinkExitDlg { } { global movieParam powDWP set movieParam(playing) 0 destroy ${powDWP}blink } proc powBlinkReload { } { global currgn global powDWP set graphlist "" foreach graph [powListGraphs] { if { ![regexp scope\$ $graph] } {lappend graphlist $graph} } ${powDWP}blink.listall delete 0 end eval [concat ${powDWP}blink.listall insert end $graphlist] ${powDWP}blink.listall selection clear 0 end set curridx [lsearch -exact $graphlist $currgn] if {$curridx>=0} {${powDWP}blink.listall selection set $curridx} \ else {${powDWP}blink.listall selection set 0} } proc powBlinkBlink { } { global movieParam currgn global powDWP ${powDWP}blink.blink configure -text "Stop Blinking" \ -command {set movieParam(playing) 0} set movieParam(playing) 1 set movieParam(Fidx) 0 powBlinkBlinkNext } proc powBlinkBlinkNext { } { global movieParam currgn global powDWP if { ![winfo exists ${powDWP}blink.listblnk] } { set movieParam(playing) 0 } else { set graphlist [${powDWP}blink.listblnk get 0 end] set cnt [llength $graphlist] if { [winfo exists .pow.pow] } { if {$movieParam(Fidx)<$cnt} { .pow.pow raise [lindex $graphlist $movieParam(Fidx)] } } else { set movieParam(playing) 0 } incr movieParam(Fidx) if {$movieParam(Fidx)>=$cnt} { set movieParam(Fidx) 0 } } if { $movieParam(playing) } { # Setup delay... top speed ~30 fps set speed 33 for {set j 0} {$j<$movieParam(speed)} {incr j} { set speed [expr $speed*1.33] } set speed [expr int($speed)] after $speed powBlinkBlinkNext } else { # Check that dialog box is still around before trying to change # its objects if {[winfo exists ${powDWP}blink]} { ${powDWP}blink.blink configure -text "Blink Graphs" \ -command {powBlinkBlink} } if { [winfo exists .pow.pow] } {.pow.pow raise $currgn} } update idletasks } proc powBlinkShift { size } { global currgn powShiftLoop powShiftCurrBtn global powDWP set powShiftLoop 1 set origobj $powShiftCurrBtn set firstloop 1 while {$powShiftLoop} { set obj $powShiftCurrBtn if {$obj!="" && $obj==$origobj} { set tags [${powDWP}blink.grphbtns.shft.but gettags $obj] regexp "blinkShft(\[^ \]+)" $tags "" direction if {$direction=="Cntr"} { set select [${powDWP}blink.listblnk get 0 end] } else { set select "" foreach idx [${powDWP}blink.listblnk curselection] { lappend select [${powDWP}blink.listblnk get $idx] } } foreach graph $select { set dx 0 set dy 0 switch -exact $direction { Cntr { if { ![info exists bbox1] } { set cbbox [.pow.pow cget -scrollregion] set bbox1 [.pow.pow bbox $graph] set xloc [expr double( \ [lindex $bbox1 0]+[lindex $bbox1 2]) \ / [lindex $cbbox 2] / 2.0 ] set yloc [expr double( \ [lindex $bbox1 1]+[lindex $bbox1 3]) \ / [lindex $cbbox 3] / 2.0 ] set xv [.pow.pow xview] if {$xloc<[lindex $xv 0] || $xloc>[lindex $xv 1]} { .pow.pow xview moveto \ [expr double([lindex $bbox1 0]-30) \ / [lindex $cbbox 2] ] } set yv [.pow.pow yview] if {$yloc<[lindex $yv 0] || $yloc>[lindex $yv 1]} { .pow.pow yview moveto \ [expr double([lindex $bbox1 1]-30) \ / [lindex $cbbox 3] ] } } else { set bbox2 [.pow.pow bbox $graph] set dx [expr [lindex $bbox1 2]-[lindex $bbox2 2]] set dy [expr [lindex $bbox1 1]-[lindex $bbox2 1]] } } Up { set dy -$size } Down { set dy $size } Left { set dx -$size } Rght { set dx $size } } powMoveGraph $graph $dx $dy } } if {$firstloop} { for {set delay 0} {$delay<200} {incr delay} {update} } update set firstloop 0 } } proc powBlinkShiftHilight { x y } { global powbg powShiftCurrBtn global powDWP ${powDWP}blink.grphbtns.shft.but itemconfigure btn -fill grey set obj [${powDWP}blink.grphbtns.shft.but find overlapping $x $y $x $y] if {[regexp btn [${powDWP}blink.grphbtns.shft.but gettags $obj] ]} { set powShiftCurrBtn $obj ${powDWP}blink.grphbtns.shft.but itemconfigure $obj -fill white } else { set powShiftCurrBtn "" } } proc powBlinkAdd { } { global powDWP set count 0 set select [${powDWP}blink.listall curselection] foreach item $select { set additem [${powDWP}blink.listall get $item] ${powDWP}blink.listblnk insert end $additem incr count } if {$count>0} { set nelem [llength [${powDWP}blink.listblnk get 0 end]] ${powDWP}blink.listblnk selection clear 0 end ${powDWP}blink.listblnk selection set [expr $nelem-$count] end } } proc powBlinkInsert { } { global powDWP set count 0 set select [${powDWP}blink.listall curselection] set insloc [lindex [${powDWP}blink.listblnk curselection] 0] if {$insloc==""} {set insloc 0} foreach item $select { set additem [${powDWP}blink.listall get $item] ${powDWP}blink.listblnk insert [expr $insloc+$count] $additem incr count } if {$count>0} { ${powDWP}blink.listblnk selection clear 0 end ${powDWP}blink.listblnk selection set $insloc [expr $insloc+$count-1] } } proc powBlinkDelete { } { global powDWP set count 0 set select [${powDWP}blink.listblnk curselection] foreach item $select { ${powDWP}blink.listblnk delete [expr $item-$count] incr count } if {$count>0} { ${powDWP}blink.listblnk selection set [lindex $select 0] } } fv5.5/tcltk/pow/powProfile.tcl0000755000220700000360000003202713224715130015302 0ustar birbylheaproc GetPoint_Img {img x y } { global profileWidth global profileHeight if {$img == "NULL"} { return NULL } if {$x >= 0 && $x < $profileWidth && $y >= 0 && $y < $profileHeight } { set imgz [powGetImageZ $img $x $y] } else { set imgz 0 } return $imgz } proc UpdateProfile {obj} { global powDWP global profile_gn global profile_img global currgn global xCount yCount powPlotParam set xdlg ${powDWP}xdlg foreach [list gx0 gy0 gx1 gy1] [$obj getGraphCoords] {} set e0 [powGraphToPixel $profile_img $gx0 $gy0] set e1 [powGraphToPixel $profile_img $gx1 $gy1] foreach [list x0 y0] $e0 {} foreach [list x1 y1] $e1 {} set x0 [expr round($x0 + 1)] set y0 [expr round($y0 + 1)] set x1 [expr round($x1 + 1)] set y1 [expr round($y1 + 1)] set width [image width $profile_img] set height [image height $profile_img] if [info exist powPlotParam(flipD,$profile_gn)] { switch $powPlotParam(flipD,$profile_gn) { "X" { if { [info exists xCount($profile_gn)] && [expr $xCount($profile_gn) % 2] != 0 } { set x0 [expr $width - $x0 - 1] set x1 [expr $width - $x1 - 1] } } "Y" { if { [info exists yCount($profile_gn)] && [expr $yCount($profile_gn) % 2] != 0 } { set y0 [expr $height - $y0 - 1] set y1 [expr $height - $y1 - 1] } } } } set g0 [format "(%-.8g, %-.8g)" $gx0 $gy0 ] set g1 [format "(%-.8g, %-.8g)" $gx1 $gy1 ] set p0 [format "(%d, %d)" $x0 $y0 ] set p1 [format "(%d, %d)" $x1 $y1 ] $xdlg.frame.row1.pix1 configure -text $p0 $xdlg.frame.row1.pix2 configure -text $p1 $xdlg.frame.row2.graph1 configure -text $g0 $xdlg.frame.row2.graph2 configure -text $g1 } proc DrawProfile {obj} { global profile_gn global profile_img global currgn global currimg global powWCS powFitsHeader powFitsHeaderCnt xCount yCount global powWCSList powWCSLabel powWCSName global powPlotParam global xlist global zlist global graphCoordList set graphCoordList {} foreach [list gx0 gy0 gx1 gy1] [$obj getGraphCoords] {} set e0 [powGraphToPixel $profile_img $gx0 $gy0] set e1 [powGraphToPixel $profile_img $gx1 $gy1] foreach [list x0 y0] $e0 {} foreach [list x1 y1] $e1 {} set x0 [expr round($x0)] set y0 [expr round($y0)] set x1 [expr round($x1)] set y1 [expr round($y1)] set tx [expr abs($x1-$x0)] set tx [expr abs($x1-$x0)] set ty [expr abs($y1-$y0)] if {$tx == 0 && $ty == 0 } { return } if {$tx >= $ty } { if {$x0 > $x1 } { set step -1 } else { set step 1 } set k [expr double($y1-$y0)/double($x1-$x0) ] set tpoints [expr (abs($x1-$x0+1))] set usex 1 } else { if {$y0 > $y1 } { set step -1 } else { set step 1 } set k [expr double($x1-$x0)/double($y1-$y0) ] set tpoints [expr abs(($y1-$y0+1))] set usex 0 } set xi $x0 set yi $y0 set a [GetPoint_Img $profile_img $xi $yi] if {$a != "NULL"} { lappend zlist $a } else { lappend zlist 0 } set zlist [GetPoint_Img $profile_img $xi $yi] lappend graphCoordList [powPixelToGraph $profile_img $xi $yi] set xlist 1 for {set i 1} {$i < $tpoints } {incr i} { if {$usex == 1} { incr xi $step set yi [expr round($k*($xi-$x0))+$y0] } else { incr yi $step set xi [expr round($k*($yi-$y0))+$x0] } lappend xlist [expr $i + 1] set a [GetPoint_Img $profile_img $xi $yi] lappend graphCoordList [powPixelToGraph $profile_img $xi $yi] if {$a != "NULL"} { lappend zlist $a } else { lappend zlist 0 } } powCreateDataFromList ${profile_gn}_cx_data $xlist set xlabel "pixel index " set xunit " pixel" set powWCSLabel(xlabel,${profile_gn}_xsec,DEFAULT) $xlabel set powWCSLabel(ylabel,${profile_gn}_xsec,DEFAULT) "" set powWCSLabel(xunit,${profile_gn}_xsec,DEFAULT) $xunit set powWCSLabel(yunit,${profile_gn}_xsec,DEFAULT) "" powCreateDataFromList ${profile_gn}_cz_data $zlist powCreateVector ${profile_gn}_cx_vector ${profile_gn}_cx_data 0 NULL NULL powCreateVector ${profile_gn}_cz_vector ${profile_gn}_cz_data 0 NULL NULL set powWCSName(${profile_gn}_xsec) $powWCSName($profile_gn) set powWCSName(${profile_gn}_xsecscope) $powWCSName($profile_gn) set powWCSList(${profile_gn}_xsec) $powWCSList($profile_gn) set powWCSList(${profile_gn}_xsecscope) $powWCSList($profile_gn) powCreateCurve ${profile_gn}_xsec_curve ${profile_gn}_cx_vector \ NULL ${profile_gn}_cz_vector NULL if ![info exists powPlotParam(xdimdisp,${profile_gn}_xsec)] { set powPlotParam(xdimdisp,${profile_gn}_xsec) 200 set powPlotParam(ydimdisp,${profile_gn}_xsec) 200 } set powWCSName(${profile_gn}_xsec_curve) $powWCSName($profile_gn) set powWCSList(${profile_gn}_xsec_curve) $powWCSList($profile_gn) set powFitsHeader(${profile_gn}_xsec) $powFitsHeader($profile_gn) set powFitsHeaderCnt(${profile_gn}_xsec) $powFitsHeaderCnt($profile_gn) set powPlotParam(graphType,${profile_gn}_xsec) "binary" set powPlotParam(zoomed,${profile_gn}_xsec) 0 set xCount(${profile_gn}_xsec) 0 set yCount(${profile_gn}_xsec) 0 set powFitsHeader(${profile_gn}_xsec_curve) $powFitsHeader($profile_gn) set powFitsHeaderCnt(${profile_gn}_xsec_curve) $powFitsHeaderCnt($profile_gn) set powPlotParam(graphType,${profile_gn}_xsec_curve) "binary" set powPlotParam(zoomed,${profile_gn}_xsec_curve) 0 set xCount(${profile_gn}_xsec_curve) 0 set yCount(${profile_gn}_xsec_curve) 0 set powFitsHeader(${profile_gn}_xsecscope) $powFitsHeader($profile_gn) set powFitsHeaderCnt(${profile_gn}_xsecscope) $powFitsHeaderCnt($profile_gn) set powPlotParam(graphType,${profile_gn}_xsecscope) "binary" set powPlotParam(zoomed,${profile_gn}_xsecscope) 0 set xCount(${profile_gn}_xsecscope) 0 set yCount(${profile_gn}_xsecscope) 0 set powWCS(${profile_gn}_xsec) {{0.0 0.0} {0.0 0.0} {1.0 -0.0 0.0 1.0} {{} {}} {{} {}}} set powWCS(${profile_gn}_xsec_curve) {{0.0 0.0} {0.0 0.0} {1.0 -0.0 0.0 1.0} {{} {}} {{} {}}} powCreateGraph ${profile_gn}_xsec ${profile_gn}_xsec_curve NULL \ $xunit NULL $xlabel Counts \ $powPlotParam(xdimdisp,${profile_gn}_xsec) \ $powPlotParam(ydimdisp,${profile_gn}_xsec) powSetCurveOptions ${profile_gn}_xsec ${profile_gn}_xsec_curve pDisp No powSetCurveOptions ${profile_gn}_xsec ${profile_gn}_xsec_curve lDisp Yes powSetCurveOptions ${profile_gn}_xsec ${profile_gn}_xsec_curve lStyle " " } proc ProfileCallback { obj msg } { global powDWP global powFitsHeader powFitsHeaderCnt global currgn set xdlg ${powDWP}xdlg if ![winfo exists $xdlg ] { return } if {$msg == "shapeIsBeingModified"} { UpdateProfile $obj } if {$msg == "shapeHasChanged"} { DrawProfile $obj UpdateProfile $obj } } proc ProfileDlg {} { global currgn global currimg global powbg global powDWP global powWCS powFitsHeader powFitsHeaderCnt global profile_gn global profile_img global profileRegion global profileWidth global profileHeight global g_titleFont global profileFile global powRotation global storePowRotation set xdlg ${powDWP}xdlg if [winfo exists $xdlg ] { focus $xdlg raise $xdlg return } if ![info exists currimg ] { tk_messageBox -type ok -icon error \ -message "Select an image first." return } powToplevel $xdlg .pow "-width 200 -bg $powbg" wm title $xdlg "Profile" frame $xdlg.frame -borderwidth 4 frame $xdlg.frame.title -width 300 frame $xdlg.frame.row0 frame $xdlg.frame.row1 frame $xdlg.frame.row2 label $xdlg.frame.title.title -text "Profile:" -background yellow \ -relief flat -width 8 -anchor w -font g_titleFont button $xdlg.frame.title.help -text Help -anchor e \ -command {powHelp Profile.html} -font g_titleFont label $xdlg.frame.row0.holder -text "" -width 18 \ -anchor w -relief flat -font g_titleFont label $xdlg.frame.row0.start -text "Start" -width 25 \ -anchor w -relief flat -font g_titleFont label $xdlg.frame.row0.stop -text "Stop" -width 25 -anchor w -relief flat -font g_titleFont label $xdlg.frame.row1.pixelname -text "Image Pixel:" \ -width 18 -relief flat -anchor w -font g_titleFont label $xdlg.frame.row1.pix1 -justify left -anchor w \ -relief sunken -width 25 -font g_titleFont label $xdlg.frame.row1.pix2 -justify left -anchor w \ -relief sunken -width 25 -font g_titleFont label $xdlg.frame.row2.graphname -text "Graph coordinates:" \ -width 18 -relief flat -anchor w -font g_titleFont label $xdlg.frame.row2.graph1 -justify left -anchor w \ -relief sunken -width 25 -font g_titleFont label $xdlg.frame.row2.graph2 -justify left -anchor w \ -relief sunken -width 25 -font g_titleFont button $xdlg.frame.save -text Record -command { SaveProfile } -font g_titleFont button $xdlg.frame.close -text Exit -command { global storePowRotation global currimg global powRotation if { [info exists currimg] && [info exists storePowRotation($currimg)] } { set powRotation($currimg) $storePowRotation($currimg) } if [info exists profileFile] { unset profileFile } ; \ itcl::delete object $profileRegion ; \ destroy ${powDWP}xdlg ; \ } -font g_titleFont pack $xdlg.frame.title.title -side left -anchor w pack $xdlg.frame.title.help -side right -anchor e pack $xdlg.frame.row0.holder -side left pack $xdlg.frame.row0.start -side left pack $xdlg.frame.row0.stop -side left pack $xdlg.frame.row1.pixelname -side left pack $xdlg.frame.row1.pix1 -side left pack $xdlg.frame.row1.pix2 -side left pack $xdlg.frame.row2.graphname -side left pack $xdlg.frame.row2.graph1 -side left pack $xdlg.frame.row2.graph2 -side left pack $xdlg.frame.title -anchor w -pady 5 -padx 2 -fill x pack $xdlg.frame.row0 -anchor w -pady 2 -padx 2 pack $xdlg.frame.row1 -anchor w -pady 2 -padx 2 pack $xdlg.frame.row2 -anchor w -pady 2 -padx 2 pack $xdlg.frame.save -expand 1 -side left -anchor w -pady 5 -padx 2 pack $xdlg.frame.close -expand 1 -side right -anchor e -pady 5 -padx 2 pack $xdlg.frame set profileRegion [gRegionList $currgn .pow.pow] $profileRegion setOwner ProfileCallback $profileRegion setAllowsMultiple 0 $profileRegion setDefault "+" Line set profile_gn $currgn set profile_img $currimg set temp [ powFetchImageInfoHash $profile_img ] set temp [split $temp ] set profileWidth [lindex $temp 3] set profileHeight [lindex $temp 5] set halfx [expr round($profileWidth*0.5) ] set halfy [expr round($profileHeight*0.5) ] set gx0 [expr round($halfx*0.5) + 1] set gy0 [expr round($halfy*0.5) + 1] set gx1 [expr round($halfx*1.5) + 1] set gy1 [expr round($halfy*1.5) + 1] set descr [list $gx0 $gy0 $gx1 $gy1] if [info exists powRotation($currimg)] { set storePowRotation($currimg) $powRotation($currimg) catch { unset powRotation($currimg) } } $profileRegion addRegion + Line $descr pixels set elem [ $profileRegion rgnAtIndex 0] bind $xdlg <> { if [info exists profileFile] { unset profileFile } itcl::delete object profileRegion destroy ${powDWP}xdlg } tkwait window $xdlg } proc SaveProfile {} { global xlist global zlist global profileFile global graphCoordList if { ![info exists profileFile ] || $profileFile == "" } { set profileFile [tk_getSaveFile -initialfile "powProfile.txt" -filetypes {{ASCII Text .txt}}] if [file exists $profileFile] { file delete -force $profileFile } } if {$profileFile == "" } { unset profileFile return } set probeNewFile [file exists $profileFile] set fprofile [open $profileFile a] foreach ele $graphCoordList x $xlist z $zlist { set v1 [lindex $ele 0] set v2 [lindex $ele 1] set v3 $x set v4 $z #puts "v1: $v1, v2: $v2, v3: $v3, v4: $v4" if { $v1 == "NULL" } { set v1 0.0 } if { $v2 == "NULL" } { set v2 0.0 } if { $v3 == "NULL" } { set v3 0.0 } if { $v4 == "NULL" } { set v4 0.0 } set temp [format "%-10.7g %-10.7g %-d %-10.7g" $v1 $v2 $v3 $v4] #puts "data: $temp" puts $fprofile $temp } close $fprofile } fv5.5/tcltk/pow/powRegion.h0000644000220700000360000000331713224715130014567 0ustar birbylhea/***************************************************************/ /* REGION STUFF */ /***************************************************************/ #define myPI 3.1415926535897932385 typedef struct { int exists; double xrefval, yrefval; double xrefpix, yrefpix; double xinc, yinc; double rot; char type[6]; } WCSdataX; typedef enum { point_rgn, line_rgn, circle_rgn, annulus_rgn, ellipse_rgn, elliptannulus_rgn, box_rgn, rectangle_rgn, diamond_rgn, sector_rgn, poly_rgn } shapeType; typedef enum { pixel_fmt, degree_fmt, hhmmss_fmt } coordFmt; typedef struct { char sign; /* Include or exclude? */ shapeType shape; /* Shape of this region */ union { /* Parameters - In pixels */ /**** Generic Shape Data ****/ struct { double p[8]; /* Region parameters */ double sinT, cosT; /* For rotated shapes */ double a, b; /* Extra scratch area */ } gen; /**** Polygon Data ****/ struct { int nPts; /* Number of Polygon pts */ double *Pts; /* Polygon points */ double xmin,xmax; /* Polygon bounding box */ double ymin,ymax; } poly; } param; } RgnShape; typedef struct { int nShapes; RgnShape *Shapes; WCSdataX wcs; } SAORegion; #ifdef __cplusplus extern "C" { #endif int fits_read_rgnfile( const char *filename, WCSdataX *wcs, SAORegion **Rgn, int *status ); int fits_in_region( double X, double Y, SAORegion *Rgn ); void fits_free_region( SAORegion *Rgn ); #ifdef __cplusplus } #endif fv5.5/tcltk/pow/powRgn.tcl0000644000220700000360000016263013224715130014431 0ustar birbylhea################################################################### # # TCL routines handling creation and manipulation of SAO regions # ################################################################### # variables used: # regionParam(rgns): RegionList object containing objects # regionParam(currSign) : current sign (+/-) # regionParam(currShape): current shape (Circle, etc) # regionParam(supportedShapes): list of valid shapes # regionParam(format): "Linear", "FK5 ()", etc # regionParam(degreeFormat): "decimal" or "hhmmss" # gn proc powRegion { } { #puts "powRegion start" global heraQueryEntry g_fvHera global powPlotParam regionParam powbg currgn currimg global powFrameForTop global powDWP availableColor global negSignLineColor negSignHandleColor posSignLineColor posSignHandleColor global d_negSignLineColor d_negSignHandleColor d_posSignLineColor d_posSignHandleColor global g_titleFont global powLutButton buttonWndw powROIButton global old_powLutButton old_powROIButton global propertyOrder set propertyOrder "Source" if {[winfo exists ${powDWP}region]} { catch {raise ${powDWP}region} return } set old_powLutButton $powLutButton set old_powROIButton $powROIButton set posSignLineColor blue set posSignHandleColor green set negSignLineColor red set negSignHandleColor yellow set d_posSignLineColor blue set d_posSignHandleColor green set d_negSignLineColor red set d_negSignHandleColor yellow powSetupRegions $currgn $regionParam(rgns) activate powToplevel ${powDWP}region .pow "-bg $powbg" bind ${powDWP}region "powRegionChangeColor all -1.0" bind ${powDWP}region <> "destroy ${powDWP}region" catch {wm title ${powDWP}region "Edit Region"} catch {wm geometry ${powDWP}region +500+240} ${powDWP}region config -menu ${powDWP}region.mbar menu ${powDWP}region.mbar -postcommand "powEvents::generate <>" -bg $powbg -font g_titleFont ${powDWP}region.mbar add cascade -menu ${powDWP}region.mbar.file -label "Property" -font g_titleFont ${powDWP}region.mbar add command -label "Help" -font g_titleFont -command { powHelp Regions.html } set m [menu ${powDWP}region.mbar.file] $m add radio -label Source -variable [itcl::scope propertyOrder] -value Source \ -command { powSetupRegionProperty } $m add radio -label Background -variable [itcl::scope propertyOrder] -value Background \ -command { powSetupRegionProperty } frame ${powDWP}region.list -bg $powbg scrollbar ${powDWP}region.list.scrolly -orient vertical \ -command {${powDWP}region.list.rgns yview} -bg $powbg scrollbar ${powDWP}region.list.scrollx -orient horizontal \ -command {${powDWP}region.list.rgns xview} -bg $powbg listbox ${powDWP}region.list.rgns -width 30 -height 6 \ -selectmode browse -bg $powbg -exportselection 0 \ -yscrollcommand "${powDWP}region.list.scrolly set " \ -xscrollcommand "${powDWP}region.list.scrollx set " -font g_titleFont bind ${powDWP}region.list.rgns \ {powSelectRegion [${powDWP}region.list.rgns curselection]} grid ${powDWP}region.list.rgns -row 1 -column 1 -sticky news -columnspan 4 grid ${powDWP}region.list.scrolly -row 1 -column 5 -sticky news grid ${powDWP}region.list.scrollx -row 2 -column 1 -sticky news grid rowconfigure ${powDWP}region.list 1 -weight 1 grid columnconfigure ${powDWP}region.list 1 -weight 1 update idletasks ${powDWP}region.list.rgns configure -height 3 frame ${powDWP}region.currshape -bg $powbg -bd 4 -relief groove frame ${powDWP}region.currshape.f1 -bg $powbg label ${powDWP}region.currshape.f1.lbl -text "Current Shape: " -bg $powbg -font g_titleFont button ${powDWP}region.currshape.f1.apply -text "Apply" -bg $powbg \ -command {powChangeRegion} -highlightthickness 0 -font g_titleFont button ${powDWP}region.currshape.f1.delete -text "Delete" -bg $powbg \ -command {powDeleteCurrRegion} -highlightthickness 0 -font g_titleFont pack ${powDWP}region.currshape.f1.lbl -in ${powDWP}region.currshape.f1 \ -side left pack ${powDWP}region.currshape.f1.apply -in ${powDWP}region.currshape.f1 \ -side right -padx 5 pack ${powDWP}region.currshape.f1.delete -in ${powDWP}region.currshape.f1 \ -side right -padx 5 frame ${powDWP}region.control -bg $powbg -bd 4 -relief groove label ${powDWP}region.control.label -text "Set right mouse button to control:" -font g_titleFont radiobutton ${powDWP}region.control.zoom -variable buttonSelection -text "Zoom/unZoom Region" \ -font [list Helvetica 10] -value left \ -command {powButtonSelection ${powDWP}region.control.brightness \ ${powDWP}region.control.zoom Left} radiobutton ${powDWP}region.control.brightness -variable buttonSelection -text "Brightness/Contrast" \ -font [list Helvetica 10] -value right \ -command {powButtonSelection ${powDWP}region.control.brightness \ ${powDWP}region.control.zoom Right} grid ${powDWP}region.control.label -row 0 -column 0 -columnspan 3 grid ${powDWP}region.control.zoom -row 1 -column 1 -sticky w grid ${powDWP}region.control.brightness -row 2 -column 1 -sticky w ${powDWP}region.control.zoom select powButtonSelection ${powDWP}region.control.brightness ${powDWP}region.control.zoom Left frame ${powDWP}region.currshape.f2 -bg $powbg menu ${powDWP}region.shapemenu -tearoff 0 -bg $powbg set regionParam(supportedShapes) \ [list Box Circle Ellipse Polygon Line Point] foreach s $regionParam(supportedShapes) { ${powDWP}region.shapemenu add command -label $s \ -command "powChangeShape $s" -font g_titleFont } button ${powDWP}region.currshape.f2.shapebut \ -textvariable regionParam(currShape) -highlightthickness 0 \ -bg $powbg -relief raised -width 8 -font g_titleFont bind ${powDWP}region.currshape.f2.shapebut { tk_popup ${powDWP}region.shapemenu \ [winfo pointerx ${powDWP}region.shapemenu] \ [winfo pointery ${powDWP}region.shapemenu] \ [lsearch -exact $regionParam(supportedShapes) \ $regionParam(currShape) ] ${powDWP}region.currshape.f2.shapebut configure -relief raised } entry ${powDWP}region.currshape.f2.desc -bg $powbg -font g_titleFont button ${powDWP}region.currshape.f2.signbut \ -textvariable regionParam(currSign) -highlightthickness 0 \ -bg $powbg -relief raised -width 1 \ -command { powToggleSign } -font g_titleFont set availableColor [list black blue green red yellow lightblue lightgreen lightyellow] tixComboBox ${powDWP}region.currshape.f2.lineColor -label "Line Color:" -dropdown true -editable true \ -option { font {Helvetica -11} \ entry.width 7 \ entry.background blue \ label.anchor w \ entry.anchor e \ } \ -command { powRegionChangeColor ${powDWP}region.currshape.f2.lineColor } foreach color $availableColor { ${powDWP}region.currshape.f2.lineColor insert end $color } tixSetSilent ${powDWP}region.currshape.f2.lineColor blue [${powDWP}region.currshape.f2.lineColor subwidget label] configure -background $powbg set swLineWidget [${powDWP}region.currshape.f2.lineColor subwidget entry] bind $swLineWidget { powRegionChangeColor ${powDWP}region.currshape.f2.lineColor -1.0 } tixComboBox ${powDWP}region.currshape.f2.handleColor -label "Handle Color:" -dropdown true -editable true \ -bg $powbg \ -option { font {Helvetica -11} \ entry.width 7 \ entry.background green \ label.anchor w \ entry.anchor e \ } \ -command { powRegionChangeColor ${powDWP}region.currshape.f2.handleColor } foreach color $availableColor { ${powDWP}region.currshape.f2.handleColor insert end $color } tixSetSilent ${powDWP}region.currshape.f2.handleColor green [${powDWP}region.currshape.f2.handleColor subwidget label] configure -background $powbg set swHandleWidget [${powDWP}region.currshape.f2.handleColor subwidget entry] bind $swHandleWidget { powRegionChangeColor ${powDWP}region.currshape.f2.handleColor -1.0 } #pack ${powDWP}region.currshape.f2.signbut -in ${powDWP}region.currshape.f2 -side left -padx 1 #pack ${powDWP}region.currshape.f2.shapebut -in ${powDWP}region.currshape.f2 -side left -padx 1 #pack ${powDWP}region.currshape.f2.lineColor -in ${powDWP}region.currshape.f2 -side left -padx 1 #pack ${powDWP}region.currshape.f2.desc -in ${powDWP}region.currshape.f2 -side left -padx 1 -fill x -expand 1 grid ${powDWP}region.currshape.f2.signbut -row 0 -column 0 -sticky w grid ${powDWP}region.currshape.f2.shapebut -row 0 -column 1 -sticky w grid ${powDWP}region.currshape.f2.desc -row 0 -column 2 -sticky we -columnspan 4 grid ${powDWP}region.currshape.f2.lineColor -row 1 -column 0 -sticky w -columnspan 2 grid ${powDWP}region.currshape.f2.handleColor -row 1 -column 2 -sticky w -columnspan 2 # Build format controls frame ${powDWP}region.radiobtns -bg $powbg -bd 4 -relief groove label ${powDWP}region.radiobtns.lbl -text "Format:" -bg $powbg -font g_titleFont menu ${powDWP}region.radiobtns.formatmenu -tearoff 0 -bg $powbg -font g_titleFont set regionParam(supportedFormats) [$regionParam(rgns) getAllFormats] foreach s $regionParam(supportedFormats) { ${powDWP}region.radiobtns.formatmenu add command -label $s \ -command [list powChangeFormat $s] -font [list Helvetica 10] } ${powDWP}region.radiobtns.formatmenu add separator ${powDWP}region.radiobtns.formatmenu add radiobutton \ -label "Decimal Degrees" -variable regionParam(degreeFormat) \ -command [list powChangeFormat "Decimal"] -value "decimal" -font [list Helvetica 10] ${powDWP}region.radiobtns.formatmenu add radiobutton \ -label "HHMMSS Degrees" -variable regionParam(degreeFormat) \ -command [list powChangeFormat "HHMMSS"] -value "hhmmss" -font [list Helvetica 10] button ${powDWP}region.radiobtns.btn \ -textvariable regionParam(format) -highlightthickness 0 \ -bg $powbg -relief raised -width 10 -font [list Helvetica 10] bind ${powDWP}region.radiobtns.btn { tk_popup ${powDWP}region.radiobtns.formatmenu \ [winfo pointerx ${powDWP}region.radiobtns.formatmenu] \ [winfo pointery ${powDWP}region.radiobtns.formatmenu] \ [lsearch -exact $regionParam(supportedFormats) \ $regionParam(format) ] ${powDWP}region.radiobtns.btn configure -relief raised -font [list Helvetica 10] } grid ${powDWP}region.radiobtns.lbl -column 0 -row 0 -sticky w grid ${powDWP}region.radiobtns.btn -column 0 -row 1 # Build Flux Panel frame ${powDWP}region.fluxprobe -bg $powbg -bd 4 -relief groove label ${powDWP}region.fluxprobe.label -text "Statistics:" -anchor w -font g_titleFont -bg $powbg iwidgets::labeledwidget ${powDWP}region.fluxprobe.pixels -labeltext "N pixels:" \ -labelfont g_titleFont -background $powbg set childsite [${powDWP}region.fluxprobe.pixels childsite] label $childsite.c -width 30 -relief sunken -font g_titleFont -bg $powbg pack $childsite.c -side left iwidgets::labeledwidget ${powDWP}region.fluxprobe.flux -labeltext "Total Flux:" \ -labelfont g_titleFont -background $powbg set childsite [${powDWP}region.fluxprobe.flux childsite] label $childsite.c -width 30 -relief sunken -font g_titleFont -bg $powbg pack $childsite.c -side left iwidgets::labeledwidget ${powDWP}region.fluxprobe.mean -labeltext "Mean Flux:" \ -labelfont g_titleFont -background $powbg set childsite [${powDWP}region.fluxprobe.mean childsite] label $childsite.c -width 30 -relief sunken -font g_titleFont -bg $powbg label $childsite.label -text "+- error" -anchor w -font g_titleFont -bg $powbg pack $childsite.c $childsite.label -side left iwidgets::Labeledwidget::alignlabels ${powDWP}region.fluxprobe.pixels \ ${powDWP}region.fluxprobe.flux \ ${powDWP}region.fluxprobe.mean grid ${powDWP}region.fluxprobe.label -column 0 -row 0 -columnspan 10 -sticky nsw grid ${powDWP}region.fluxprobe.pixels -column 0 -row 1 -columnspan 10 -sticky nsw grid ${powDWP}region.fluxprobe.flux -column 0 -row 2 -columnspan 10 -sticky nsw grid ${powDWP}region.fluxprobe.mean -column 0 -row 3 -columnspan 10 -sticky nsw # frame ${powDWP}region.btns -bg $powbg button ${powDWP}region.btns.exit -text "Exit" \ -command "destroy ${powDWP}region" \ -bg $powbg -highlightthickness 0 -font g_titleFont button ${powDWP}region.btns.clear -text "Clear All" -command powClearRegions \ -bg $powbg -highlightthickness 0 -font g_titleFont button ${powDWP}region.btns.save -text "Save..." -command powSaveRegionFile \ -bg $powbg -highlightthickness 0 -font g_titleFont button ${powDWP}region.btns.open -text "Open..." -command powOpenRegionFile \ -bg $powbg -highlightthickness 0 -font g_titleFont if { ![info exists heraQueryEntry] && !([info exists g_fvHera] && $g_fvHera > 0) } { pack ${powDWP}region.btns.open -in ${powDWP}region.btns -side left -padx 7 } pack ${powDWP}region.btns.save -in ${powDWP}region.btns -side left -padx 7 pack ${powDWP}region.btns.clear -in ${powDWP}region.btns -side left -padx 7 pack ${powDWP}region.btns.exit -in ${powDWP}region.btns -side left -padx 7 grid ${powDWP}region.list -in ${powDWP}region -column 1 -row 1 -sticky news -columnspan 5 grid ${powDWP}region.currshape -in ${powDWP}region -column 1 -row 5 -sticky ew -columnspan 5 grid ${powDWP}region.currshape.f1 -in ${powDWP}region.currshape -column 1 -row 0 -sticky ew -padx 5 -pady 5 grid ${powDWP}region.currshape.f2 -in ${powDWP}region.currshape -column 1 -row 1 -sticky ew -padx 5 -pady 5 grid ${powDWP}region.radiobtns -in ${powDWP}region -column 1 -row 11 -sticky news -rowspan 3 grid ${powDWP}region.control -in ${powDWP}region -column 2 -row 11 -sticky news -columnspan 4 -rowspan 3 grid ${powDWP}region.fluxprobe -column 0 -row 15 -columnspan 5 -rowspan 4 -sticky news grid ${powDWP}region.btns -in ${powDWP}region -column 1 -row 19 -pady 5 -columnspan 5 grid columnconfigure ${powDWP}region 1 -weight 1 grid columnconfigure ${powDWP}region.currshape 1 -weight 1 grid columnconfigure ${powDWP}region.currshape.f2 2 -weight 1 grid rowconfigure ${powDWP}region 1 -weight 1 grid rowconfigure ${powDWP}region 11 -minsize 5 grid rowconfigure ${powDWP}region 15 -minsize 10 # catch {wm minsize ${powDWP}region 300 400} ######### # Now setup bindings ######### .pow.pow bind shape {powRegion} bind ${powDWP}region.list.rgns {powExitRegionDlg} foreach wndw [list .pow ${powDWP}region] { bind $wndw { powShiftRegion 0 -1 } bind $wndw { powShiftRegion -1 0 } bind $wndw { powShiftRegion 1 0 } bind $wndw { powShiftRegion 0 1 } bind $wndw { powShiftRegion 0 -10 } bind $wndw { powShiftRegion -10 0 } bind $wndw { powShiftRegion 10 0 } bind $wndw { powShiftRegion 0 10 } } powUpdateRegionDlg update idletasks scan [winfo geometry .pow] "%dx%d+%d+%d" Pw Ph Px Py #set width [winfo reqwidth ${powDWP}region.control] #set width [expr [winfo reqwidth ${powDWP}region.radiobtns] + $width + 2] set width [expr [winfo reqwidth ${powDWP}region.fluxprobe] + 2] scan [winfo geometry ${powDWP}region] "%dx%d+%d+%d" Rw Rh Rx Ry catch { wm geometry ${powDWP}region ${width}x$Rh+[expr $Px + $Pw - 15 ]+$Py } err [gNotifications default] addObserver \ powRegionNotify notify * graphHasBeenUnselected [gNotifications default] addObserver \ powRegionNotify notify * graphHasBeenSelected [gNotifications default] addObserver \ powRegionNotify notify * graphHasBeenDestroyed } proc powSetupRegionProperty { } { global regionParam global propertyOrder set rgnIdx [$regionParam(rgns) selected] if { $rgnIdx < 0 } return set rgn [$regionParam(rgns) rgnAtIndex $rgnIdx] $rgn setPropertyOrder $propertyOrder powSelectRegion $rgnIdx } proc powSetupRegions { gn } { global regionParam powPlotParam set regionParam(gn) $gn if { [info exists powPlotParam(regions,$gn)] } { set regionParam(rgns) $powPlotParam(regions,$gn) $regionParam(rgns) activate } else { set regionParam(rgns) [gRegionList $gn .pow.pow] $regionParam(rgns) setOwner powRegionOwner set powPlotParam(regions,$gn) $regionParam(rgns) } } proc powRegionResetPanelColor { lineColor handleColor } { global powDWP [${powDWP}region.currshape.f2.lineColor subwidget entry] configure -background $lineColor [${powDWP}region.currshape.f2.handleColor subwidget entry] configure -background $handleColor powRegionChangeColor all -1.0 } proc powRegionChangeColor { wndw value } { global regionParam powDWP availableColor global negSignLineColor negSignHandleColor posSignLineColor posSignHandleColor if { $wndw == "all" } { set swEntry [${powDWP}region.currshape.f2.handleColor subwidget entry] $regionParam(rgns) setHandleColor [$swEntry cget -background] $swEntry delete 0 end set swEntry [${powDWP}region.currshape.f2.lineColor subwidget entry] $regionParam(rgns) setOutlineColor [$swEntry cget -background] $swEntry delete 0 end } else { set swEntry [$wndw subwidget entry] $swEntry delete 0 end if { $value == -1.0 } { set value [$swEntry cget -background] } else { set idx [lsearch -exact $availableColor $value] if { $idx < 0 } { # not on the availableColor list $swEntry delete 0 end set value [$swEntry cget -background] } else { $swEntry configure -background $value } } $swEntry configure -background $value if { $wndw == "${powDWP}region.currshape.f2.lineColor" } { $regionParam(rgns) setOutlineColor $value } elseif { $wndw == "${powDWP}region.currshape.f2.handleColor" } { $regionParam(rgns) setHandleColor $value } } if { $regionParam(currSign) == "+" } { set posSignLineColor [[${powDWP}region.currshape.f2.lineColor subwidget entry] cget -background] set posSignHandleColor [[${powDWP}region.currshape.f2.handleColor subwidget entry] cget -background] } else { set negSignLineColor [[${powDWP}region.currshape.f2.lineColor subwidget entry] cget -background] set negSignHandleColor [[${powDWP}region.currshape.f2.handleColor subwidget entry] cget -background] } } proc powUpdateRegionDlg { { selectGn "" } } { global regionParam powDWP global currentRegionObj global powPlotParam if { $selectGn != "" } { set regionParam(gn) $selectGn } set gn $regionParam(gn) #change rgn as well if [info exists powPlotParam(regions,$gn)] { set regionParam(rgns) $powPlotParam(regions,$gn) set regionParam(format) [$regionParam(rgns) getCoordSys] set currentRegionObj [$regionParam(rgns) getObj] } if { [$regionParam(rgns) count]==0 } { set regionParam(currRgn) "" set regionParam(currSign) "+" set regionParam(currShape) "Circle" if { [powWCSexists $gn] } { # Dont set default regions # $regionParam(rgns) setCoordSys fk5 set regionParam(degreeFormat) "hhmmss" } else { $regionParam(rgns) setCoordSys linear set regionParam(degreeFormat) "decimal" } } if { [powWCSexists $gn] } { set wcsState normal set linState disabled } else { set wcsState disabled set linState normal } foreach itm [list FK4 FK5 Gal Ecl IC Deg] { ${powDWP}region.radiobtns.formatmenu entryconfigure "${itm}*" \ -state $wcsState } ${powDWP}region.radiobtns.formatmenu entryconfigure "Lin*" \ -state $linState powUpdateRegionList powUpdateRegionTitle } proc powExitRegionDlg { } { global regionParam powPlotParam global powDWP waitFlag global old_powLutButton powLutButton powROIButton old_powROIButton set waitFlag unsave destroy ${powDWP}region if { [itcl::find objects $regionParam(rgns)] != "" } { if { [$regionParam(rgns) count]==0 || ![winfo exists .pow.pow] } { itcl::delete object $regionParam(rgns) unset powPlotParam(regions,$regionParam(gn)) } else { $regionParam(rgns) deleteAll $regionParam(rgns) deactivate itcl::delete object $regionParam(rgns) unset powPlotParam(regions,$regionParam(gn)) } } [gNotifications default] removeObserver \ powRegionNotify notify * if [info exists old_powLutButton] { set powLutButton $old_powLutButton set powROIButton $old_powROIButton powSaveConfig } } proc powRegionNotify { dmy obj msg args } { global powDWP regionParam currgn powPlotParam switch -- $msg { "graphHasBeenSelected" { if { [winfo exists ${powDWP}region] } { if { $regionParam(gn)==$obj } { # If graph hasn't actually changed, just call the activate # method so that all the shapes/drawables get raised to top $regionParam(rgns) activate } else { powSetupRegions $obj powUpdateRegionDlg } } } "graphHasBeenUnselected" { if { [info exists powPlotParam(regions,$obj)] } { set rgnList $powPlotParam(regions,$obj) $rgnList deactivate if { [$rgnList count]==0 } { unset powPlotParam(regions,$obj) itcl::delete object $rgnList } } } "graphHasBeenDestroyed" { if { [info exists powPlotParam(regions,$obj)] } { set rgnList $powPlotParam(regions,$obj) unset powPlotParam(regions,$obj) itcl::delete object $rgnList if { $regionParam(gn)==$obj } { set regionParam(gn) "" } } } } } proc powRegionOwner { obj msg } { global regionParam global currentRegionObj switch $msg { "selectionHasChanged" { powUpdateSelectedRegion } "shapeIsBeingModified" { } "shapeHasChanged" { set idx [$regionParam(rgns) indexOfRgn $obj] if { $idx == -1 } return powUpdateRegionList $idx } "regionsHaveChanged" { powUpdateRegionList } } } proc powShiftRegion { dx dy } { global regionParam if { [info exists regionParam(rgns)] \ && [itcl::find objects $regionParam(rgns)]!="" } { set idx [$regionParam(rgns) selected] [$regionParam(rgns) rgnAtIndex $idx] shift $dx $dy } } proc powUpdateRegionTitle { {outputfile ""} } { global regionParam global powDWP if { $outputfile == "" } { set fName [$regionParam(rgns) filename] if { $fName!="" } { # ${powDWP}region.head.title configure \ -text "Regions for $regionParam(gn) ([file tail $fName])" } else { # ${powDWP}region.head.title configure -text "Regions for $regionParam(gn)" } } else { # catch { ${powDWP}region.head.title configure -text "Regions for $regionParam(gn) ([file tail $outputfile])" } } } proc powSaveRegionFile { } { global regionParam currimg powDWP global regionOutputFileName global heraClientObj heraClientUploadDirList # g_fvHera is defined in fvApp of fv and it indicates that POW is # used in a Hera client. global heraQueryEntry g_fvHera global waitFlag g_backupDir global newUploadFileName set filenameList [list "src.reg"] for {set i 0} {$i<[$regionParam(rgns) count]} {incr i} { set rgn [$regionParam(rgns) rgnAtIndex $i] set propertyOrder [$rgn getPropertyOrder] if { $propertyOrder == "Background" } { lappend filenameList "back.reg" break } } for {set i 0} {$i < [llength $filenameList]} {incr i} { if { $i == 0 } { # file list: source, background set fName [$regionParam(rgns) filename] set property "Source" } else { set fName [$regionParam(rgns) bfilename] set property "Background" } if { $fName!="" } { set defFile [file tail $fName] } else { if { [info exists regionOutputFileName] && $regionOutputFileName != "" } { set defFile [file tail $regionOutputFileName] } else { set defFile [lindex $filenameList $i] } } if { [info exists heraQueryEntry] || ([info exists g_fvHera] && $g_fvHera > 0) } { set newUploadFileName [file tail $defFile] powRenameFile $defFile vwait newUploadFileName set defFile $newUploadFileName $regionParam(rgns) writeToFile "$g_backupDir/[file tail $defFile]" $regionParam(degreeFormat) $property set idx [lsearch $heraClientUploadDirList [list "*" [file tail $defFile]] ] set heraClientUploadDir [lindex [lindex $heraClientUploadDirList $idx] 0] eval $heraClientObj uploadFileVirtual {$g_backupDir/[file tail $defFile]} $heraClientUploadDir eval $heraClientObj receiveOutput "refreshDir .$heraClientUploadDir" file delete -force $g_backupDir/[file tail $defFile] set waitFlag save } else { if { [info exists regionOutputFileName] && $regionOutputFileName != "" } { set filename $regionOutputFileName } else { set filename [tk_getSaveFile -initialfile "$defFile"] } if {$filename == "" } { set waitFlag unsave return } $regionParam(rgns) writeToFile $filename $regionParam(degreeFormat) $property powUpdateRegionTitle set waitFlag save } } } proc powRenameFile { fileName } { global oldUploadFileName set oldUploadFileName $fileName set top .renameFile toplevel .renameFile wm geometry $top +[winfo pointerx .]+[winfo pointery .] wm title .renameFile "Rename Upload File Name" label $top.label -text "Rename file name if desired" -font g_titleFont label $top.entrylb -text "file name:" -font g_titleFont entry $top.entry -text "" -width 30 -background white -font g_titleFont grid $top.label -row 0 -column 0 -columnspan 5 -sticky nws grid $top.entrylb -row 1 -column 0 -sticky nws grid $top.entry -row 1 -column 1 -columnspan 4 -sticky nws frame $top.actionFrame set actionFrame $top.actionFrame button $actionFrame.ok -text "Save File" -command { powUpdateFileName } grid $actionFrame.ok -row 0 -column 4 grid $actionFrame -row 6 -column 0 -columnspan 10 -sticky news $top.entry delete 0 end $top.entry insert end [file tail $fileName] bind $top.entry { powUpdateFileName } } proc powUpdateFileName {} { global oldUploadFileName global newUploadFileName set fileDir [file dirname $oldUploadFileName] set fileName [string trim [.renameFile.entry get]] set newUploadFileName [format "%s/%s" $fileDir $fileName] destroy .renameFile } proc powOpenRegionFile { {fName "NONE"} } { global regionParam global powDWP set types { {{Region Files} {.reg} } {{All Files} * } } if { $fName == "NONE" } { set fName [$regionParam(rgns) filename] if { $fName!="" } { set defFile [file tail $fName] } else { set defFile "" } set filename [tk_getOpenFile -filetypes $types -initialfile $defFile] if {$filename == "" } return if { $regionParam(nItems) } { set act [tk_dialog ${powDWP}regionInquiry "Open Region File" \ "Region files already exist" warning 2 Cancel Overwrite Append] if { $act==-1 || $act==0 } {return} if { $act==1 } { $regionParam(rgns) deleteAll } } } else { set filename $fName } catch { $regionParam(rgns) readFromFile $filename } err catch { powUpdateRegionTitle } err } proc powUpdateRegionList { {idx -1} } { global regionParam global powDWP global convertToFormat powRotation currentRotationList currimg if { ![winfo exists ${powDWP}region] } { return } set regionParam(format) [$regionParam(rgns) getCoordSys] set currItm [$regionParam(rgns) selected] if { $idx==-1 } { ${powDWP}region.list.rgns delete 0 end set theRgns [$regionParam(rgns) regions] set n 0 } else { set theRgns [$regionParam(rgns) rgnAtIndex $idx] set n $idx } foreach rgn $theRgns { foreach [list sign shape descr] \ [$regionParam(rgns) buildRegionStr $rgn $regionParam(degreeFormat)]\ {} #puts "regionParam(degreeFormat): $regionParam(degreeFormat)" #puts "readin descr: $descr" if [info exists convertToFormat] { if { ([string tolower $shape] == "box" || [string tolower $shape] == "ellipse") && [llength $descr] >= 5 } { switch $convertToFormat { "TO_SKY" { # convert from Pixel value to Sky coordinates, minus powRotation if { [info exists currimg] && [info exists powRotation($currimg)] } { set convrtRot [lindex [lindex $currentRotationList 0] $n] # set convrtRot [expr $convrtRot - $powRotation($currimg)] set descr [lreplace $descr end end $convrtRot] #puts "PIXEL_TO_SKY: descr: $descr" } } "TO_PIXEL" { # convert from Sky coordinates to Pixel value, add powRotation if { [info exists currimg] && [info exists powRotation($currimg)] } { set convrtRot [lindex [lindex $currentRotationList 0] $n] set convrtRot [expr $convrtRot + $powRotation($currimg)] set descr [lreplace $descr end end $convrtRot] #puts "SKY_TO_PIXEL: descr: $descr" } } default { } } } catch { unset convertToFormat } catch { unset currentRotationList } } elseif { [string first "(pixels)" [string tolower $regionParam(format)]] > 0 && \ [info exists currimg] && [info exists powRotation($currimg)] } { if { ([string tolower $shape] == "box" || [string tolower $shape] == "ellipse") && [llength $descr] >= 5 } { set rot [lindex $descr end] set descr [lreplace $descr end end [expr $rot + $powRotation($currimg)]] } } set descr "([join $descr {, }])" #puts "final descr: $descr" set txtDescr "$sign${shape}$descr" ${powDWP}region.list.rgns insert $n $txtDescr if { $n==$currItm } { set regionParam(currSign) $sign set regionParam(currShape) $shape set regionParam(currDescr) $descr ${powDWP}region.currshape.f2.desc delete 0 end ${powDWP}region.currshape.f2.desc insert 0 $descr } incr n } if { $idx!=-1 } { ${powDWP}region.list.rgns delete [expr $idx+1] } if { $currItm!=-1 } { ${powDWP}region.list.rgns selection set $currItm ${powDWP}region.list.rgns see $currItm } powCalculateImageFlux } proc powUpdateSelectedRegion { } { global regionParam powDWP set rgnIdx [$regionParam(rgns) selected] set rgn [$regionParam(rgns) rgnAtIndex $rgnIdx] if { [winfo exists ${powDWP}region] } { ${powDWP}region.currshape.f2.desc delete 0 end foreach [list sign shape descr] \ [$regionParam(rgns) buildRegionStr $rgn $regionParam(degreeFormat)]\ {} ${powDWP}region.currshape.f2.desc insert 0 "([join $descr {, }])" ${powDWP}region.list.rgns select clear 0 end ${powDWP}region.list.rgns select set $rgnIdx ${powDWP}region.list.rgns see $rgnIdx set regionParam(currSign) $sign set regionParam(currShape) $shape $regionParam(rgns) setDefault $sign $shape } powCalculateImageFlux } proc powSelectRegion { itemNo } { global regionParam global powDWP global propertyOrder if {$itemNo==""} {return} $regionParam(rgns) selectRegion $itemNo set rgn [$regionParam(rgns) rgnAtIndex $itemNo] set propertyOrder [$rgn getPropertyOrder] } proc powChangeFormat { newFormat } { global regionParam global currimg powRotation convertToFormat currentRotationList set format [string tolower [lindex $newFormat 0]] switch $format { # Changes to degreeFormat "decimal" - "hhmmss" { set regionParam(degreeFormat) $format } # Changes to format default { set fromSys [$regionParam(rgns) getCoordSys] set theRgns [$regionParam(rgns) regions] set currentRotationList {} foreach rgn $theRgns { foreach [list sign shape descr] \ [$regionParam(rgns) buildRegionStr $rgn $regionParam(degreeFormat)]\ {} lappend currentRotationList [list [lindex $descr end] $fromSys] } $regionParam(rgns) setCoordSys $newFormat set toSys [$regionParam(rgns) getCoordSys] set convertToFormat "NONE" if { [string first "Pixel" $fromSys] >= 0 && [string first "Pixel" $toSys] < 0 } { # convert from Pixel value to Sky coordinates, minus powRotation set convertToFormat "TO_SKY" } elseif { [string first "Pixel" $fromSys] < 0 && [string first "Pixel" $toSys] >= 0 } { # convert from Sky coordinates to Pixel value, add powRotation set convertToFormat "TO_PIXEL" } elseif { [string first "Pixel" $fromSys] >= 0 && [string first "Pixel" $toSys] >= 0 } { # convert from Pixel value to Pixel value, since value of rotation is from # origine plane, add powRotation set convertToFormat "TO_PIXEL" } } } powUpdateRegionList } proc powChangeShape { newShape } { global regionParam global powDWP set d [${powDWP}region.currshape.f2.desc get] if { [catch {set descr [$regionParam(rgns) parseRegionStr $d]} errMsg] } { set regionParam(currShape) $newShape $regionParam(rgns) setDefault \ $regionParam(currSign) $regionParam(currShape) ${powDWP}region.currshape.f2.desc delete 0 end return } foreach [list oldSign oldShape oldDescr oldUnits] $descr {} if {$oldShape==$newShape} {return} set rgn [gRegion $regionParam(gn) .pow.pow] $rgn setSign $oldSign $rgn setShape $oldShape $rgn setFunction $oldUnits $oldDescr set theta [$rgn getRotation] set stdDescr [$rgn getCoords] if {$oldShape=="Polygon"} { set sumX 0 set sumY 0 set sumXX 0 set sumYY 0 set sumXY 0 set cnt 0 foreach {x y} $stdDescr { set sumX [expr $sumX +$x] set sumY [expr $sumY +$y] set sumXX [expr $sumXX+$x*$x] set sumYY [expr $sumYY+$y*$y] set sumXY [expr $sumXY+$x*$y] incr cnt } set x1 [expr $sumX/$cnt] set y1 [expr $sumY/$cnt] set dx [expr sqrt($sumXX/$cnt-$x1*$x1)] set dy [expr sqrt($sumYY/$cnt-$y1*$y1)] set x2 [expr $x1+$dx] set y2 [expr $y1+$dy] set stdDescr [list $x1 $y1 $x2 $y2] } if {$newShape=="Polygon"} { set pts [$rgn getPolygon] set npts [expr [llength $pts]-3] set theta 0 set stdDescr [lrange $pts 0 $npts] } $rgn setRotation $theta $rgn setShape $newShape $rgn setCoords $stdDescr foreach [list sign shape descr] \ [$regionParam(rgns) buildRegionStr $rgn $regionParam(degreeFormat)]\ {} ${powDWP}region.currshape.f2.desc delete 0 end ${powDWP}region.currshape.f2.desc insert 0 "([join $descr {, }])" set regionParam(currShape) $shape $regionParam(rgns) setDefault $sign $shape itcl::delete object $rgn } proc powToggleSign { } { global regionParam powDWP global d_negSignLineColor d_negSignHandleColor d_posSignLineColor d_posSignHandleColor if {$regionParam(currSign)=="+"} { set regionParam(currSign) "-" } else { set regionParam(currSign) "+" } if { $regionParam(currSign) == "+" } { [${powDWP}region.currshape.f2.lineColor subwidget entry] configure -background $d_posSignLineColor [${powDWP}region.currshape.f2.handleColor subwidget entry] configure -background $d_posSignHandleColor } else { [${powDWP}region.currshape.f2.lineColor subwidget entry] configure -background $d_negSignLineColor [${powDWP}region.currshape.f2.handleColor subwidget entry] configure -background $d_negSignHandleColor } powRegionChangeColor all -1.0 $regionParam(rgns) setDefault $regionParam(currSign) $regionParam(currShape) } proc powChangeRegion { } { global regionParam global powDWP $regionParam(rgns) setDefault $regionParam(currSign) $regionParam(currShape) set descr [${powDWP}region.currshape.f2.desc get] if { [catch {set newDescr [\ $regionParam(rgns) parseRegionStr $descr \ ]}] } { return } foreach {sign shape descr units} $newDescr {} $regionParam(rgns) modifyRegion $sign $shape $descr $units } proc powDeleteCurrRegion { } { global regionParam $regionParam(rgns) deleteRegion [$regionParam(rgns) selected] } proc powClearRegions { {mode "manual"} } { global regionParam powDWP if { $mode == "manual" } { set act [tk_messageBox -message "Delete All regions?" -type yesno \ -default no] if { $act=="yes" } { $regionParam(rgns) deleteAll } } else { $regionParam(rgns) deleteAll } catch { set sta ${powDWP}region.fluxprobe set childsite [$sta.pixels childsite] $childsite.c configure -text "" set childsite [$sta.flux childsite] $childsite.c configure -text "" set childsite [$sta.mean childsite] $childsite.c configure -text "" } } ######### # # Handle region clipping # proc powConvPoly { P } { set PolyGrid "" set x [lindex $P 0] set y [lindex $P 1] for {set i 2} {$i<[llength $P]} {incr i 2} { set nextX [lindex $P $i] set nextY [lindex $P [expr $i+1]] set dx [expr ($nextX-$x)] set dy [expr ($nextY-$y)] if { $dx || $dy } { lappend PolyGrid [list $x $y $dx $dy] } set x $nextX set y $nextY } return $PolyGrid } proc powClipPolys { P1 P2 } { # # Find the intersect region of two polygons. P1 and P2 *must* be closed # (ie, P[0]==P[last]) without any adjacent duplicate entries (P[i]=P[i+1]) # If a polygon is irregular (eg, U-shaped), this routine may return a list # of lists of coordinates, mapping out the disjointed regions. set TINY 1e-9 set ONEPLUS [expr 1+$TINY] set ONEMNUS [expr 1-$TINY] set Poly1 [powConvPoly $P1] set Poly2 [powConvPoly $P2] set nPoly1 [llength $Poly1] set nPoly2 [llength $Poly2] set Ipts "" if { !$nPoly1 || !$nPoly2 } { if {$nPoly1 \ && [powPtInRgn [lindex P2 0] [lindex P2 1] $Poly1]} { return $P2 } elseif { $nPoly2 \ && [powPtInRgn [lindex P1 0] [lindex P1 1] $Poly2]} { return $P1 } return "" } # Find the Intersections of the two regions for {set i1 0} {$i1 < $nPoly1} {incr i1} { set Seg1 [lindex $Poly1 $i1] foreach {a_x a_y a_dx a_dy} $Seg1 {} for {set i2 0} {$i2 < $nPoly2} {incr i2} { set Seg2 [lindex $Poly2 $i2] foreach {b_x b_y b_dx b_dy} $Seg2 {} set a $i1 set b $i2 set num [expr $a_dx*($a_y-$b_y) - $a_dy*($a_x-$b_x)] set den [expr $a_dx*$b_dy - $b_dx*$a_dy] if {$den!=0 || ($den==0 && $num==0)} { if {$den==0} { if { [expr abs($b_dx)] > [expr abs($b_dy)] } { set fb [expr ($a_x-$b_x)/$b_dx] } else { set fb [expr ($a_y-$b_y)/$b_dy] } if {$fb>=0 && $fb<$ONEPLUS} { if {$fb>$ONEMNUS} { incr b if {$b==$nPoly2} {set b 0} } elseif { $fb>$TINY } { incr b set dx [expr $fb*$b_dx] set dy [expr $fb*$b_dy] set x [expr $b_x+$dx] set y [expr $b_y+$dy] set Seg2 [list $b_x $b_y $dx $dy] set newSeg [list $x $y [expr $b_dx-$dx] \ [expr $b_dy-$dy] ] set Poly2 [lreplace $Poly2 $i2 $i2 $Seg2 $newSeg] incr nPoly2 foreach {b_dx b_dy} "$dx $dy" {} set tmp "" foreach j $Ipts { foreach {j1 j2} $j {} if {$j2>$i2} {incr j2} lappend tmp [list $j1 $j2] } set Ipts $tmp } set newI [list $a $b] if { [lsearch -exact $Ipts $newI]==-1 } { lappend Ipts $newI } set b $i2 } set fb 0 } else { set fb [expr $num/$den] } if { $fb>=0 && $fb<$ONEPLUS } { if { [expr abs($a_dx)] > [expr abs($a_dy)] } { set fa [expr ($b_dx*$fb+$b_x-$a_x)/$a_dx] } else { set fa [expr ($b_dy*$fb+$b_y-$a_y)/$a_dy] } if { $fa>=0 && $fa<$ONEPLUS } { if { $fa>$ONEMNUS } { incr a if {$a==$nPoly1} {set a 0} } elseif { $fa>$TINY } { incr a set dx [expr $fa*$a_dx] set dy [expr $fa*$a_dy] set x [expr $a_x+$dx] set y [expr $a_y+$dy] set Seg1 [list $a_x $a_y $dx $dy] set newSeg [list $x $y [expr $a_dx-$dx] \ [expr $a_dy-$dy] ] set Poly1 [lreplace $Poly1 $i1 $i1 $Seg1 $newSeg] incr nPoly1 foreach {a_dx a_dy} "$dx $dy" {} set tmp "" foreach j $Ipts { foreach {j1 j2} $j {} if {$j1>$i1} {incr j1} lappend tmp [list $j1 $j2] } set Ipts $tmp } if { $fb>$ONEMNUS } { incr b if {$b==$nPoly2} {set b 0} } elseif { $fb>$TINY } { incr b set dx [expr $fb*$b_dx] set dy [expr $fb*$b_dy] set x [expr $b_x+$dx] set y [expr $b_y+$dy] set Seg2 [list $b_x $b_y $dx $dy] set newSeg [list $x $y [expr $b_dx-$dx] \ [expr $b_dy-$dy] ] set Poly2 [lreplace $Poly2 $i2 $i2 $Seg2 $newSeg] incr nPoly2 foreach {b_dx b_dy} "$dx $dy" {} set tmp "" foreach j $Ipts { foreach {j1 j2} $j {} if {$j2>$i2} {incr j2} lappend tmp [list $j1 $j2] } set Ipts $tmp incr i2 } set newI [list $a $b] if { [lsearch -exact $Ipts $newI]==-1 } { lappend Ipts $newI } } } } } } set Ipts [lsort -command {powSortIntSects 0} $Ipts] set Jpts [lsort -command {powSortIntSects 1} $Ipts] set Npts [llength $Ipts] # powClipDump $Ipts $Poly1 $Poly2 # If there are no intersections or only 1, return: # P1 if P1 is inside P2 # P2 if P1 encloses P2 # empty if there is no overlap # If there is only one intersection, make sure first point isn't lying # right on the other Polygon. If it is, use second point for test. set state [powPtInRgn [lindex $P1 0] [lindex $P1 1] $Poly2] if { $Npts==1 } { set i1 [lindex [lindex $Ipts 0] 0] set za [lindex [lindex $Ipts 0] 2] if { $i1==0 && $za==0 } { set state [powPtInRgn [lindex $P1 2] [lindex $P2 3] $Poly2] } set Npts 0 } if { ! $Npts } { if {$state} { return [list $P1] } set state [powPtInRgn [lindex $P2 0] [lindex $P2 1] $Poly1] if {$state} { return [list $P2] } return "" } # Do loop over all the intersections and make sure they all make it # into the clipped region... this allows for disjointed clip regions set Mclips "" for {set IntSects 0} {$IntSects<$Npts} {incr IntSects} { if { ![info exists Iused($IntSects)] } { set I $IntSects set J [lsearch -exact $Jpts [lindex $Ipts $I] ] set Idir 1 set Jdir 1 set endPt $I set errFlag 0 foreach {ia1 ib1} [lindex $Ipts $I] {} set pt [lindex $Poly1 $ia1] foreach {x y dx dy} $pt {} set clipped "$x $y" set Iused($I) 1 while { 1 } { foreach {ia1 ib1} [lindex $Ipts $I] {} foreach {x1 y1 dx1 dy1} [lindex $Poly1 $ia1] {} foreach {x2 y2 dx2 dy2} [lindex_wrap $Poly1 [expr $ia1-1] ] {} set posState [powPtInRgn [expr $x1+0.5*$dx1] [expr $y1+0.5*$dy1] $Poly2] set negState [powPtInRgn [expr $x2+0.5*$dx2] [expr $y2+0.5*$dy2] $Poly2] set doP1 1 if { $posState && !$negState } { set Idir 1 } elseif { !$posState && $negState } { set Idir -1 } elseif { $posState } { set prevI [lsearch -exact $Ipts [lindex_wrap $Jpts [expr $J-$Jdir]]] set Idir [expr $I-$prevI] if { $Idir<-1 } {set Idir 1} if { $Idir> 1 } {set Idir -1} } else { # Both directions outside region... # If this wasn't first point tested, return to tracing other region. # Otherwise, it was a single point intersection, so just finish. set doP1 0 if { $I!=$endPt } { set ia2 [lindex [lindex_wrap $Ipts [expr $I+1] ] 0] if { $ia1==$ia2 } { incr I } else { incr I -1 } set J [lsearch -exact $Jpts [lindex_wrap $Ipts $I] ] } } while { $doP1 } { foreach {ia1 ib1} [lindex $Ipts $I] {} incr I $Idir if {$I==$Npts} {set I 0} elseif {$I<0} {set I [expr $Npts-1]} # Copy over all polygon1 segments inside polygon2 (ia1->ia2) foreach {ia2 ib2} [lindex $Ipts $I] {} while {$ia1!=$ia2} { incr ia1 $Idir if {$ia1==$nPoly1} {set ia1 0} \ elseif {$ia1<0} {set ia1 [expr $nPoly1-1]} set pt [lindex $Poly1 $ia1] lappend clipped [lindex $pt 0] lappend clipped [lindex $pt 1] } set J [lsearch -exact $Jpts [lindex $Ipts $I] ] set Iused($I) 1 if {$I==$endPt} {break} if { [llength $clipped] > [expr 3*($nPoly1+$nPoly2)]} { set errFlag 1 tk_messageBox -message "Got lost clipping regions! Region is too complex." break } # Check whether we actually need to switch to P2... test whether the middle # point of the next segment is still inside P2 if {$Idir==1} { foreach {x y dx dy} [lindex $Poly1 $ia2] {} } else { foreach {x y dx dy} [lindex_wrap $Poly1 [expr $ia2-1]] {} } if { ![powPtInRgn [expr $x+0.5*$dx] [expr $y+0.5*$dy] $Poly2] } { break } } if {$I==$endPt} {break} if {$errFlag} {break} # Follow polygon2 around until re-intersect polygon1 # First, need to know what direction to go! foreach {ja1 jb1} [lindex $Jpts $J] {} foreach {x1 y1 dx1 dy1} [lindex $Poly2 $jb1] {} foreach {x2 y2 dx2 dy2} [lindex_wrap $Poly2 [expr $jb1-1] ] {} set posState [powPtInRgn [expr $x1+0.5*$dx1] [expr $y1+0.5*$dy1] $Poly1] set negState [powPtInRgn [expr $x2+0.5*$dx2] [expr $y2+0.5*$dy2] $Poly1] set doP2 1 if { $posState && !$negState } { set Jdir 1 } elseif { !$posState && $negState } { set Jdir -1 } elseif { $posState } { set prevJ [lsearch -exact $Jpts [lindex_wrap $Ipts [expr $I-$Idir]]] set Jdir [expr $J-$prevJ] if { $Jdir<-1 } {set Jdir 1} if { $Jdir> 1 } {set Jdir -1} } else { set jb2 [lindex [lindex_wrap $Jpts [expr $J+1] ] 1] if { $jb1==$jb2 } { incr J } else { incr J -1 } set I [lsearch -exact $Ipts [lindex_wrap $Jpts $J] ] set doP2 0 } while { $doP2 } { foreach {ja1 jb1} [lindex $Jpts $J] {} incr J $Jdir if {$J==$Npts} {set J 0} elseif {$J<0} {set J [expr $Npts-1]} # Copy over all polygon2 segments inside polygon1 (jb1->jb2) foreach {ja2 jb2} [lindex $Jpts $J] {} while {$jb1!=$jb2} { incr jb1 $Jdir if {$jb1==$nPoly2} {set jb1 0} \ elseif {$jb1<0} {set jb1 [expr $nPoly2-1]} set pt [lindex $Poly2 $jb1] lappend clipped [lindex $pt 0] lappend clipped [lindex $pt 1] } set I [lsearch -exact $Ipts [lindex $Jpts $J] ] set Iused($I) 1 if {$I==$endPt} {break} # Check whether we actually need to switch to P1... test whether the middle # point of the next segment is still inside P1 if { [llength $clipped] > [expr 3*($nPoly1+$nPoly2)]} { set errFlag 1 tk_messageBox -message "Got lost clipping regions! Region is too complex." break } if {$Jdir==1} { foreach {x y dx dy} [lindex $Poly2 $jb2] {} } else { foreach {x y dx dy} [lindex_wrap $Poly2 [expr $jb2-1]] {} } if { ![powPtInRgn [expr $x+0.5*$dx] [expr $y+0.5*$dy] $Poly1] } { break } } if {$I==$endPt} {break} if {$errFlag} {break} } lappend Mclips $clipped } } return $Mclips } proc powClipDump { Ints P1 P2 } { puts "\nPolygon1" set i 0 foreach is $P1 { puts "[eval [concat format \"%2d %9.3f %9.3f %9.3f %9.3f\" $i $is]]" incr i } puts "Polygon2" set i 0 foreach is $P2 { puts "[eval [concat format \"%2d %9.3f %9.3f %9.3f %9.3f\" $i $is]]" incr i } puts "Intersections: " set i 0 foreach is $Ints { puts "[eval [concat format \"%2d %2d %2d\" $i $is]]" incr i } } proc lindex_wrap { L i } { set n [llength $L] while { $i < 0 } { incr i $n } while { $i >= $n } { incr i [expr -$n] } return [lindex $L $i] } proc powSortIntSects { elem a b } { set d [expr [lindex $a $elem] - [lindex $b $elem] ] if {$d==0} { set d [expr [lindex $a [expr 1-$elem] ] - [lindex $b [expr 1-$elem] ] ] } if { $d<0 } {return -1} elseif { $d>0 } {return 1} else {return 0} } proc powPtInRgn { x y Poly } { lappend Poly [lindex $Poly 0] set nPoly [llength $Poly] set next [lindex $Poly 0] foreach {n_x n_y n_dx n_dy} $next {} set flag 0 for {set cnt 1} {$cnt < $nPoly} {incr cnt} { set nxt [list $n_x $n_y $n_dx $n_dy] foreach {b_x b_y b_dx b_dy} $nxt {} foreach {n_x n_y n_dx n_dy} [lindex $Poly $cnt] {} if { ($y>$b_y && $y>=$n_y) || ($y<$b_y && $y<=$n_y) \ || ($x>$b_x && $x>=$n_x) } { continue } # Check to see if x,y lies right on the segment if { $x>=$b_x || $x>$n_x } { set dy [expr $y-$b_y] if { [expr abs($b_dy)]<1e-10 } { if { [expr abs($dy)]<1e-10 } { return 1 } else { continue } } set dx [expr $b_x + ($b_dx/$b_dy)*$dy - $x] if { $dx < -1e-10 } {continue} if { $dx < 1e-10 } {return 1} } # There is an intersection! Make sure it isn't a V point. if { $y!=$b_y } { set flag [expr 1-$flag] } else { set idx [expr $cnt-1] while {1} { if {$idx} {incr idx -1} else {set idx [expr $nPoly-2]} set prevdy [lindex [lindex $Poly $idx] 3] if {$prevdy} {break} } if {$b_dy*$prevdy > 0} { set flag [expr 1-$flag] } } } return $flag } proc powCalculateImageFlux {} { global currimg global powbg global powDWP g_titleFont global regionParam global g_backupDir global powRotation set probeFormat decimal # Use SAO Format set theRgns [$regionParam(rgns) regions] if {$theRgns == ""} { return } set regionFileName $g_backupDir/pow_[clock seconds].reg set f [open $regionFileName "w+"] set numberShape 0 for {set i 0} {$i < [llength $theRgns]} {incr i} { set probeSelected [lindex $theRgns $i] set shape [$probeSelected getShape ] set descr [$probeSelected getFunction "pixels" ] set sign [$probeSelected getSign] if { $regionParam(format) == "Physical (Pixels)" } { set new_descr "" if { $shape=="Line" || $shape=="Polygon" || $shape=="Point" } { # These objects consist of just pairs of coordinates foreach [list phy_x phy_y] $descr { set result [powConvertPhysical2Image $phy_x $phy_y] set img_x [lindex $result 0] set img_y [lindex $result 1] if { $new_descr == "" } { set new_descr [format "%s %s" $img_x $img_y] } else { set new_descr [format "%s %s %s" $new_descr $img_x $img_y] } } } else { set tokenList [split $descr " "] set phy_x [lindex $tokenList 0] set phy_y [lindex $tokenList 1] set result [powConvertPhysical2Image $phy_x $phy_y] set img_x [lindex $result 0] set img_y [lindex $result 1] set new_descr [format "%s %s" $img_x $img_y] if { $shape=="Circle" } { set phy_radius [lindex $tokenList 2] set img_radius [powConvertRadiusPhysical2Image $phy_x $phy_y $img_x $phy_radius] set new_descr [format "%s %s" $new_descr $img_radius] } else { set width [lindex $tokenList 2] set height [lindex $tokenList 3] set rot [lindex $tokenList 4] set phy_xn [expr $phy_x + $width] set phy_yn [expr $phy_y + $height] set result [powConvertPhysical2Image $phy_xn $phy_yn] set img_xn [lindex $result 0] set img_yn [lindex $result 1] set new_width [expr $img_xn - $img_x] set new_height [expr $img_yn - $img_y] set new_descr [format "%s %s %s %s" $new_descr $new_width $new_height $rot] } } set descr $new_descr } if { [string tolower $shape] == "polygon" } { set token [split $descr " "] if { [llength $token] <= 4 } { continue } } if { ([string tolower $shape] == "box" || [string tolower $shape] == "ellipse") && [llength $descr] >= 5 } { set rot [lindex $descr end] if { [info exists currimg] && [info exists powRotation($currimg)] } { set rot [expr $rot + $powRotation($currimg)] set descr [lreplace $descr end end $rot] } } # update data set tempdescr "([join $descr {, }])" set rgnDescr "$sign[string tolower ${shape}]$tempdescr" puts $f $rgnDescr incr numberShape } close $f if { $numberShape <= 0 } return set results [powGetRegionStatistics $currimg $regionFileName $descr $shape $sign ] file delete -force $regionFileName set good [lindex $results 0] if {$good == 1} { set probeCentX [lindex $results 1] set probeCentY [lindex $results 2] set probeStdX [lindex $results 3] set probeStdY [lindex $results 4] set probeFlux [lindex $results 5] set probeNPix [lindex $results 6] set probeMean [ format "%.10g" [lindex $results 7] ] set probeDMean [ format "%.10g" [lindex $results 8] ] set pixel [format "(%.2f, %.2f) +- (%.2f, %.2f)" \ $probeCentX $probeCentY $probeStdX $probeStdY ] foreach {graphx graphy} [powPixelToGraph $currimg \ [expr $probeCentX - 1] [expr $probeCentY - 1] ] {} foreach {gx1 gy1} [powPixelToGraph $currimg \ [expr $probeCentX - 1 - $probeStdX ] \ [expr $probeCentY - 1 - $probeStdY ] ] {} foreach {gx2 gy2} [powPixelToGraph $currimg \ [expr $probeCentX - 1 + $probeStdX ] \ [expr $probeCentY - 1 + $probeStdY ] ] {} set graphdx [expr abs($gx2 - $gx1)/2.0 ] set graphdy [expr abs($gy2 - $gy1)/2.0 ] if {$probeFormat == "decimal" } { set graphx [format %.6g $graphx] set graphy [format %.6g $graphy] set graphdx [format %.3g $graphdx] set graphdy [format %.3g $graphdy] } else { set graphx [powHourRA $graphx "%02d:%02d:%05.2f"] set graphy [powDegDec $graphy] set graphdx [powHourRA $graphdx "%02d:%02d:%05.2f"] set graphdy [powDegDec $graphdy] } set coord "($graphx, $graphy) +- ($graphdx, $graphdy)" } else { set probeCentX X set probeCentY Y set probeStdX "" set probeStdY "" set probeFlux 0.0 set probeNPix 0 set pixel "(X,Y) +- (dX,dY)" set coord "(X,Y) +- (dX,dY)" set probeMean 0.0 set probeDMean 0.0 if { $good == 504 } { tk_messageBox -message "Current projection is not supported." -type ok -icon error } else { tk_messageBox -message "Failed to get statistical values for region., err code: $good" -type ok -icon error } } # Update the readout in dialog box. set sta ${powDWP}region.fluxprobe set childsite [$sta.pixels childsite] $childsite.c configure -text $probeNPix set childsite [$sta.flux childsite] $childsite.c configure -text $probeFlux set childsite [$sta.mean childsite] $childsite.c configure -text "$probeMean +- $probeDMean" } fv5.5/tcltk/pow/powRuler.tcl0000755000220700000360000001574513224715130015003 0ustar birbylhea# From canvas coordinates to the pixel and physical coord. #Update the label in the Option box proc UpdateRuler {obj} { global currimg global currgn global powDWP set xruler ${powDWP}xruler if ![info exists currimg] { return } foreach [list tx0 ty0 tx1 ty1] [$obj getGraphCoords] {} set e0 [powGraphToPixel $currimg $tx0 $ty0] set e1 [powGraphToPixel $currimg $tx1 $ty1] foreach [list x0 y0] $e0 {} foreach [list x1 y1] $e1 {} set dx [expr $x1 - $x0 ] set dy [expr $y1 - $y0 ] set dd [expr hypot($dx, $dy)] set ruler_pix [ format \ "Image Pixel \n(dX, dY): (%-.6g ,%-.6g)\n Pixel Distance: %-.6g " \ $dx $dy $dd ] $xruler.frame.message.pixel configure -text $ruler_pix set tx [expr $tx1 - $tx0 ] set ty [expr $ty1 - $ty0 ] set deg2rad [expr 3.1415926/180.0 ] if [powWCSexists $currgn ] { # angular distance set sinx2 [expr sin($tx/2.0*$deg2rad)] set siny2 [expr sin($ty/2.0*$deg2rad)] set cosy1 [expr cos($ty1*$deg2rad)] set cosy0 [expr cos($ty0*$deg2rad)] set dd [expr ($siny2*$siny2) + ($cosy1*$cosy0*$sinx2*$sinx2) ] set dd [expr sqrt($dd)] if {$dd > 1.0} { set dd 1.0 } set dd [expr asin($dd)*2.0/$deg2rad] # angle to north set a [expr (90 - $ty1)*$deg2rad] set b [expr (90 - $ty0)*$deg2rad] set c [expr $dd*$deg2rad] if {$a == 0.0 || $b == 180.0 || $c == 0.0 } { set angle 0 } elseif {$a == 180.0 || $b == 0.0 || $c == 180.0 } { set angle 180 } else { set sinb [expr sin($b)] set sinc [expr sin($c)] set s [expr 0.5 * ($a + $b + $c)] set sinsc [expr sin($s - $c)] set sinsb [expr sin($s - $b)] set temp2 [expr sqrt(($sinsc/$sinc)*($sinsb/$sinb))] if {$temp2 > 1.0} { set temp2 1.0 } set angtmp [expr 2.0*asin($temp2)/$deg2rad] if {$tx >= 0 && $tx < 180} { set angle $angtmp } elseif {$tx >= 180 && $tx < 360 } { set angle [expr 360 - $angtmp ] } elseif {$tx < 0 && $tx >= -180 } { set angle [expr 360.0 - $angtmp ] } elseif {$tx < -180 && $tx >= -360 } { set angle $angtmp } else { } } set ruler_graph [format \ "Graph Coordinate (deg) \n(dRA, dDec): (%-.6g, %-.6g)\n" $tx $ty ] set temp [format \ "Ang. Distance: %-.6g \nAngle to North: %-.6g \n" \ $dd $angle ] set ruler_graph "${ruler_graph}${temp}" } else { set dd [expr hypot($tx, $ty)] set angle [expr atan2($ty,$tx)/$deg2rad ] set ruler_graph [ format \ "Graph Coordinate \n(dX, dY): (%-.6g, %-.6g)\n" $tx $ty ] set temp [format \ "Distance: %-.6g \nAngle to X-axis(deg): %-.6g \n" \ $dd $angle ] set ruler_graph "${ruler_graph}${temp}" } $xruler.frame.message.graph configure -text $ruler_graph foreach {cx0 cy0} [powGraphToCanvas $currgn $tx0 $ty0] {} foreach {cx1 cy1} [powGraphToCanvas $currgn $tx1 $ty1] {} set temp [list $cx0 $cy0 $cx0 $cy1 $cx1 $cy1] .pow.pow delete ruler_line .pow.pow create line $temp -fill lightblue -tags ruler_line } proc RulerCallback { obj msg } { global powDWP set xruler ${powDWP}xruler if ![winfo exists $xruler ] { return } if {$msg == "shapeIsBeingModified" || $msg == "shapeHasChanged"} { UpdateRuler $obj } } proc OpenRuler { } { global rulerRegion global currgn global currimg global powDWP global powbg global g_titleFont global powRotation global storePowRotation set xruler ${powDWP}xruler if [winfo exists $xruler ] { focus $xruler raise $xruler return } if ![info exists currimg ] { tk_messageBox -type ok -icon error \ -message "Select an image first." return } powToplevel $xruler .pow "-width 200 -bg $powbg" wm title $xruler "Ruler" frame $xruler.frame -borderwidth 4 frame $xruler.frame.title frame $xruler.frame.message -borderwidth 3 -relief groove label $xruler.frame.title.title -text "Ruler:" -background yellow \ -relief flat -width 8 -anchor w -font g_titleFont button $xruler.frame.title.help -text Help -anchor e \ -command {powHelp Ruler.html} -font g_titleFont set ruler_pix "Image Pixel \n(dX, dY): \n Pixel Distance: " if [powWCSexists $currgn ] { set ruler_graph "Graph Coordinate (deg)\n(dRA, dDEC): \n" set ruler_graph "${ruler_graph}Ang. Distance: \nAngle to North:" } else { set ruler_graph "Graph Coordinate \n(dX, dY): \n" set ruler_graph "${ruler_graph}Distance: \nAngle to X-axis:" } message $xruler.frame.message.pixel -text $ruler_pix \ -anchor w -relief flat -width 200 -font g_titleFont message $xruler.frame.message.graph -text $ruler_graph \ -anchor w -relief flat -width 400 -font g_titleFont button $xruler.frame.close -text Exit -command { global storePowRotation global currimg global powRotation if { [info exists currimg] && [info exists storePowRotation($currimg)] } { set powRotation($currimg) $storePowRotation($currimg) } itcl::delete object $rulerRegion .pow.pow delete ruler_line destroy ${powDWP}xruler } -font g_titleFont pack $xruler.frame.title.title -side left -anchor w pack $xruler.frame.title.help -side right -anchor e pack $xruler.frame.message.pixel -side left -anchor nw pack $xruler.frame.message.graph -side left -anchor nw pack $xruler.frame.title -anchor w -pady 5 -padx 2 -fill x pack $xruler.frame.message -anchor w -pady 2 -padx 2 -fill x pack $xruler.frame.close -expand 1 -anchor w -pady 5 -padx 2 pack $xruler.frame -fill x set ruler_gn $currgn set ruler_img $currimg set rulerRegion [gRegionList $currgn .pow.pow] $rulerRegion setOwner RulerCallback $rulerRegion setAllowsMultiple 0 $rulerRegion setDefault "+" Line set temp [powFetchImageInfoHash $ruler_img ] set temp [split $temp ] set rulerWidth [lindex $temp 3] set rulerHeight [lindex $temp 5] set halfx [expr round($rulerWidth*0.5) ] set halfy [expr round($rulerHeight*0.5) ] set gx0 [expr round($halfx*0.5) + 1] set gy0 [expr round($halfy*0.5) + 1] set gx1 [expr round($halfx*1.5) + 1] set gy1 [expr round($halfy*1.5) + 1] set descr [list $gx0 $gy0 $gx1 $gy1] if [info exists powRotation($currimg)] { set storePowRotation($currimg) $powRotation($currimg) catch { unset powRotation($currimg) } } $rulerRegion addRegion + Line $descr pixels set elem [$rulerRegion rgnAtIndex 0] set powROIButton 1 powSaveConfig bind $xruler <> { itcl::delete object rulerRegion .pow.pow delete ruler_line destroy ${powDWP}xruler } tkwait window $xruler } fv5.5/tcltk/pow/powScript.tcl0000644000220700000360000017257213224715130015155 0ustar birbylhea# # This file contains code which makes POW more scriptable either from # TCL or via XPA entry points # namespace eval powCmds { variable currcrv "" variable remoteServer "" variable mouseClicked "" proc helpPage { args } { variable remoteServer global g_showpow_flag powDWP g_backupDir if { $remoteServer != "" } { return [::powXPA::server $remoteServer helpPage $str ] } set g_showpow_flag "noshow" if { ![winfo exists .pow] } { powInit .dummy } if { [string range $args [expr [string length $args] - 5] end] == ".html" } { set fileName $args } else { set fileName $g_backupDir/helpPage_[clock seconds].html set f [::open $fileName w+] set data [split [lindex $args 0] \n] foreach line $data { catch { puts $f $line } err } catch { ::close $f } err } catch { powHelp $fileName } err } proc getXRange { args } { global currgn powDWP global xRangeParam variable remoteServer if { $remoteServer != "" } { return [::powXPA::server $remoteServer getXRange $str ] } if { ![info exist xRangeParam(rgns)] } return {} set theRgns [$xRangeParam(rgns) regions] set regionStr {} foreach rgn $theRgns { foreach [list sign shape descr] \ [$xRangeParam(rgns) buildRegionStr $rgn $xRangeParam(degreeFormat)]\ {} set descr "[format "%.15G" [lindex $descr 0]] [format "%.15G" [lindex $descr 2]]" lappend regionStr $descr } return $regionStr } proc getRegion { args } { global currgn regionParam powDWP variable remoteServer if { $remoteServer != "" } { return [::powXPA::server $remoteServer getRegion $str ] } set propertyOrder [lindex $args 0] if { ![info exist regionParam(rgns)] } return {} set theRgns [$regionParam(rgns) regions] set regionStr {} foreach rgn $theRgns { if { [$rgn getPropertyOrder] == $propertyOrder } { foreach [list sign shape descr] \ [$regionParam(rgns) buildRegionStr $rgn $regionParam(degreeFormat)]\ {} set descr [format "%s%s%s" [string trim $sign] [string tolower $shape] ([join $descr {, }])] lappend regionStr $descr } } return $regionStr } proc regions { args } { variable remoteServer global currgn regionParam powDWP if { [llength $args] == 1 && [file exists [lindex $args 0]] } { set f [open [lindex $args 0] r] set str [read $f [file size [lindex $args 0]]] ::close $f } else { set str "" for {set i 0} {$i < [llength $args]} {incr i} { set str [format "%s%s" $str [lindex $args $i]] } } if { $remoteServer != "" } { return [::powXPA::server $remoteServer regions $str ] } if { ![winfo exists ${powDWP}region] } { powRegion } if { ![info exists regionParam(rgns)] } { set regionParam(rgns) [gRegionList $currgn .pow.pow] } catch { $regionParam(rgns) readFromStr $str } err return Done } proc regionName { args } { global regionOutputFileName variable remoteServer if { $remoteServer != "" } { return [::powXPA::server $remoteServer regionName $args] } set regionOutputFileName [lindex $args 0] powUpdateRegionTitle $regionOutputFileName return Done } proc setRegionFormat { args } { variable remoteServer global regionParam if { $remoteServer != "" } { return [::powXPA::server $remoteServer regionName $args] } set plainformats [$regionParam(rgns) getPlainFormats] set allformats [$regionParam(rgns) getAllFormats] set idx [lsearch -exact $plainformats [lindex $args 0]] set newFormat [lindex $args 0] if { $idx >= 0 } { set newFormat [lindex $allformats $idx] } powChangeFormat $newFormat return Done } proc binFactorTool { args } { global binFactorSendFlag powDWP global defaultBinFactor variable remoteServer if { $remoteServer != "" } { return [::powXPA::server $remoteServer binFactorTool $args] } if { [llength $args] == 1 } { switch -- [lindex $args 0] { "-wait" { set token [split $binFactorSendFlag " "] if { [lindex $token 0] != "NOT_YET" } { set returnFlag $binFactorSendFlag set binFactorSendFlag "NOT_YET 0" return $returnFlag } return $binFactorSendFlag } "-open" { powBinFactorSelect set binFactorSendFlag "NOT_YET 0" return Done } "-close" { powApplyBinFactor DONE catch { destroy ${powDWP}binFactorSelect } return Done } default { error "[lindex $args 0] is not a valid option for binFactorTool" } } } elseif { [llength $args] == 2 } { switch -- [lindex $args 0] { "-value" { powSetBinFactor [lindex $args 1] set defaultBinFactor [lindex $args 1] } default { error "[lindex $args 0] is not a valid option for binFactorTool" } } } else { error "$args are not a valid options for binFactorTool" } } proc regionTool { args } { global currgn regionParam global regionOutputFileName waitFlag powDWP variable remoteServer if { $remoteServer != "" } { return [::powXPA::server $remoteServer regionTool $args] } if { [llength $args] == 1 } { switch -- [lindex $args 0] { "-wait" { if ![info exists waitFlag] { return "NOT_YET" } if { $waitFlag == "save" } { return 0 } elseif { $waitFlag == "unsave" } { return 1 } else { return "NOT_YET" } } "-open" { set regionParam(rgns) [gRegionList $currgn .pow.pow] powRegion set waitFlag "NOT_YET" return Done } "-close" { catch { destroy ${powDWP}region } return Done } "-clearAll" { catch { powClearRegions clearAll } err return Done } default { error "[lindex $args 0] is not a valid option for regionTool" } } } else { error "$args are not a valid options for regionTool" } } proc xranges { args } { variable remoteServer global currgn xRangeParam powDWP if { [llength $args] == 1 && [file exists [lindex $args 0]] } { set f [open [lindex $args 0] r] set str [read $f [file size [lindex $args 0]]] ::close $f } else { set str "" for {set i 0} {$i < [llength $args]} {incr i} { set str [format "%s%s" $str [lindex $args $i]] } } if { $remoteServer != "" } { return [::powXPA::server $remoteServer xranges $str ] } if { ![info exists ${powDWP}xRange] } { powXRange } if { ![info exists xRangeParam(rgns)] } { set xRangeParam(rgns) [gRegionList $currgn .pow.pow] } $xRangeParam(rgns) setStaticFlag "y" catch { xrangeReadDataStr $str } err return Done } proc xrangeName { args } { global xrangeOutputFileName variable remoteServer if { $remoteServer != "" } { return [::powXPA::server $remoteServer xrangeName $args] } set xrangeOutputFileName [lindex $args 0] powUpdateXRangeTitle $xrangeOutputFileName return Done } proc xrangeTool { args } { global currgn xRangeParam global xrangeOutputFileName waitFlag powDWP variable remoteServer if { $remoteServer != "" } { return [::powXPA::server $remoteServer xrangeTool $args] } if { [llength $args] == 1 } { switch -- [lindex $args 0] { "-wait" { if { $waitFlag == "save" } { return 0 } elseif { $waitFlag == "unsave" } { return 1 } else { return "NOT_YET" } } "-open" { set xRangeParam(rgns) [gRegionList $currgn .pow.pow] powXRange set waitFlag "NOT_YET" return Done } "-close" { catch { destroy ${powDWP}xRange } return Done } default { error "[lindex $args 0] is not a valid option for xrangeTool" } } } else { error "$args are not a valid options for xrangeTool" } } proc draw { args } { init eval .pow.pow create $args } ######################## # Graph Commands # ######################## proc add { objType objName } { global currgn variable remoteServer if { $remoteServer != "" } { return [::powXPA::server $remoteServer add $objType $objName] } switch -- $objType { curve { powAddCurves $currgn $objName } image { powAddImages $currgn $objName } default { error "Unrecognized object type: $objType" } } } proc axes { {xscale ""} {yscale ""} } { global currgn powPlotParam variable remoteServer if { $remoteServer != "" } { return [::powXPA::server $remoteServer axes $xscale $yscale] } if { $xscale=="" && $yscale=="" } { return [list $powPlotParam(xTickScal,$currgn) \ $powPlotParam(yTickScal,$currgn)] } elseif { $yscale=="" } { if { [regexp (\W)-(\W) $xscale dmy xsc ysc] } { powLogGraph $currgn $xsc $ysc } else { powLogGraph $currgn $xscale $xscale } } else { powLogGraph $currgn $xscale $yscale } } proc bounds { args } { global powPlotParam currgn currimg variable currcrv variable remoteServer if { $remoteServer != "" } { return [eval ::powXPA::server $remoteServer bounds $args] } setCurrCurve set mode "wcs" set argc [llength $args] if { $argc==0 || ($argc==1 && [lindex $args 0]!="reset") } { foreach {x0 y0 x1 y1} [list \ $powPlotParam(xBot,$currgn) \ $powPlotParam(yBot,$currgn) \ $powPlotParam(xTop,$currgn) \ $powPlotParam(yTop,$currgn) ] {} if { $argc==1 } {set mode $args} switch -glob $mode { pix* { if { [info exists currimg] || $currcrv!="" } { if { [info exists currimg] } { set obj $currimg set isImg 1 } else { set obj $currcrv set isImg 0 } foreach {x0 y0} [powGraphToPixel $obj \ $powPlotParam(xBot,$currgn) \ $powPlotParam(yBot,$currgn)] {} foreach {x1 y1} [powGraphToPixel $obj \ $powPlotParam(xTop,$currgn) \ $powPlotParam(yTop,$currgn)] {} if { $isImg } { set x0 [expr $x0+1] set y0 [expr $y0+1] set x1 [expr $x1+1] set y1 [expr $y1+1] } } } wc* { # No need to do anything } default { error "Unrecognized conversion mode: $mode" } } return [list $x0 $y0 $x1 $y1] } elseif { [lindex $args 0]=="reset" } { set powPlotParam(xBot,$currgn) NULL set powPlotParam(yBot,$currgn) NULL set powPlotParam(xTop,$currgn) NULL set powPlotParam(yTop,$currgn) NULL powEraseGraph $currgn 1 powMapGraph $currgn } elseif { [lindex $args 0]=="zoom" } { if { $argc==2 || $argc==3 } { set xmag [lindex $args 1] if { $argc==3 } { set ymag [lindex $args 2] } else { set ymag $xmag } if { $xmag<=0 || $ymag<=0 } { error "Zoom factor out of range" } foreach {x0 y0 x1 y1} [bounds pixels] {} set halfwdth [expr 0.5*($x1-$x0)] set halfhght [expr 0.5*($y1-$y0)] set x0 [expr $x0 + $halfwdth - $halfwdth/$xmag] set x1 [expr $x1 - $halfwdth + $halfwdth/$xmag] set y0 [expr $y0 + $halfhght - $halfhght/$ymag] set y1 [expr $y1 - $halfhght + $halfhght/$ymag] bounds $x0 $y0 $x1 $y1 pixels } else { error "Usage: bounds zoom xMag ?yMag?" } } elseif { $argc==4 || $argc==5 } { foreach {x0 y0 x1 y1} [lrange $args 0 3] {} if { $argc==5 } {set mode [lindex $args 4]} switch -glob $mode { pix* { if { [info exists currimg] || $currcrv!="" } { if { [info exists currimg] } { set obj $currimg set x0 [expr $x0-1] set y0 [expr $y0-1] set x1 [expr $x1-1] set y1 [expr $y1-1] } else { set obj $currcrv } foreach {x0 y0} [powPixelToGraph $obj $x0 $y0] {} foreach {x1 y1} [powPixelToGraph $obj $x1 $y1] {} } } wc* { # No need to do anything } default { error "Unrecognized conversion mode: $mode" } } set powPlotParam(xBot,$currgn) $x0 set powPlotParam(yBot,$currgn) $y0 set powPlotParam(xTop,$currgn) $x1 set powPlotParam(yTop,$currgn) $y1 powEraseGraph $currgn 1 powMapGraph $currgn } else { error "Syntax: bounds ?xLft yBtm xRgt yTop? ?mode?" } } proc cursor { } { global currgn variable mouseClicked foreach {x1 y1 x2 y2} [.pow.pow coords ${currgn}box] {} set boxid [.pow.pow create polygon $x1 $y1 $x1 $y2 $x2 $y2 $x2 $y1 \ -fill {}] .pow.pow bind $boxid