;****************************************************************************** ;* File name: ql_lff_trt.pro * ;* * ;* Content : * ;* ql_get_ql_dctrl * ;* ql_init_rrd_hd * ;* ql_ldprf_ctrl_str * ;* ql_load_ctrl_str * ;* ql_fill_sd_rrd_hd * ;* ql_update_itg_list * ;* ql_gintg_event * ;* ql_gintg_item * ;* ql_gfdata_event * ;* ql_get_opt_data * ;* ql_get_fits_data * ;* ql_gfield_event * ;* ql_get_fits_field * ;* ql_get_single_data * ;* ql_dis_fhd_event * ;* ql_display_fhd * ;* valid_dir * ;* getdirs * ;* getfiles * ;* ql_lff_event * ;* ql_lff_trt * ;* * ;* * ;* Date Author Comment * ;* -------------------------------------------------------------------------- * ;* 10-05-94 E.PETIT Creation * ;* 23-08-94 E.PETIT compression parameter type * ;* 19-06-96 N.Morisset Patch, replace SSLOC by SSPGTYPE * ;* 31-01-97 N.Morisset Refpix wrong (-1) * ;* * ;****************************************************************************** ;*** ;############################################################################## ;#Function name : ql_get_ql_dctrl # ;# # ;#Author : Emmanuel PETIT # ;#Language : IDL # ;#Purpose : Load SUMER QL specific data from fits primary header # ;#Creation date : 17-05-94 # ;#External modules : # ;# # ;#Call sequence : # ;# # ;#Arguments : # ;# # ;#Description : # ;# # ;# # ;############################################################################## PRO ql_get_ql_dctrl, p_header, dctrl, mode, err ;============================================================================ ; Common Block in use ;============================================================================ COMMON const_com COMMON const2_com COMMON color_com ;============================================================================ ; Initialization ;============================================================================ err = 0 ;============================================================================ ; Processing ;============================================================================ WIDGET_CONTROL, /HOURGLASS comment = FXPAR (p_header, 'COMMENT') FOR i=0, N_ELEMENTS(comment)-1 DO BEGIN IF (STRMID(comment(i), 0, 9) EQ SUMER_ID_STR ) THEN BEGIN cmd_str = 'dctrl.' + STRTRIM(STRMID(comment(i), 9, STRLEN(comment(i))-9),2) ret = EXECUTE (cmd_str) ENDIF ENDFOR dctrl.title = STRING(dctrl.title , FORMAT=Title_Format) dctrl.x.comment = STRING(dctrl.x.comment, FORMAT=Comment_Format) dctrl.y.comment = STRING(dctrl.y.comment, FORMAT=Comment_Format) END ;############################################################################## ;#Function name : ql_init_rrd_hd # ;# # ;#Author : Emmanuel PETIT # ;#Language : IDL # ;#Purpose : init rrd header # ;#Creation date : 16-05-94 # ;#External modules : # ;# # ;#Call sequence : # ;# # ;#Arguments : # ;# # ;#Description : # ;# # ;# # ;############################################################################## PRO ql_init_rrd_hd, header ;============================================================================ ; Common Block in use ;============================================================================ COMMON lff_com COMMON lff2_com COMMON color_com ;============================================================================ ; Initialization ;============================================================================ header.SSTYPIMG = -1 header.SSEXPTYR = BYTE (0) header.SSEXPTMO = BYTE (0) header.SSEXPTDY = BYTE (0) header.SSEXPTHR = BYTE (0) header.SSEXPTMN = BYTE (0) header.SSEXPTSC = BYTE (0) header.SSEXPTCS = BYTE (0) header.SSOPCNT = -1 header.SSPOPUDP = -1 header.SSIMGCNT = -1 header.SSSCIENT = -1 header.SSPGTYPE = -1 header.SSTARGET = -1 header.SSFLDATE = -1 header.SSFLREQN = -1 header.SSREFPIX = -1 header.SSSTAT = BYTE (0) header.SSDETSTA = -1 header.SSSUNY = -1 header.SSSUNZ = -1 header.SSEXPTIM = -1.0 header.SSIIDZ = -1 header.SSIISEZ = -1 header.SSIIVALZ = -1 header.SSIIDY = -1 header.SSIIMIDY = -1 header.SSIIVALY = -1 header.SSBPADDY = -1 header.SSBPADDZ = -1 header.SSIMGTOT = -1L header.SSROTCMP = -1.0 header.SSBPCNTS = -1L header.SSACIMGC = -1L header.SSRASSTP = -1 header.SSRASSIZ = BYTE (0) header.SSSLITNB = -1 header.SSBINNY = 1 header.SSBINNZ = 1 header.SSVALEV = -1L header.SSTOTEV = -1L header.S_MCPV = -1L header.SIMCPI = -1 header.SSMC2POS = -1 header.SSMC3POS = -1 header.SSMC4POS = -1 header.SSMC8POS = -1 header.SSMCERR = BYTE (0) header.SSCOMPRM = BYTE (0) header.SSWAVEL = -1.0 header.SSCOMPP1 = -1L header.SSCOMPP2 = -1L header.SSCOMPP3 = -1L header.SSADMCNT = -1L header.SSMC6POS = -1 header.CMPSTAT = BYTE(0) header.SPARE0 = BYTE (0) header.SPARE1 = BYTE (0) header.DATAFMT = BYTE (0) header.DATATYPE = BYTE (0) END ;############################################################################## ;#Function name : ql_load_ctrl_str # ;# # ;#Author : Emmanuel PETIT # ;#Language : IDL # ;#Purpose : Update Init control structure for loaded fits data # ;#Creation date : 16-05-94 # ;#External modules : # ;# # ;#Call sequence : # ;# # ;#Arguments : # ;# # ;#Description : # ;# # ;# # ;############################################################################## PRO ql_load_ctrl_str, fits_hd, mode ;============================================================================ ; Common Block in use ;============================================================================ COMMON lff_com COMMON lff2_com COMMON curr_data_i_com COMMON const_com COMMON const2_com COMMON scient_com COMMON target_com COMMON instr_id_com COMMON instr_evt_com COMMON meth_com COMMON load_flg_com COMMON color_com ;============================================================================ ; Initialization ;============================================================================ ; ---------------------------------------------------------- ; axis_idx (0): axis selected as abscisse , dimension: dim1 ; axis_idx (1): axis selected as ordonnee , dimension: dim2 ; axis_idx (1): axis not selected , dimension: dim3 ; There is so dim3 images of (dim1, dim2) ; ---------------------------------------------------------- err = 0 ;============================================================================ ; Processing ;============================================================================ WIDGET_CONTROL, /HOURGLASS ; Get primary fits curr_header_i ; ----------------------- primary_hd = HEADFITS (thefile, EXTEN=0) ; Initialize RRD header ; --------------------- ql_init_rrd_hd, curr_header_i ; get mandatory keyword values ; ---------------------------- tdim = FXBTDIM (FXPAR (fits_hd, 'TDIM' + STRTRIM(STRING(selected_field),2))) tdesc = FXBTDIM (FXPAR (fits_hd, 'TDESC'+ STRTRIM(STRING(selected_field),2))) trpix = FXBTDIM (FXPAR (fits_hd, 'TRPIX'+ STRTRIM(STRING(selected_field),2))) trval = FXBTDIM (FXPAR (fits_hd, 'TRVAL'+ STRTRIM(STRING(selected_field),2))) tdelt = FXBTDIM (FXPAR (fits_hd, 'TDELT'+ STRTRIM(STRING(selected_field),2))) tunit = FXBTDIM (FXPAR (fits_hd, 'TUNIT'+ STRTRIM(STRING(selected_field),2))) twave = FXPAR (fits_hd, 'TWAVE'+ STRTRIM(STRING(selected_field),2)) trpix = trpix - 1 ; +++++++++++++++ ; COMPUTED VALUES ; +++++++++++++++ ; Set image components ; -------------------- IF (mode EQ COM_IMAGE) THEN BEGIN ; compound image img_content = REPLICATE ({index:0,weight:0}, N_ELEMENTS(itg_item_lst)) ENDIF ELSE BEGIN ; single image axis_idx(0) = 0 axis_idx(1) = 1 dim1 = FIX(tdim(axis_idx(0))) dim2 = FIX(tdim(axis_idx(1))) img_content = {index:0,weight:1} itg_item_lst = STRARR (1) itg_item_lst(0) = '#000 01' cutaxe = 'A' ENDELSE FOR i=0, N_ELEMENTS(itg_item_lst)-1 DO BEGIN img_content(i).index = FIX (STRMID (itg_item_lst(i),1,3)) img_content(i).weight = FIX (STRMID (itg_item_lst(i),6,2)) ENDFOR ; ------------------- ; compute image type ; ------------------- dir1 = STRTRIM(tdesc(axis_idx(0)),2) dir2 = STRTRIM(tdesc(axis_idx(1)),2) CASE 1 OF (dir1 EQ 'WAVELNTH') AND (dir2 EQ 'SOLAR_X') : imgtype = 21 (dir1 EQ 'WAVELNTH') AND (dir2 EQ 'SOLAR_Y') : imgtype = 1 (dir1 EQ 'WAVELNTH') AND (dir2 EQ 'TEMPORAL') : imgtype = 3 (dir1 EQ 'SOLAR_X') AND (dir2 EQ 'SOLAR_Y') : imgtype = 2 (dir1 EQ 'SOLAR_X') AND (dir2 EQ 'TEMPORAL') : imgtype = 24 (dir1 EQ 'SOLAR_X') AND (dir2 EQ 'WAVELNTH') : imgtype = 25 (dir1 EQ 'SOLAR_Y') AND (dir2 EQ 'SOLAR_X') : imgtype = 22 (dir1 EQ 'SOLAR_Y') AND (dir2 EQ 'TEMPORAL') : imgtype = 4 (dir1 EQ 'SOLAR_Y') AND (dir2 EQ 'WAVELNTH') : imgtype = 5 (dir1 EQ 'TEMPORAL') AND (dir2 EQ 'SOLAR_X') : imgtype = 27 (dir1 EQ 'TEMPORAL') AND (dir2 EQ 'SOLAR_Y') : imgtype = 7 (dir1 EQ 'TEMPORAL') AND (dir2 EQ 'WAVELNTH') : imgtype = 5 ELSE: imgtype = 2 ENDCASE curr_header_i.DATATYPE=BYTE(imgtype) ; Total counts in Image curr_header_i.SSIMGTOT = LONG(TOTAL(curr_data_i)) ; Data format ds = size (curr_data_i) IF (ds(3) EQ 5) THEN BEGIN curr_data_i = FLOAT (curr_data_i) ds = size (curr_data_i) ENDIF curr_header_i.DATAFMT = ds(3) ; brightest pixel bp = LONG(MAX(curr_data_i,maxpix)) curr_header_i.SSBPCNTS = bp ; brigtest pixel coordinates curr_header_i.SSBPADDY = maxpix MOD dim1 curr_header_i.SSBPADDZ = maxpix / dim1 ; ++++++++++++++++++++++++++ ; VALUES FROM PRIMARY HEADER ; ++++++++++++++++++++++++++ ; GPOP/UDP id curr_header_i.SSPOPUDP = FIX(FXPAR(primary_hd, 'POPUDP')) ; Binning factors binny = FIX(FXPAR(primary_hd, 'BINX', COUNT=cnt1)) binnz = FIX(FXPAR(primary_hd, 'BINY', COUNT=cnt2)) IF (cnt1 EQ 1) THEN curr_header_i.SSBINNY = binny IF (cnt2 EQ 1) THEN curr_header_i.SSBINNZ = binnz ; Solar rotation compensation curr_header_i.SSROTCMP = FLOAT(FXPAR(primary_hd, 'ROTCMP')) ; locate curr_header_i.SSPGTYPE = FIX(FXPAR(primary_hd, 'PGTYPE')) ; IPOP/UDP ID curr_header_i.SSADMCNT = FIX(FXPAR(primary_hd, 'PROG_ID')) ; Compression parameters curr_header_i.SSCOMPP1 = LONG(FXPAR(primary_hd, 'COMPAR1')) curr_header_i.SSCOMPP2 = LONG(FXPAR(primary_hd, 'COMPAR2')) curr_header_i.SSCOMPP3 = LONG(FXPAR(primary_hd, 'COMPAR3')) ; II event coordiates curr_header_i.SSIIDY = FIX( FLOAT(FXPAR(primary_hd, 'ININVALX'))) curr_header_i.SSIIDZ = FIX(-FLOAT(FXPAR(primary_hd, 'ININVALY'))) ; Scientist str = STRTRIM(FXPAR(primary_hd, 'SCIENTIS'),2) tmp = STRMID (str,STRPOS(str,'<')+1, STRPOS(str,'>')-1 ) IF (tmp NE '') THEN curr_header_i.SSSCIENT= FIX(tmp) ; target str = STRTRIM(FXPAR(primary_hd, 'OBJECT'),2) tmp = STRMID (str,STRPOS(str,'<')+1, STRPOS(str,'>')-1 ) IF (tmp NE '') THEN curr_header_i.SSTARGET=FIX(tmp) ; II master ID str = STRTRIM(FXPAR(primary_hd, 'ININM_ID'),2) tmp = STRMID (str,STRPOS(str,'<')+1, STRPOS(str,'>')-1 ) IF (tmp NE '') THEN curr_header_i.SSIIMIDY = FIX(tmp) ; II solar event str = STRTRIM(FXPAR(primary_hd, 'ININSE'),2) tmp = STRMID (str,STRPOS(str,'<')+1, STRPOS(str,'>')-1 ) IF (tmp NE '') THEN curr_header_i.SSIISEZ = FIX(tmp) ; Compression scheme str = STRTRIM(FXPAR(primary_hd, 'COMPRESS'),2) tmp = STRMID (str,STRPOS(str,'<')+1, STRPOS(str,'>')-1 ) IF (tmp NE '') THEN curr_header_i.SSCOMPRM = FIX(tmp) ; Slit str = STRTRIM(FXPAR(primary_hd, 'SLIT'),2) tmp = STRMID (str,STRPOS(str,'<')+1, STRPOS(str,'>')-1 ) IF (tmp NE '') THEN curr_header_i.SSSLITNB = FIX(tmp) ; +++++++++++++++++++++++++++++++ ; VALUES FROM BINARY TABLE HEADER ; AND FROM OTHER COLUMNS ; +++++++++++++++++++++++++++++++ ; Get reference pixel, reference wavelength ; ----------------------------------------- refpix = (FIX(FXPAR(primary_hd,'DET_X'))-1)>1 wavel = twave IF (twave EQ 0) THEN wavel = FLOAT(FXPAR(primary_hd, 'WAVELNTH')) FOR i=0, N_ELEMENTS(tdesc)-1 DO BEGIN IF (tdesc(i) EQ 'WAVELNTH') THEN BEGIN refpix = FIX(trpix(i)) wavel = FLOAT(trval(i)) ENDIF ENDFOR curr_header_i.SSREFPIX = refpix IF (curr_header_i.SSREFPIX LT 0) THEN curr_header_i.SSREFPIX=curr_header_i.SSREFPIX+REFPIX_OFFSET curr_header_i.SSWAVEL = wavel ; Compute observation date ; according to cut axe ; ------------------------ tmp = FXPAR(primary_hd, 'DATE_OBS', COUNT=cnt) IF (cnt EQ 1) THEN obt_base = UTC2TAI(tmp) $ ELSE obt_base = DOUBLE (0) obt_delt = DOUBLE (0) IF (delt_field_flg EQ 1) THEN BEGIN ; There is a DEL_TIME column CASE 1 OF (cutaxe EQ 'A') OR (cutaxe EQ 'D'): BEGIN obt_delt = TOTAL(delt_data (selected_field-1,img_content(*).index)) / N_ELEMENTS(img_content(*).index) END (cutaxe EQ 'B') OR (cutaxe EQ 'E') OR (cutaxe EQ 'C') OR (cutaxe EQ 'F'): BEGIN obt_delt = TOTAL(delt_data (selected_field-1,*)) / N_ELEMENTS(delt_data (selected_field-1,*)) END ELSE: ENDCASE ENDIF ret = TAI2UTC (obt_base + obt_delt, /EXTERNAL) curr_header_i.SSEXPTYR = BYTE(FIX(STRMID(STRING(ret.year, FORMAT='(I4.4)'),2,2))) curr_header_i.SSEXPTMO = BYTE(ret.month) curr_header_i.SSEXPTDY = BYTE(ret.day) curr_header_i.SSEXPTHR = BYTE(ret.hour) curr_header_i.SSEXPTMN = BYTE(ret.minute) curr_header_i.SSEXPTSC = BYTE(ret.second) curr_header_i.SSEXPTCS = BYTE(FIX(ret.millisecond/10.0)) ; Compute solar position ; according to cut axe ; ------------------------ solarx = FXPAR(primary_hd, 'XCEN') solary = FXPAR(primary_hd, 'YCEN') IF (solx_field_flg EQ 1) AND (soly_field_flg EQ 1) THEN BEGIN ; There are SOLAR_X/SOLAR_Y column CASE 1 OF (cutaxe EQ 'A') OR (cutaxe EQ 'D'): BEGIN solarx = TOTAL(solx_data (selected_field-1,img_content(*).index)) / N_ELEMENTS(img_content(*).index) solary = TOTAL(soly_data (selected_field-1,img_content(*).index)) / N_ELEMENTS(img_content(*).index) END (cutaxe EQ 'B') OR (cutaxe EQ 'E') OR (cutaxe EQ 'C') OR (cutaxe EQ 'F'): BEGIN solarx = TOTAL(solx_data (selected_field-1,*)) / N_ELEMENTS(solx_data (selected_field-1,*)) solary = TOTAL(soly_data (selected_field-1,*)) / N_ELEMENTS(soly_data (selected_field-1,*)) END ELSE: ENDCASE ENDIF curr_header_i.SSSUNY = FIX(solarx * 16.0) curr_header_i.SSSUNZ = FIX(-solary * 16.0) ; Compute exposure time ; according to cut axe ; ------------------------ expotime = FXPAR(primary_hd, 'EXPTIME') IF (expo_field_flg EQ 1) THEN BEGIN ; There is a EXP_TIME column CASE 1 OF (cutaxe EQ 'A') OR (cutaxe EQ 'D'): BEGIN expotime = TOTAL( expo_data(selected_field-1,img_content(*).index)* img_content(*).weight) / $ N_ELEMENTS(img_content(*).index) END (cutaxe EQ 'B') OR (cutaxe EQ 'E') OR (cutaxe EQ 'C') OR (cutaxe EQ 'F'): BEGIN expotime = TOTAL(expo_data (selected_field-1,*)) / N_ELEMENTS(delt_data (selected_field-1,*)) END ELSE: ENDCASE ENDIF curr_header_i.SSEXPTIM = FLOAT(expotime) ; Get status ; according to cut axe ; ------------------------ IF (stat_field_flg EQ 1) THEN BEGIN ; There is a STATUS column CASE 1 OF (cutaxe EQ 'A') OR (cutaxe EQ 'D'): BEGIN cmpstatus = stat_data(selected_field-1, img_content(0).index, 1) detstatus = stat_data(selected_field-1, img_content(0).index, 3) status = stat_data(selected_field-1, img_content(0).index, 4) END (cutaxe EQ 'B') OR (cutaxe EQ 'E') OR (cutaxe EQ 'C') OR (cutaxe EQ 'F'): BEGIN cmpstatus = stat_data(selected_field-1, 0, 1) detstatus = stat_data(selected_field-1, 0, 3) status = stat_data(selected_field-1, 0, 4) END ELSE: ENDCASE curr_header_i.CMPSTAT = FIX (cmpstatus) curr_header_i.SSDETSTA = FIX (detstatus) curr_header_i.SSSTAT = BYTE(status) ENDIF ;-------------------------------------------- ;Init and fill display control str and banner ;-------------------------------------------- ; Init display control structure ql_init_dctrl, mode ; init banner ql_init_banner,curr_data_i, IMAGE , err ; Title curr_dctrl_i.title = STRING(STRTRIM(FXPAR(primary_hd,'FILENAME'),2), FORMAT=Title_Format) ; Axis comments sz = SIZE (tunit) IF (sz(0) EQ 0) THEN BEGIN unite1=STRTRIM(tunit,2) unite2=unite1 ENDIF ELSE BEGIN unite1 = STRTRIM(tunit(axis_idx(0)),2) unite2 = STRTRIM(tunit(axis_idx(1)),2) ENDELSE curr_dctrl_i.x.comment = STRING(dir1+' ('+unite1+')',FORMAT=Comment_Format) curr_dctrl_i.y.comment = STRING(dir2+' ('+unite2+')',FORMAT=Comment_Format) ; compute axis extrema ; according to cut direction ; and axis type ; --------------------------- ref_pix_x = FIX (trpix(axis_idx(0))) ref_val_x = FLOAT(trval(axis_idx(0))) delt_val_x = ABS(FLOAT(tdelt(axis_idx(0)))) ref_pix_y = FIX (trpix(axis_idx(1))) ref_val_y = FLOAT(trval(axis_idx(1))) delt_val_y = ABS(FLOAT(tdelt(axis_idx(1)))) curr_dctrl_i.x.min = ref_val_x - (ref_pix_x-curr_dctrl_i.x.min)*delt_val_x curr_dctrl_i.x.max = ref_val_x + (curr_dctrl_i.x.max-ref_pix_x)*delt_val_x curr_dctrl_i.x.plot_min = curr_dctrl_i.x.min curr_dctrl_i.x.plot_max = curr_dctrl_i.x.max curr_dctrl_i.y.min = ref_val_y - (ref_pix_y-curr_dctrl_i.y.min)*delt_val_y curr_dctrl_i.y.max = ref_val_y + (curr_dctrl_i.y.max-ref_pix_y)*delt_val_y curr_dctrl_i.y.plot_min = curr_dctrl_i.y.min curr_dctrl_i.y.plot_max = curr_dctrl_i.y.max ; Special update ; det_min only for spectral/spatial image ; --------------------------------------- IF (imgtype NE 1) AND (imgtype NE 21) AND (imgtype NE 3) THEN BEGIN curr_dctrl_i.x.det_min=0 curr_dctrl_i.y.det_min=0 ENDIF ; Update process list ; ------------------- IF (dir1 EQ 'WAVELNTH') THEN ret = ql_manage_proc (curr_dctrl_i, PUSH, 1) IF (dir2 EQ 'SOLAR_Y') THEN ret = ql_manage_proc (curr_dctrl_i, PUSH, 3) load_flag_i = 1 END ;############################################################################## ;#Function name : ql_update_itg_list # ;# # ;#Author : Emmanuel PETIT # ;#Language : IDL # ;#Purpose : Update list of selected image from fits data cube # ;#Creation date : 10-05-94 # ;#External modules : # ;# # ;#Call sequence : # ;# # ;#Arguments : # ;# # ;#Description : # ;# # ;# # ;############################################################################## PRO ql_update_itg_list, mode ;============================================================================ ; Common Block in use ;============================================================================ COMMON lff_com COMMON lff2_com COMMON color_com ;============================================================================ ; Initialization ;============================================================================ found = -1 ;============================================================================ ; Processing ;============================================================================ WIDGET_CONTROL, /HOURGLASS ; Add ; --- IF (mode EQ 0) THEN BEGIN IF (itg_res_count EQ 1) THEN BEGIN ; First image itg_item_lst = STRARR (1) itg_item_lst(0) = '#'+STRING(itg_curr_index,FORMAT='(I3.3)')+' '+STRING(1,FORMAT='(I2.2)') ENDIF ELSE BEGIN ; Check if image has already been loaded FOR i=0, N_ELEMENTS(itg_item_lst)-1 DO BEGIN s1 = STRING (itg_curr_index, FORMAT='(I3.3)') IF (STRMID (itg_item_lst(i),1,3) EQ s1) THEN found = i ENDFOR IF (found NE -1) THEN BEGIN n = FIX (STRMID (itg_item_lst(found),6,2)) + 1 itg_item_lst(found) = '#'+STRING(itg_curr_index,FORMAT='(I3.3)')+' '+STRING(n,FORMAT='(I2.2)') ENDIF ELSE BEGIN n = 1 itg_item_old = itg_item_lst itg_item_lst = STRARR (N_ELEMENTS(itg_item_lst)+1) FOR i=0,N_ELEMENTS(itg_item_lst)-2 DO itg_item_lst(i) = itg_item_old (i) itg_item_lst(N_ELEMENTS(itg_item_lst)-1) = '#'+STRING(itg_curr_index,FORMAT='(I3.3)')+' '+STRING(n,FORMAT='(I2.2)') ENDELSE ENDELSE ENDIF ; Remove ; ------ IF (mode EQ 1) THEN BEGIN FOR i=0, N_ELEMENTS(itg_item_lst)-1 DO BEGIN ; Find location s1 = STRING (itg_curr_index, FORMAT='(I3.3)') IF (STRMID (itg_item_lst(i),1,3) EQ s1) THEN found = i ENDFOR n = FIX (STRMID (itg_item_lst(found),6,2)) - 1 IF (n EQ 0) THEN BEGIN IF (N_ELEMENTS(itg_item_lst) GT 1) THEN BEGIN itg_item_old = itg_item_lst itg_item_lst = STRARR (N_ELEMENTS(itg_item_lst)-1) i=0 FOR j=0, N_ELEMENTS(itg_item_lst) DO BEGIN IF (j NE found) THEN BEGIN itg_item_lst(i) = itg_item_old(j) i = i + 1 ENDIF ENDFOR ENDIF ELSE BEGIN itg_item_lst = ' ' ENDELSE ENDIF ELSE BEGIN itg_item_lst(found) = '#'+STRING(itg_curr_index,FORMAT='(I3.3)')+' '+STRING(n,FORMAT='(I2.2)') ENDELSE ENDIF ; All ; --- IF (mode EQ 2) THEN BEGIN itg_item_lst = STRARR (itg_res_count) FOR i=0, itg_img_count-1 DO itg_item_lst(i) = '#'+STRING(i,FORMAT='(I3.3)')+' '+STRING(1,FORMAT='(I2.2)') ENDIF ; clear ; ------ IF (mode EQ 3) THEN BEGIN itg_item_lst = ' ' ENDIF WIDGET_CONTROL, itg_lst, SET_VALUE=itg_item_lst END ;############################################################################## ;#Function name : ql_gintg_event # ;#LEVEL : # ;# # ;#Author : Emmanuel PETIT # ;#Language : IDL # ;#Purpose : Selection of an integration items in a fits data cube # ;#Creation date : 09-05-94 # ;#External modules : # ;# # ;#Call sequence : # ;# # ;#Arguments : # ;# # ;#Description : # ;# # ;# # ;############################################################################## PRO ql_gintg_event, ev ;============================================================================ ; Common Block in use ;============================================================================ COMMON lff_com COMMON lff2_com COMMON color_com ;============================================================================ ; Initialization ;============================================================================ found = -1 ;============================================================================ ; Processing ;============================================================================ CASE ev.id OF itg_sld : BEGIN WSET,itg_win DEVICE, COPY=[0, 0, dim1, dim2, 0, 0, itg_pixmap(ev.value)] itg_curr_index = ev.value END itg_next : BEGIN IF (itg_curr_index LE itg_img_count-2) THEN BEGIN itg_curr_index = itg_curr_index + 1 DEVICE, COPY=[0, 0, dim1, dim2, 0, 0, itg_pixmap(itg_curr_index) ] WIDGET_CONTROL, itg_sld, set_value = itg_curr_index ; re-engaged timer if needed WIDGET_CONTROL, itg_cycle, GET_UVALUE=uval IF (uval EQ 'STOP') THEN BEGIN WIDGET_CONTROL, itg_rate, GET_VALUE=itg_rate_val WIDGET_CONTROL, itg_next, TIMER = float(itg_rate_val)/10.0 ENDIF ENDIF ELSE BEGIN WIDGET_CONTROL, itg_cycle, SET_VALUE='START CYCLE', SET_UVALUE='START' ENDELSE END itg_prev : BEGIN IF (itg_curr_index GE 1) THEN BEGIN itg_curr_index = itg_curr_index - 1 DEVICE, COPY=[0, 0, dim1, dim2, 0, 0, itg_pixmap(itg_curr_index) ] WIDGET_CONTROL, itg_sld, set_value = itg_curr_index ENDIF END itg_cycle :BEGIN WIDGET_CONTROL, itg_cycle, GET_UVALUE=uval IF (uval EQ 'START') THEN BEGIN WIDGET_CONTROL, itg_cycle, SET_VALUE='STOP CYCLE', SET_UVALUE='STOP' WIDGET_CONTROL, itg_rate, GET_VALUE=itg_rate_val WIDGET_CONTROL, itg_next, TIMER = float(itg_rate_val)/10.0 ENDIF ELSE BEGIN WIDGET_CONTROL, itg_cycle, SET_VALUE='START CYCLE', SET_UVALUE='START' ENDELSE END itg_rate : BEGIN WIDGET_CONTROL, itg_rate, GET_VALUE=itg_rate_val END itg_add: BEGIN WIDGET_CONTROL, /HOURGLASS WIDGET_CONTROL, ev.id, GET_UVALUE=new_fdata ; compute adition itg_curr_image = itg_curr_image + new_fdata(*,*,itg_curr_index) itg_res_count = itg_res_count + 1 ; update itg_lst ql_update_itg_list, 0 ; switch to next image IF (itg_curr_index LT itg_img_count-1) THEN BEGIN itg_curr_index = itg_curr_index + 1 DEVICE, COPY=[0, 0, dim1, dim2, 0, 0, itg_pixmap(itg_curr_index) ] WIDGET_CONTROL, itg_sld, set_value = itg_curr_index ENDIF END itg_remove: BEGIN WIDGET_CONTROL, /HOURGLASS WIDGET_CONTROL, ev.id, GET_UVALUE=new_fdata ; compute subtraction itg_curr_image = itg_curr_image - new_fdata(*,*,itg_curr_index) itg_res_count = itg_res_count - 1 ; update itg_lst ql_update_itg_list, 1 END itg_all: BEGIN WIDGET_CONTROL, /HOURGLASS WIDGET_CONTROL, ev.id, GET_UVALUE=new_fdata ; Compute addition itg_curr_image = new_fdata(*,*,0) FOR i=1,itg_img_count-1 DO $ itg_curr_image = itg_curr_image + new_fdata(*,*,i) itg_res_count = itg_img_count ; switch to last image itg_curr_index = itg_img_count-1 DEVICE, COPY=[0, 0, dim1, dim2, 0, 0, itg_pixmap(itg_curr_index) ] WIDGET_CONTROL, itg_sld, set_value = itg_curr_index ; update itg_lst ql_update_itg_list, 2 END itg_clear: BEGIN WIDGET_CONTROL, /HOURGLASS itg_curr_image(*,*) = 0.0 itg_res_count = 0 ; update itg_lst ql_update_itg_list, 3 END itg_cancel: BEGIN WIDGET_CONTROL, ev.top, /DESTROY RETURN END itg_valid: BEGIN WIDGET_CONTROL, /HOURGLASS valid_flag = 1 WIDGET_CONTROL, ev.top, /DESTROY RETURN END ELSE: ENDCASE FOR i=0, N_ELEMENTS(itg_item_lst)-1 DO BEGIN s1 = STRING (itg_curr_index, FORMAT='(I3.3)') IF (STRMID (itg_item_lst(i),1,3) EQ s1) THEN found = i ENDFOR IF (itg_res_count GT 0) THEN BEGIN IF found NE -1 THEN WIDGET_CONTROL,itg_remove, SENSITIVE=1$ ELSE WIDGET_CONTROL,itg_remove, SENSITIVE=0 WIDGET_CONTROL,itg_valid , SENSITIVE=1 WIDGET_CONTROL,itg_clear , SENSITIVE=1 ENDIF ELSE BEGIN WIDGET_CONTROL,itg_remove, SENSITIVE=0 WIDGET_CONTROL,itg_valid , SENSITIVE=0 WIDGET_CONTROL,itg_clear , SENSITIVE=0 ENDELSE IF (itg_curr_index GE itg_img_count-1) THEN WIDGET_CONTROL,itg_next, SENSITIVE = 0 $ ELSE WIDGET_CONTROL,itg_next, SENSITIVE = 1 IF (itg_curr_index GT 0) THEN WIDGET_CONTROL,itg_prev, SENSITIVE = 1 $ ELSE WIDGET_CONTROL,itg_prev, SENSITIVE = 0 ; Refesh banner ; ------------- IF (ev.id NE itg_cycle ) AND $ (ev.id NE itg_rate ) AND $ (ev.id NE itg_cancel ) AND $ (ev.id NE itg_valid) AND $ ((cutaxe EQ 'A') OR( cutaxe EQ 'D'))THEN $ FOR i=0, N_ELEMENTS(itg_banner)-1 DO WIDGET_CONTROL, itg_banner(i) , SET_VALUE =fits_banner(i,itg_curr_index) ; Refresh result display ; ---------------------- IF (ev.id EQ itg_add ) OR $ (ev.id EQ itg_all) OR $ (ev.id EQ itg_remove) OR $ (ev.id EQ itg_clear) $ THEN BEGIN WIDGET_CONTROL, itg_res, SET_DRAW_VIEW = [0,0] WIDGET_CONTROL, itg_res, GET_VALUE=res_win WSET, res_win tmpimg = BYTSCL(itg_curr_image,top=max_nb_color) TV,BYTSCL(tmpimg,min=color_min,max=color_max,top=max_nb_color) cmd_str = 'PLOT, [0,' + STRTRIM(STRING(dim1-1),2) + '],[0,' + STRTRIM(STRING(dim2-1),2) +']' + $ ',POSITION=[0,0,' + STRTRIM(STRING(dim1-1),2)+',' +STRTRIM(STRING(dim2-1),2)+']' + $ ',XSTYLE=1, YSTYLE=1' + $ ',/NODATA' + $ ',/DEVICE' + $ ',/NOERASE' ret = EXECUTE( cmd_str) WSET, itg_win ENDIF END ;############################################################################## ;#Function name : ql_gintg_item # ;#LEVEL : # ;# # ;#Author : Emmanuel PETIT # ;#Language : IDL # ;#Purpose : Selection of an integration items in a fits data cube # ;#Creation date : 09-05-94 # ;#External modules : # ;# # ;#Call sequence : # ;# # ;#Arguments : # ;# # ;#Description : # ;# # ;# # ;############################################################################## PRO ql_gintg_item, fheader, fdata, new_dfdata, tdim ;============================================================================ ; Common Block in use ;============================================================================ COMMON lff_com COMMON lff2_com COMMON const_com COMMON const2_com COMMON color_com ;============================================================================ ; Initialization ;============================================================================ x_offset = 0 y_offset = 0 Title = 'Integration Item Selection' itg_pixmap = LONARR (itg_img_count) itg_rate_val = 1L dim1 = FIX(tdim(axis_idx(0))) dim2 = FIX(tdim(axis_idx(1))) dim3 = FIX(tdim(axis_idx(2))) str1 = 'Current image (' + tdim(axis_idx(0)) + ' x '+ tdim(axis_idx(1))+ ')' str2 = 'Resulted image (' + tdim(axis_idx(0)) + ' x '+ tdim(axis_idx(1))+ ')' itg_curr_image = FLTARR (dim1, dim2) new_fdata = FLTARR (dim1, dim2, dim3) itg_banner_prp = LONARR(6) itg_banner = LONARR(6) fits_banner = STRARR(6, dim3) ; Banner values itg_res_count = 0 itg_curr_index = 0 ;============================================================================ ; Processing ;============================================================================ WIDGET_CONTROL, /HOURGLASS wait_base = WIDGET_BASE (TITLE= ' ',XOFFSET=630, YOFFSET=540, /COLUMN) tmp = WIDGET_LABEL (wait_base, VALUE=' ') tmp = WIDGET_LABEL (wait_base, VALUE='Loading images ...') tmp = WIDGET_LABEL (wait_base, VALUE='Please Wait.') tmp = WIDGET_LABEL (wait_base, VALUE=' ') WIDGET_CONTROL, wait_base, /REALIZE ; compute cuting axe ; ------------------ CASE axis_idx(0) OF 0:BEGIN CASE axis_idx(1) OF 1: cutaxe = 'A' 2: cutaxe = 'B' END END 1:BEGIN CASE axis_idx(1) OF 0: cutaxe = 'D' 2: cutaxe = 'C' END END 2:BEGIN CASE axis_idx(1) OF 0: cutaxe = 'E' 1: cutaxe = 'F' END END ENDCASE ; Build new_fdata, store images ; in Pixmap for fast display ; -------------------------- FOR i=0,itg_img_count-1 DO BEGIN WINDOW, /FREE ,/PIXMAP,XS = dim1,YS = dim2 itg_pixmap(i) = !D.WINDOW WSET, !D.WINDOW CASE cutaxe OF 'A' : new_fdata (*,*,i) = fdata(*,*,i) 'B' : new_fdata (*,*,i) = fdata(*,i,*) 'C' : new_fdata (*,*,i) = fdata(i,*,*) 'D' : new_fdata (*,*,i) = ROTATE(REFORM(fdata(*,*,i)),4) 'E' : new_fdata (*,*,i) = ROTATE(REFORM(fdata(*,i,*)),4) 'F' : new_fdata (*,*,i) = ROTATE(REFORM(fdata(i,*,*)),4) ELSE: ENDCASE tmpimg = BYTSCL(new_fdata(*,*,i),top=max_nb_color) TV,BYTSCL(tmpimg,min=color_min,max=color_max,top=max_nb_color) cmd_str = 'PLOT, [0,' + STRTRIM(STRING(dim1-1),2) + '],[0,' +STRTRIM(STRING(dim2-1),2) +']' + $ ',POSITION=[0,0,' + STRTRIM(STRING(dim1-1),2)+',' +STRTRIM(STRING(dim2-1),2)+']' + $ ',XSTYLE=1, YSTYLE=1' + $ ',/NODATA' + $ ',/DEVICE' + $ ',/NOERASE' ret = EXECUTE( cmd_str) ENDFOR ; Build image banners ; ------------------- IF (cutaxe EQ 'A') OR (cutaxe EQ 'D') THEN BEGIN fits_banner_prp = ['Observation date (UTC) : ' , $ 'Data coordinates (X,Y) (arcsec): ' , $ 'Exposure time (s) : ' , $ 'Image padded : ' , $ 'De-compression status : ' , $ 'Flat Field correction applied : ' ] FOR i=0,itg_img_count-1 DO BEGIN IF (delt_field_flg EQ 1) THEN fits_banner(0,i) = TAI2UTC(obt_base+delt_data(selected_field-1,i),/VMS) IF (solx_field_flg EQ 1) THEN fits_banner(1,i) = STRTRIM(STRING(solx_data(i)),2)+','+STRTRIM(STRING(soly_data(i)),2) IF (expo_field_flg EQ 1) THEN fits_banner(2,i) = STRTRIM(STRING(expo_data(i)),2) IF (stat_field_flg EQ 1) THEN BEGIN IF (stat_data(selected_field-1,i,0) EQ 0) THEN fits_banner(3,i)='Yes' $ ELSE fits_banner(3,i)='No' CASE (stat_data(selected_field-1,i,1) ) OF -1 : fits_banner(4,i) = 'Failed' 0 : fits_banner(4,i) = 'Partial' 1 : fits_banner(4,i) = 'OK' 2 : fits_banner(4,i) = 'Not Compressed' ELSE: fits_banner(4,i) = '?' ENDCASE CASE (stat_data(selected_field-1,i,4) AND '40'X) OF '40'X : fits_banner(5,i) = 'Yes' '00'X : fits_banner(5,i) = 'No' ELSE : fits_banner(5,i) = '?' ENDCASE ENDIF ENDFOR ENDIF ELSE BEGIN fits_banner_prp = ['Observation date (UTC) : ' , $ 'Data coordinates (X,Y) (arcsec): ' , $ 'Exposure time (s) : ' , $ ' ' , $ ' ' , $ ' ' ] IF (delt_field_flg EQ 1) THEN fits_banner(0,*) = $ TAI2UTC(obt_base +(TOTAL(delt_data(selected_field-1,*))/N_ELEMENTS(delt_data(selected_field-1,*))), /VMS) $ ELSE fits_banner(0,*) = TAI2UTC(obt_base , /VMS) IF (solx_field_flg EQ 1) THEN fits_banner(2,*) = $ STRTRIM(STRING(TOTAL(solx_data(selected_field-1,*))/N_ELEMENTS(solx_data(selected_field-1,*))),2)+',' + $ STRTRIM(STRING(TOTAL(soly_data(selected_field-1,*))/N_ELEMENTS(soly_data(selected_field-1,*))),2) IF (expo_field_flg EQ 1) THEN fits_banner(3,*) = $ STRTRIM(STRING(TOTAL(expo_data (selected_field-1,*)) / N_ELEMENTS(delt_data (selected_field-1,*))),2) ENDELSE ; Only one image: select it and return ; ------------------------------------ IF(itg_img_count EQ 1) THEN BEGIN WIDGET_CONTROL, wait_base, /DESTROY itg_curr_image = new_fdata(*,*,itg_curr_index) itg_res_count = itg_res_count + 1 itg_item_lst = STRARR (1) itg_item_lst(0) = '#'+STRING(itg_curr_index,FORMAT='(I3.3)')+' '+STRING(1,FORMAT='(I2.2)') valid_flag = 1 ; Free window ressource WDELETE, itg_pixmap(0) RETURN ENDIF ; Widget resources ; --------------- itg_base = WIDGET_BASE (TITLE=Title, XOFFSET=x_offset,YOFFSET=y_offset, $ /COLUMN, /MODAL) ret = WIDGET_LABEL(itg_base,VALUE=str1, FONT=Hd_Font_Bold) dummy1 = WIDGET_BASE (itg_base,/ROW,/FRAME) dummy11 = WIDGET_BASE (dummy1,/COLUMN) dummy12 = WIDGET_BASE (dummy1,/COLUMN) ret = WIDGET_LABEL(itg_base,VALUE=str2, FONT=Hd_Font_Bold) dummy2 = WIDGET_BASE (itg_base, /ROW,/FRAME) dummy21 = WIDGET_BASE (dummy2,/COLUMN) dummy22 = WIDGET_BASE (dummy2,/COLUMN) base = WIDGET_BASE (dummy11, /ROW, /FRAME) base1= WIDGET_BASE (base,/COLUMN) base2= WIDGET_BASE (base,/COLUMN) FOR i=0, N_ELEMENTS(itg_banner)-1 DO BEGIN itg_banner_prp(i) = WIDGET_LABEL(base1, VALUE = fits_banner_prp(i),FONT=Hd_Font_Bold) itg_banner (i) = WIDGET_LABEL(base2, VALUE = fits_banner(i,0), FONT=Hd_Font) ENDFOR itg_draw = WIDGET_DRAW (dummy11,XSIZE=IMAGE_X_SZ ,YSIZE=IMAGE_X_SZ, $ X_SCROLL_SIZE=1024,Y_SCROLL_SIZE=360,RETAIN = 2) ret = WIDGET_LABEL (dummy12, VALUE = 'Image #') itg_sld = WIDGET_SLIDER (dummy12,MINIMUM=0,MAXIMUM=itg_img_count-1,/DRAG) itg_next = WIDGET_BUTTON (dummy12, VALUE='NEXT') itg_prev = WIDGET_BUTTON (dummy12, VALUE='PREVIOUS') ret = WIDGET_LABEL (dummy12, VALUE = ' ') itg_cycle = WIDGET_BUTTON (dummy12, VALUE='START CYCLE', UVALUE='START') ret = WIDGET_LABEL (dummy12, VALUE = 'Cycle Rate') itg_rate = WIDGET_SLIDER (dummy12,MINIMUM=1,MAXIMUM=10,VALUE=itg_rate_val, /DRAG) ret = WIDGET_LABEL (dummy12, VALUE = ' ') itg_remove = WIDGET_BUTTON (dummy12, VALUE='REMOVE', UVALUE=new_fdata) itg_add = WIDGET_BUTTON (dummy12, VALUE='ADD' , UVALUE=new_fdata) itg_all = WIDGET_BUTTON (dummy12, VALUE='ALL' , UVALUE=new_fdata) itg_res = WIDGET_DRAW (dummy21 ,XSIZE=IMAGE_X_SZ,YSIZE=IMAGE_X_SZ,$ X_SCROLL_SIZE=1024,Y_SCROLL_SIZE=360,RETAIN=2) itg_valid = WIDGET_BUTTON (dummy22, VALUE='VALID') itg_cancel = WIDGET_BUTTON (dummy22, VALUE='CANCEL') itg_clear = WIDGET_BUTTON (dummy22, VALUE='CLEAR') itg_lst = WIDGET_LIST (dummy22, VALUE=' ',FONT=Hd_Font_Bold,YSIZE=15,XSIZE=9) WIDGET_CONTROL, itg_base, /REALIZE WIDGET_CONTROL, itg_prev , SENSITIVE = 0 WIDGET_CONTROL, itg_remove , SENSITIVE = 0 WIDGET_CONTROL, itg_valid , SENSITIVE = 0 WIDGET_CONTROL, itg_clear , SENSITIVE = 0 WIDGET_CONTROL, itg_next, /INPUT_FOCUS ; First item in display area ; -------------------------- WIDGET_CONTROL, itg_draw, GET_VALUE = itg_win WIDGET_CONTROL, itg_draw, SET_DRAW_VIEW = [0,0] WSET,itg_win DEVICE, COPY=[0,0,dim1,dim2,0,0,itg_pixmap(0)] WIDGET_CONTROL, wait_base, /DESTROY XMANAGER, 'ql_gintg', itg_base ; Free window ressources FOR i=0, itg_img_count-1 DO WDELETE, itg_pixmap(i) END ;############################################################################## ;#Function name : ql_gfdata_event # ;#LEVEL : # ;# # ;#Author : Emmanuel PETIT # ;#Language : IDL # ;#Purpose : selection of an image/profile from fits field # ;#Creation date : 05-05-94 # ;#External modules : # ;# # ;#Call sequence : # ;# # ;#Arguments : # ;# # ;#Description : # ;# # ;# # ;############################################################################## PRO ql_gfdata_event, ev ;============================================================================ ; Common Block in use ;============================================================================ COMMON lff_com COMMON lff2_com COMMON color_com ;============================================================================ ; Initialization ;============================================================================ NOT_ALLOWED = ['MOMENT', 'SOLAR_XY'] ok_flg = 0 curr_dim = 0 ;============================================================================ ; Processing ;============================================================================ CASE ev.id OF fdimension(0): BEGIN WIDGET_CONTROL, ev.id, GET_UVALUE=tdesc flg = 0 FOR i=0, N_ELEMENTS(NOT_ALLOWED)-1 DO BEGIN IF (tdesc(0) EQ NOT_ALLOWED(i)) THEN flg = 1 ENDFOR IF (flg EQ 0) THEN BEGIN curr_dim = 0 ok_flg = 1 ENDIF ELSE BEGIN WIDGET_CONTROL, ev.id, SET_BUTTON=0 ENDELSE END fdimension(1): BEGIN WIDGET_CONTROL, ev.id, GET_UVALUE=tdesc flg = 0 FOR i=0, N_ELEMENTS(NOT_ALLOWED)-1 DO BEGIN IF (tdesc(0) EQ NOT_ALLOWED(i)) THEN flg = 1 ENDFOR IF (flg EQ 0) THEN BEGIN curr_dim = 1 ok_flg = 1 ENDIF ELSE BEGIN WIDGET_CONTROL, ev.id, SET_BUTTON=0 ENDELSE END fdimension(2): BEGIN WIDGET_CONTROL, ev.id, GET_UVALUE=tdesc flg = 0 FOR i=0, N_ELEMENTS(NOT_ALLOWED)-1 DO BEGIN IF (tdesc(0) EQ NOT_ALLOWED(i)) THEN flg = 1 ENDFOR IF (flg EQ 0) THEN BEGIN curr_dim = 2 ok_flg = 1 ENDIF ELSE BEGIN WIDGET_CONTROL, ev.id, SET_BUTTON=0 ENDELSE END fdata_cancel : WIDGET_CONTROL, ev.top, /DESTROY fdata_clear: BEGIN nb_dim=0 WIDGET_CONTROL, fsel_lbl(0), SET_VALUE = ' ' WIDGET_CONTROL, fsel_lbl(1), SET_VALUE = ' ' WIDGET_CONTROL, fsel_lbl(2), SET_VALUE = ' ' WIDGET_CONTROL, fdimension(0), SET_BUTTON=0 WIDGET_CONTROL, fdimension(1), SET_BUTTON=0 WIDGET_CONTROL, fdimension(2), SET_BUTTON=0 END fdata_valid: BEGIN valid_dim = 1 FOR i=0, 2 DO BEGIN WIDGET_CONTROL, fsel_lbl(i), GET_VALUE = tmp IF (tmp EQ 'X') THEN axis_idx(0) = i IF (tmp EQ 'Y') THEN axis_idx(1) = i IF (tmp EQ ' ') THEN axis_idx(2) = i ENDFOR WIDGET_CONTROL, ev.top, /DESTROY END ENDCASE IF (ok_flg EQ 1) THEN BEGIN IF (ev.select EQ 1) THEN BEGIN CASE nb_dim OF 0: BEGIN nb_dim = nb_dim + 1 WIDGET_CONTROL, fsel_lbl(curr_dim), SET_VALUE = 'X' END 1: BEGIN nb_dim = nb_dim + 1 WIDGET_CONTROL, fsel_lbl(curr_dim), SET_VALUE = 'Y' END ELSE: BEGIN WIDGET_CONTROL, fdimension(curr_dim), SET_BUTTON=0 END ENDCASE ENDIF ELSE BEGIN CASE nb_dim OF 0: BEGIN WIDGET_CONTROL, fsel_lbl(curr_dim), SET_VALUE = ' ' END 1: BEGIN nb_dim = nb_dim - 1 WIDGET_CONTROL, fsel_lbl(curr_dim), SET_VALUE = ' ' END 2: BEGIN nb_dim = nb_dim - 1 WIDGET_CONTROL, fsel_lbl(curr_dim), SET_VALUE = ' ' FOR i=0, 2 DO BEGIN WIDGET_CONTROL, fsel_lbl(i), GET_VALUE = tmp IF (tmp NE ' ') THEN WIDGET_CONTROL, fsel_lbl(i), SET_VALUE = 'X' ENDFOR END ELSE: ENDCASE ENDELSE ENDIF ELSE BEGIN IF (ev.id NE fdata_valid) AND $ (ev.id NE fdata_cancel) $ THEN WIDGET_CONTROL, fdimension(curr_dim), SET_BUTTON=0 ENDELSE IF (ev.id NE fdata_valid) AND (ev.id NE fdata_cancel) THEN BEGIN IF (nb_dim EQ 2) THEN WIDGET_CONTROL, fdata_valid , SENSITIVE=1 $ ELSE WIDGET_CONTROL, fdata_valid , SENSITIVE=0 ENDIF END ;############################################################################## ;#Function name : ql_get_fits_data # ;#LEVEL : # ;# # ;#Author : Emmanuel PETIT # ;#Language : IDL # ;#Purpose : selection of an image/profile from selected field # ;#Creation date : 05-05-94 # ;#External modules : # ;# # ;#Call sequence : # ;# # ;#Arguments : # ;# # ;#Description : # ;# # ;# # ;############################################################################## PRO ql_get_fits_data, header, fdata , new_fdata ;============================================================================ ; Common Block in use ;============================================================================ COMMON lff_com COMMON lff2_com COMMON const_com COMMON const2_com COMMON curr_data_i_com COMMON curr_data_p_com COMMON color_com ;============================================================================ ; Initialization ;============================================================================ x_offset = 670 y_offset = 600 Title = 'Dimension Selection' fdimension = LONARR(3) fsel_lbl = LONARR(3) axis_idx = INTARR(3) nb_dim = 0 valid_dim = 0 ;============================================================================ ; Processing ;============================================================================ WIDGET_CONTROL, /HOURGLASS tdesc = FXPAR (header, 'TDESC'+ STRTRIM(STRING(selected_field),2)) tdim = FXPAR (header, 'TDIM' + STRTRIM(STRING(selected_field),2), COUNT=cnt) ; Single profile ; -------------- IF (cnt EQ 0) THEN BEGIN ; 1 dimension valid_flag = 1 s = size(fdata) CASE s(2) OF 1: curr_data_p = BYTARR(1, s(1)) 2: curr_data_p = INTARR(1, s(1)) 3: curr_data_p = LONARR(1, s(1)) 4: curr_data_p = FLTARR(1, s(1)) 5: curr_data_p = DBLARR(1, s(1)) ENDCASE curr_data_p(0,*) = fdata(*) ql_ldprf_ctrl_str, header ret = ql_display_data(curr_data_p, 100, curr_dctrl_p, err) RETURN ENDIF tdim = FXBTDIM (tdim) tdesc = FXBTDIM (tdesc) IF (tdim(0) EQ 1) AND (N_ELEMENTS(tdim) EQ 2) THEN BEGIN ; 1 profile valid_flag = 1 s = size(fdata) CASE s(3) OF 1: curr_data_p = BYTARR(1, s(2)) 2: curr_data_p = INTARR(1, s(2)) 3: curr_data_p = LONARR(1, s(2)) 4: curr_data_p = FLTARR(1, s(2)) 5: curr_data_p = DBLARR(1, s(2)) ENDCASE curr_data_p(0,*) = fdata(*) ql_ldprf_ctrl_str, header load_flag_p = 1 ret = ql_display_data(curr_data_p, 100, curr_dctrl_p, err) RETURN ENDIF IF (tdim(0) EQ 2) AND (N_ELEMENTS(tdim) EQ 2) THEN BEGIN ; 2 profiles valid_flag = 1 s = size(fdata) CASE s(3) OF 1: curr_data_p = BYTARR(2, s(2)) 2: curr_data_p = INTARR(2, s(2)) 3: curr_data_p = LONARR(2, s(2)) 4: curr_data_p = FLTARR(2, s(2)) 5: curr_data_p = DBLARR(2, s(2)) ENDCASE curr_data_p(0,*) = fdata(0,*) curr_data_p(1,*) = fdata(1,*) ql_ldprf_ctrl_str, header load_flag_p = 2 ret = ql_display_data(curr_data_p, 101, curr_dctrl_p, err) RETURN ENDIF IF (tdim(0) EQ 4) AND (N_ELEMENTS(tdim) EQ 2) THEN BEGIN ; 4 profiles valid_flag = 1 s = size(fdata) CASE s(3) OF 1: curr_data_p = BYTARR(4, s(2)) 2: curr_data_p = INTARR(4, s(2)) 3: curr_data_p = LONARR(4, s(2)) 4: curr_data_p = FLTARR(4, s(2)) 5: curr_data_p = DBLARR(4, s(2)) ENDCASE curr_data_p(0,*) = fdata(0,*) curr_data_p(1,*) = fdata(1,*) curr_data_p(2,*) = fdata(2,*) curr_data_p(3,*) = fdata(3,*) ql_ldprf_ctrl_str, header load_flag_p = 4 ret = ql_display_data(curr_data_p, 102, curr_dctrl_p, err) RETURN ENDIF IF (tdim(0) EQ 5) AND (N_ELEMENTS(tdim) EQ 2) THEN BEGIN ; 5 profiles valid_flag = 1 s = size(fdata) CASE s(3) OF 1: curr_data_p = BYTARR(5, s(2)) 2: curr_data_p = INTARR(5, s(2)) 3: curr_data_p = LONARR(5, s(2)) 4: curr_data_p = FLTARR(5, s(2)) 5: curr_data_p = DBLARR(5, s(2)) ENDCASE curr_data_p(0,*) = fdata(0,*) curr_data_p(1,*) = fdata(1,*) curr_data_p(2,*) = fdata(2,*) curr_data_p(3,*) = fdata(3,*) curr_data_p(4,*) = fdata(4,*) ql_ldprf_ctrl_str, header load_flag_p = 5 ret = ql_display_data(curr_data_p, 103, curr_dctrl_p, err) RETURN ENDIF ; Single image ; -------------- IF (N_ELEMENTS(tdim) EQ 2) THEN BEGIN ; 2 dimensions only valid_flag = 1 curr_data_i = fdata ql_load_ctrl_str, header, IMAGE ; init ctrl str for a single image ret = ql_display_data(curr_data_i, 0, curr_dctrl_i, err) RETURN ENDIF ; ======================================= ; Selection of 2 dimensions in the 'cube' ; ======================================= select_list = tdesc + ' ' + tdim fdata_base = WIDGET_BASE (TITLE=Title,XOFFSET=x_offset,YOFFSET=y_offset, $ XSIZE=250,/COLUMN,/MODAL) ret = WIDGET_LABEL (fdata_base, VALUE='Select 2 dimensions') FOR i=0, N_ELEMENTS(select_list)-1 DO BEGIN dummy = WIDGET_BASE (fdata_base, /ROW) fsel_lbl (i) = WIDGET_LABEL (dummy, VALUE=' ', FONT=Line_Font) dummy = WIDGET_BASE (dummy, /NONEXCLUSIVE, /ROW) fdimension(i) = WIDGET_BUTTON (dummy,VALUE=tdesc(i)+'('+tdim(i)+')',FONT=Line_Font,UVALUE=tdesc(i)) ENDFOR dummy = WIDGET_BASE (fdata_base, /ROW) fdata_valid = WIDGET_BUTTON(dummy, VALUE = 'VALID') fdata_cancel = WIDGET_BUTTON(dummy, VALUE = 'CANCEL') fdata_clear = WIDGET_BUTTON(dummy, VALUE = 'CLEAR') WIDGET_CONTROL, fdata_valid, SENSITIVE = 0 WIDGET_CONTROL, fdimension(0), /INPUT_FOCUS WIDGET_CONTROL, fdata_base , /REALIZE XMANAGER, 'ql_gfdata', fdata_base ; =========================================== ; Image builder. ; Data struture initialization ; =========================================== IF (valid_dim EQ 1) THEN BEGIN itg_img_count = FIX(tdim(axis_idx(2))) ql_gintg_item, header, fdata, new_fdata, tdim IF (valid_flag EQ 1) THEN BEGIN curr_data_i = itg_curr_image ql_load_ctrl_str, header, COM_IMAGE ret = ql_display_data(curr_data_i, 0, curr_dctrl_i, err) ENDIF ENDIF END ;############################################################################## ;#Function name : ql_ldprf_ctrl_str # ;# # ;#Author : Emmanuel PETIT # ;#Language : IDL # ;#Purpose : load control structure in case of profile # ;#Creation date : 16-05-94 # ;#External modules : # ;# # ;#Call sequence : # ;# # ;#Arguments : # ;# # ;#Description : # ;# # ;# # ;############################################################################## PRO ql_ldprf_ctrl_str, fits_hd ;============================================================================ ; Common Block in use ;============================================================================ COMMON lff_com COMMON lff2_com COMMON curr_data_p_com COMMON const_com COMMON const2_com COMMON scient_com COMMON target_com COMMON instr_id_com COMMON instr_evt_com COMMON meth_com COMMON load_flg_com COMMON color_com ;============================================================================ ; Initialization ;============================================================================ err = 0 ;============================================================================ ; Processing ;============================================================================ WIDGET_CONTROL, /HOURGLASS ; Get primary fits header ; ----------------------- primary_hd = HEADFITS (thefile, EXTEN=0) ; Initialize RRD header ; --------------------- ql_init_rrd_hd, curr_header_p tmp = FXPAR(fits_hd,'TDIM'+STRTRIM(STRING(selected_field),2),COUNT=cnt) IF (cnt EQ 1) THEN BEGIN tdim = FXBTDIM (tmp) dim1 = FIX(tdim(1)) ENDIF ELSE BEGIN dim1 = N_ELEMENTS(curr_data_p) ENDELSE tmp = FXPAR(fits_hd,'TDESC'+STRTRIM(STRING(selected_field),2),COUNT=cnt) IF (cnt EQ 1) THEN BEGIN tdesc = FXBTDIM (tmp) dir1 = STRTRIM(tdesc(1),2) ENDIF ELSE BEGIN dir1 =' ' ENDELSE tmp = FXPAR(fits_hd,'TUNIT'+STRTRIM(STRING(selected_field),2),COUNT=cnt) IF (cnt EQ 1) THEN BEGIN tunit = FXBTDIM (tmp) unit1 = STRTRIM(tunit(1),2) ENDIF ELSE BEGIN unit1 =' ' ENDELSE twave = FXPAR(fits_hd,'TWAVE'+STRTRIM(STRING(selected_field),2),COUNT=cnt) IF (cnt EQ 0) THEN twave = 0.0 ; +++++++++++++++ ; COMPUTED VALUES ; +++++++++++++++ ; datatype CASE (ttype_list(selected_field-1)) OF 'SUM_STATUS': imgtype = 14 'DEL_TIME' : imgtype = 10 'EXPTIME' : imgtype = 10 'SOLAR_X' : imgtype = 29 'SOLAR_Y' : imgtype = 9 ELSE : imgtype = 11 ENDCASE curr_header_p.DATATYPE=BYTE(imgtype) ; Total counts in profile curr_header_p.SSIMGTOT = LONG(TOTAL(curr_data_p)) ; Data format ds = size (curr_data_p) IF (ds(3) EQ 5) THEN BEGIN curr_data_p = FLOAT (curr_data_p) ds = size (curr_data_p) ENDIF curr_header_p.DATAFMT = ds(3) ; brightest pixel bp = LONG(MAX(curr_data_p,maxpix)) curr_header_p.SSBPCNTS = bp ; brigtest pixel coordinates curr_header_p.SSBPADDY = maxpix MOD dim1 curr_header_p.SSBPADDZ = maxpix / dim1 ; ++++++++++++++++++++++++++ ; VALUES FROM PRIMARY HEADER ; ++++++++++++++++++++++++++ ; GPOP/UDP id curr_header_p.SSPOPUDP = FIX(FXPAR(primary_hd, 'POPUDP')) ; Binning factors binny = FIX(FXPAR(primary_hd, 'BINX', COUNT=cnt1)) binnz = FIX(FXPAR(primary_hd, 'BINY', COUNT=cnt2)) IF (cnt1 EQ 1) THEN curr_header_p.SSBINNY = binny IF (cnt2 EQ 1) THEN curr_header_p.SSBINNZ = binnz ; Solar rotation compensation curr_header_p.SSROTCMP = FLOAT(FXPAR(primary_hd, 'ROTCMP')) ; locate curr_header_p.SSPGTYPE = FIX(FXPAR(primary_hd, 'LOCATE')) ; IPOP/UDP ID curr_header_p.SSADMCNT = FIX(FXPAR(primary_hd, 'PROG_ID')) ; Compression parameters curr_header_p.SSCOMPP1 = LONG(FXPAR(primary_hd, 'COMPAR1')) curr_header_p.SSCOMPP2 = LONG(FXPAR(primary_hd, 'COMPAR2')) curr_header_p.SSCOMPP3 = LONG(FXPAR(primary_hd, 'COMPAR3')) ; II event coordiates curr_header_p.SSIIDY = FIX( FLOAT(FXPAR(primary_hd, 'ININVALX'))) curr_header_p.SSIIDZ = FIX(-FLOAT(FXPAR(primary_hd, 'ININVALY'))) ; Scientist str = STRTRIM(FXPAR(primary_hd, 'SCIENTIS'),2) tmp = STRMID (str,STRPOS(str,'<')+1, STRPOS(str,'>')-1 ) IF (tmp NE '') THEN curr_header_p.SSSCIENT= FIX(tmp) ; target str = STRTRIM(FXPAR(primary_hd, 'OBJECT'),2) tmp = STRMID (str,STRPOS(str,'<')+1, STRPOS(str,'>')-1 ) IF (tmp NE '') THEN curr_header_p.SSTARGET=FIX(tmp) ; II master ID str = STRTRIM(FXPAR(primary_hd, 'ININM_ID'),2) tmp = STRMID (str,STRPOS(str,'<')+1, STRPOS(str,'>')-1 ) IF (tmp NE '') THEN curr_header_p.SSIIMIDY = FIX(tmp) ; II solar event str = STRTRIM(FXPAR(primary_hd, 'ININSE'),2) tmp = STRMID (str,STRPOS(str,'<')+1, STRPOS(str,'>')-1 ) IF (tmp NE '') THEN curr_header_p.SSIISEZ = FIX(tmp) ; Compression scheme str = STRTRIM(FXPAR(primary_hd, 'COMPRESS'),2) tmp = STRMID (str,STRPOS(str,'<')+1, STRPOS(str,'>')-1 ) IF (tmp NE '') THEN curr_header_p.SSCOMPRM = FIX(tmp) ; Slit str = STRTRIM(FXPAR(primary_hd, 'SLIT'),2) tmp = STRMID (str,STRPOS(str,'<')+1, STRPOS(str,'>')-1 ) IF (tmp NE '') THEN curr_header_p.SSSLITNB = FIX(tmp) ; reference pixel refpix = FIX(FXPAR(primary_hd,'DET_X'))-1 curr_header_p.SSREFPIX = refpix IF (curr_header_p.SSREFPIX LT 0) THEN curr_header_p.SSREFPIX=curr_header_p.SSREFPIX+REFPIX_OFFSET ; reference wavelength curr_header_p.SSWAVEL = twave ; Compute observation date tmp = FXPAR(primary_hd, 'DATE_OBS', COUNT=cnt) IF (cnt EQ 1) THEN BEGIN obt_base = UTC2TAI(tmp) ret = TAI2UTC (obt_base, /EXTERNAL) curr_header_p.SSEXPTYR = BYTE(FIX(STRMID(STRING(ret.year, FORMAT='(I4.4)'),2,2))) curr_header_p.SSEXPTMO = BYTE(ret.month) curr_header_p.SSEXPTDY = BYTE(ret.day) curr_header_p.SSEXPTHR = BYTE(ret.hour) curr_header_p.SSEXPTMN = BYTE(ret.minute) curr_header_p.SSEXPTSC = BYTE(ret.second) curr_header_p.SSEXPTCS = BYTE(FIX(ret.millisecond/10.0)) ENDIF ; solar position solarx = FXPAR(primary_hd, 'XCEN') solary = FXPAR(primary_hd, 'YCEN') curr_header_p.SSSUNY = FIX(solarx * 16.0) curr_header_p.SSSUNZ = FIX(-solary * 16.0) ; exposure time expotime = FXPAR(primary_hd, 'EXPTIME') curr_header_p.SSEXPTIM = FLOAT(expotime) ;-------------------------------------------- ;Init and fill display control str and banner ;-------------------------------------------- ; Init display control structure ql_init_dctrl, PROFILE ; init banner ql_init_banner, curr_data_p, PROFILE, err ; Title curr_dctrl_p.title = STRING(STRTRIM(FXPAR (primary_hd,'FILENAME'),2), FORMAT=Title_Format) ; Axis comments curr_dctrl_p.x.comment = STRING(dir1+' ('+unit1+')', FORMAT=Comment_Format) CASE (ttype_list(selected_field-1)) OF 'SUM_STATUS': cmt = 'SUM_STATUS' 'DEL_TIME' : cmt = 'DEL_TIME (SECOND)' 'EXPTIME' : cmt = 'EXPTIME (SECOND)' 'SOLAR_X' : cmt = 'SOLAR_X (ARCSEC)' 'SOLAR_Y' : cmt = 'SOLAR_Y (ARCSEC)' ELSE : cmt = ttype_list(selected_field-1) ENDCASE curr_dctrl_p.y.comment = STRING(cmt, FORMAT=Comment_Format) ; compute axis extrema ; -------------------- max = MAX (curr_data_p(0,*), MIN=min) IF (min EQ max) THEN BEGIN val = max min = val - ((FLOOR(val/10.0))>1) max = val + ((CEIL(val/10.0))>1) ENDIF curr_dctrl_p.y.min = min curr_dctrl_p.y.max = max curr_dctrl_p.y.plot_min = curr_dctrl_p.y.min curr_dctrl_p.y.plot_max = curr_dctrl_p.y.max ; ------------- ; Init curr_x_p ; ------------- sz_x = curr_dctrl_p.x.nb_dot curr_x_p = FINDGEN (sz_x) curr_x_p = $ curr_dctrl_p.x.min+curr_x_p*(curr_dctrl_p.x.max-curr_dctrl_p.x.min)/(sz_x-1) load_flag_p = 1 END ;############################################################################## ;#Function name : ql_get_opt_data # ;#LEVEL : # ;# # ;#Author : Emmanuel PETIT # ;#Language : IDL # ;#Purpose : manage load of optional column # ;#Creation date : 26-09-95 # ;#External modules : # ;# # ;#Call sequence : # ;# # ;#Arguments : # ;# # ;#Description : # ;# # ;# # ;############################################################################## PRO ql_get_opt_data, header, fits_data ;============================================================================ ; Common Block in use ;============================================================================ COMMON lff_com COMMON lff2_com COMMON const_com COMMON const2_com COMMON curr_data_p_com COMMON load_flg_com COMMON color_com ;============================================================================ ; Initialization ;============================================================================ x_offset = 670 y_offset = 600 Title = 'Data set Selection' axis_idx = INTARR(3) ;============================================================================ ; Processing ;============================================================================ WIDGET_CONTROL, /HOURGLASS ; return if only 1 data ; --------------------- tmp = FXPAR(header,'TDIM' + STRTRIM(STRING(selected_field),2),COUNT=cnt) IF (cnt EQ 1) THEN BEGIN tdim = FXBTDIM (tmp) ; tdimi = (x,1) <=> 1 data per column IF (FIX(tdim(1)) LE 1) THEN BEGIN valid_flag = 0 RETURN ENDIF valid_flag = 1 ENDIF ELSE BEGIN valid_flag = 0 RETURN ENDELSE ; initialize control structures ; ----------------------------- IF (ttype_list(selected_field-1) EQ 'SUM_STATUS') THEN BEGIN curr_data_p = INTARR (5,N_ELEMENTS(fits_data(raw_data_idx-1,*,0))) curr_data_p(0,*) = fits_data (raw_data_idx-1,*,0) curr_data_p(1,*) = fits_data (raw_data_idx-1,*,1) curr_data_p(2,*) = fits_data (raw_data_idx-1,*,2) curr_data_p(3,*) = fits_data (raw_data_idx-1,*,3) curr_data_p(4,*) = fits_data (raw_data_idx-1,*,4) ENDIF ELSE BEGIN curr_data_p = fits_data (raw_data_idx-1,*) ENDELSE ql_ldprf_ctrl_str, header ; set some display parameter ; (opt colon display) ; -------------------------- curr_dctrl_p.color = blue curr_dctrl_p.x.plot_sz = 500 curr_dctrl_p.x.offset = 300 curr_dctrl_p.x.nb_tick = (curr_dctrl_p.x.nb_dot-1)<29 curr_dctrl_p.y.plot_sz = 170 ; Display opt data as profile ; --------------------------- IF (ttype_list(selected_field-1) EQ 'SUM_STATUS') THEN BEGIN load_flag_p = 5 ret = ql_display_data(curr_data_p, 103, curr_dctrl_p, err) ENDIF ELSE BEGIN ret = ql_display_data(curr_data_p, 100, curr_dctrl_p, err) ENDELSE END ;############################################################################## ;#Function name : ql_gfield_event # ;#LEVEL : # ;# # ;#Author : Emmanuel PETIT # ;#Language : IDL # ;#Purpose : selection of field in fits file # ;#Creation date : 05-05-94 # ;#External modules : # ;# # ;#Call sequence : # ;# # ;#Arguments : # ;# # ;#Description : # ;# # ;# # ;############################################################################## PRO ql_gfield_event, ev ;============================================================================ ; Common Block in use ;============================================================================ COMMON lff_com COMMON lff2_com COMMON color_com ;============================================================================ ; Initialization ;============================================================================ optcolumn = ['SUM_STATUS', $ 'DEL_TIME' , $ 'EXPTIME' , $ 'SOLAR_X' , $ 'SOLAR_Y' , $ 'INS_X' , $ 'INS_Y' , $ 'OPS_L' , $ 'OPS_R' , $ 'MIR_POS' , $ 'SLIT_POS'] ;============================================================================ ; Processing ;============================================================================ WIDGET_CONTROL, ev.id, GET_UVALUE=value CASE ev.id OF field_lst : BEGIN selected_field = ev.index + 1 flg = 0 FOR j=0, N_ELEMENTS(optcolumn)-1 DO BEGIN IF (ttype_list(ev.index) EQ optcolumn(j)) THEN flg=1 ENDFOR IF (flg EQ 0) THEN BEGIN raw_data_idx = selected_field WIDGET_CONTROL, field_lbl, SET_VALUE=ttype_list(selected_field-1) ENDIF END field_load: BEGIN WIDGET_CONTROL, GET_UVALUE=header ; Wait message wait_base = WIDGET_BASE (TITLE= ' ',XOFFSET=630, YOFFSET=540, /COLUMN) tmp = WIDGET_LABEL (wait_base, VALUE=' ') tmp = WIDGET_LABEL (wait_base, VALUE='Loading FITS data...') tmp = WIDGET_LABEL (wait_base, VALUE='Please Wait.') tmp = WIDGET_LABEL (wait_base, VALUE=' ') WIDGET_CONTROL, wait_base, /REALIZE nb_opt_col=0 FOR i=0, N_ELEMENTS(ttype_list)-1 DO $ FOR j=0, N_ELEMENTS(optcolumn)-1 DO $ IF (ttype_list(i) EQ optcolumn(j)) THEN nb_opt_col = nb_opt_col+1 nb_raw_col = N_ELEMENTS(ttype_list)-nb_opt_col ; Load selected column ; -------------------- WIDGET_CONTROL, /HOURGLASS FXBOPEN, unit, thefile , extend_index, header FXBREAD, unit, fits_data, selected_field szmain = SIZE (fits_data) ; Load optinal columns if needed ; ------------------------------- flg = 0 FOR j=0, N_ELEMENTS(optcolumn)-1 DO $ IF (ttype_list(selected_field-1) EQ optcolumn(j)) THEN flg=1 IF (flg EQ 0) THEN BEGIN FOR l=0, N_ELEMENTS(ttype_list)-1 DO BEGIN CASE ttype_list(l) OF 'SUM_STATUS': BEGIN stat_field_flg = 1 FXBREAD, unit, stat_data, l+1 END 'DEL_TIME':BEGIN delt_field_flg = 1 FXBREAD, unit, delt_data, l+1 delt_data = DOUBLE(delt_data) ; adapt del_time according to main data dimension ; ----------------------------------------------- szopt = SIZE (delt_data) IF (szopt(1) NE nb_raw_col) THEN BEGIN nn = N_ELEMENTS(delt_data) CASE szopt(szopt(0)+1) OF 1 :tmp_opt = BYTARR (nb_raw_col, nn) 2 :tmp_opt = INTARR (nb_raw_col, nn) 3 :tmp_opt = LONARR (nb_raw_col, nn) 4 :tmp_opt = FLTARR (nb_raw_col, nn) 5 :tmp_opt = DBLARR (nb_raw_col, nn) ENDCASE FOR i=0, nb_raw_col-1 DO tmp_opt(i,*) = delt_data(*) delt_data = tmp_opt ENDIF END 'EXPTIME':BEGIN expo_field_flg = 1 FXBREAD, unit, expo_data, l+1 ; adapt exp_time according to main data dimension ; ----------------------------------------------- szopt = SIZE (expo_data) IF (szopt(1) NE nb_raw_col) THEN BEGIN nn = N_ELEMENTS(expo_data) CASE szopt(szopt(0)+1) OF 1 :tmp_opt = BYTARR (nb_raw_col, nn) 2 :tmp_opt = INTARR (nb_raw_col, nn) 3 :tmp_opt = LONARR (nb_raw_col, nn) 4 :tmp_opt = FLTARR (nb_raw_col, nn) 5 :tmp_opt = DBLARR (nb_raw_col, nn) ENDCASE FOR i=0, nb_raw_col-1 DO tmp_opt(i,*) = expo_data(*) expo_data = tmp_opt ENDIF END 'SOLAR_X':BEGIN solx_field_flg = 1 FXBREAD, unit, solx_data, l+1 ; adapt solar_x according to main data dimension ; ----------------------------------------------- szopt = SIZE (solx_data) IF (szopt(1) NE nb_raw_col) THEN BEGIN nn = N_ELEMENTS(solx_data) CASE szopt(szopt(0)+1) OF 1 :tmp_opt = BYTARR (nb_raw_col, nn) 2 :tmp_opt = INTARR (nb_raw_col, nn) 3 :tmp_opt = LONARR (nb_raw_col, nn) 4 :tmp_opt = FLTARR (nb_raw_col, nn) 5 :tmp_opt = DBLARR (nb_raw_col, nn) ENDCASE FOR i=0, nb_raw_col-1 DO tmp_opt(i,*) = solx_data(*) solx_data = tmp_opt ENDIF END 'SOLAR_Y':BEGIN soly_field_flg = 1 FXBREAD, unit, soly_data, l+1 ; adapt solar_y according to main data dimension ; ----------------------------------------------- szopt = SIZE (soly_data) IF (szopt(1) NE nb_raw_col) THEN BEGIN nn = N_ELEMENTS(soly_data) CASE szopt(szopt(0)+1) OF 1 :tmp_opt = BYTARR (nb_raw_col, nn) 2 :tmp_opt = INTARR (nb_raw_col, nn) 3 :tmp_opt = LONARR (nb_raw_col, nn) 4 :tmp_opt = FLTARR (nb_raw_col, nn) 5 :tmp_opt = DBLARR (nb_raw_col, nn) ENDCASE FOR i=0, nb_raw_col-1 DO tmp_opt(i,*) = soly_data(*) soly_data = tmp_opt ENDIF END ELSE: ENDCASE ENDFOR FXBCLOSE, unit ; Remove wait message WIDGET_CONTROL, wait_base, /DESTROY ; Select dimensions ; ----------------- ql_get_fits_data, header, fits_data, new_fdata IF (valid_flag EQ 1) THEN WIDGET_CONTROL, ev.top, /DESTROY ENDIF ELSE BEGIN FXBCLOSE, unit ; Remove wait message WIDGET_CONTROL, wait_base, /DESTROY ; manage optionnal data plot ; -------------------------- ql_get_opt_data, header, fits_data IF (valid_flag EQ 1) THEN WIDGET_CONTROL, ev.top, /DESTROY ENDELSE END field_cancel: BEGIN selected_field = 0 WIDGET_CONTROL, ev.top , /DESTROY END ENDCASE END ;############################################################################## ;#Function name : ql_get_fits_field # ;#LEVEL : # ;# # ;#Author : Emmanuel PETIT # ;#Language : IDL # ;#Purpose : selection of a field in a fits file # ;#Creation date : 05-05-94 # ;#External modules : # ;# # ;#Call sequence : # ;# # ;#Arguments : # ;# # ;#Description : # ;# # ;# # ;############################################################################## PRO ql_get_fits_field, header ;============================================================================ ; Common Block in use ;============================================================================ COMMON lff_com COMMON lff2_com COMMON const_com COMMON const2_com COMMON color_com ;============================================================================ ; Initialization ;============================================================================ x_offset = 540 y_offset = 480 Title = 'Field Selection' selected_field = 1 tdesc_list = FXPAR (header, 'TDESC*') ttype_list = STRTRIM(FXPAR (header, 'TTYPE*'),2) field_list = ttype_list + ' ' + tdesc_list stat_field_flg = 0 delt_field_flg = 0 expo_field_flg = 0 solx_field_flg = 0 soly_field_flg = 0 raw_data_idx = 1 ;============================================================================ ; Processing ;============================================================================ WIDGET_CONTROL, /HOURGLASS field_base = WIDGET_BASE (TITLE=Title,XOFFSET = x_offset, $ YOFFSET=y_offset,/COLUMN,/MODAL) field_lst = WIDGET_LIST (field_base,VALUE=field_list,FONT=Line_Font,YSIZE=8) field_lbl = WIDGET_LABEL (field_base,VALUE=ttype_list(raw_data_idx-1) ,FONT=Line_Font) dummy = WIDGET_BASE (field_base, /ROW) field_load = WIDGET_BUTTON (dummy,UVALUE=header,VALUE = 'LOAD') field_cancel= WIDGET_BUTTON (dummy,VALUE = 'CANCEL') WIDGET_CONTROL, field_base, /REALIZE WIDGET_CONTROL, field_lst, /INPUT_FOCUS WIDGET_CONTROL,field_lst, SET_LIST_SELECT = raw_data_idx-1 XMANAGER, 'ql_gfield', field_base END ;############################################################################## ;#Function name : ql_fill_sd_rrd_hd # ;# # ;#Author : Emmanuel PETIT # ;#Language : IDL # ;#Purpose : Fill RRD header (single fits case) # ;############################################################################## PRO ql_fill_sd_rrd_hd, rrd_hd, fits_hd , mode ;============================================================================ ; Common Block in use ;============================================================================ COMMON lff_com COMMON lff2_com COMMON curr_data_i_com COMMON curr_data_p_com COMMON const_com COMMON const2_com COMMON scient_com COMMON target_com COMMON instr_id_com COMMON instr_evt_com COMMON meth_com COMMON load_flg_com COMMON color_com ;============================================================================ ; Initialization ;============================================================================ err = 0 ;============================================================================ ; Processing ;============================================================================ WIDGET_CONTROL, /HOURGLASS ; instrument (INSTRUME) ; --------------------- tmp = FXPAR (fits_hd, 'INSTRUME', COUNT=cnt) IF (cnt EQ 1) THEN instrument = STRTRIM(tmp,2) $ ELSE instrument = '???' ; Observation date (DATE_OBS) ; --------------------------- tmp = FXPAR(fits_hd,'DATE_OBS',COUNT=cnt) IF (cnt EQ 1) THEN BEGIN date_obs_val = tmp rrd_hd.SSEXPTYR = BYTE (FIX(STRMID(date_obs_val,2 ,2))) rrd_hd.SSEXPTMO = BYTE (FIX(STRMID(date_obs_val,5 ,2))) rrd_hd.SSEXPTDY = BYTE (FIX(STRMID(date_obs_val,8 ,2))) rrd_hd.SSEXPTHR = BYTE (FIX(STRMID(date_obs_val,11,2))) rrd_hd.SSEXPTMN = BYTE (FIX(STRMID(date_obs_val,14,2))) rrd_hd.SSEXPTSC = BYTE (FIX(STRMID(date_obs_val,17,2))) rrd_hd.SSEXPTCS = BYTE (FIX(STRMID(date_obs_val,20,3))) ENDIF ELSE BEGIN print, '*** DATE_OBS not founded !! ***' tmp = bin_date (systime()) rrd_hd.SSEXPTYR = BYTE (FIX(STRMID(STRTRIM(STRING(tmp(0)),2),2,2))) rrd_hd.SSEXPTMO = BYTE (FIX(tmp(1))) rrd_hd.SSEXPTDY = BYTE (FIX(tmp(2))) rrd_hd.SSEXPTHR = BYTE (FIX(tmp(3))) rrd_hd.SSEXPTMN = BYTE (FIX(tmp(4))) rrd_hd.SSEXPTSC = BYTE (FIX(tmp(5))) rrd_hd.SSEXPTCS = BYTE (0) ENDELSE ; Exposure time (EXPTIME) ; ----------------------- tmp = FXPAR(fits_hd,'EXPTIME',COUNT=cnt) IF (cnt EQ 1) THEN rrd_hd.SSEXPTIM = FLOAT(tmp) $ ELSE rrd_hd.SSEXPTIM = 1.0 ; Ref pixel (DET_X / CRPIX1) ; -------------------------- tmp = FXPAR(fits_hd,'DET_X',COUNT=cnt) IF (cnt EQ 1) THEN BEGIN rrd_hd.SSREFPIX = FIX(tmp)-1 ENDIF ELSE BEGIN tmp = FXPAR(fits_hd,'CRPIX1',COUNT=cnt) IF (cnt EQ 1) THEN BEGIN rrd_hd.SSREFPIX = FIX(tmp)-1 ENDIF ELSE BEGIN rrd_hd.SSREFPIX = 0 ENDELSE ENDELSE ; Ref wavelength (WAVELNTH) ; ------------------------- tmp = FXPAR(fits_hd,'WAVELNTH',COUNT=cnt) IF (cnt EQ 1) THEN rrd_hd.SSWAVEL = FLOAT(tmp) $ ELSE rrd_hd.SSWAVEL = 0.0 ; Binning factors (BINX, BINY) ; ---------------------------- binny = FIX(FXPAR(fits_hd, 'BINX', COUNT=cnt1)) binnz = FIX(FXPAR(fits_hd, 'BINY', COUNT=cnt2)) IF (cnt1 EQ 1) THEN rrd_hd.SSBINNY = binny $ ELSE rrd_hd.SSBINNY = 1 IF (cnt2 EQ 1) THEN rrd_hd.SSBINNZ = binnz $ ELSE rrd_hd.SSBINNZ = 1 ; Solar rotation compensation (ROTCMP) ; ----------------------------------- tmp = FXPAR(fits_hd,'ROTCMP',COUNT=cnt) IF (cnt EQ 1) THEN rrd_hd.SSROTCMP = FLOAT(tmp) $ ELSE rrd_hd.SSROTCMP = -1.0 ; Raster steps (RASSTP/NX) ; ----------------------- tmp = FXPAR(fits_hd,'RASSTP',COUNT=cnt) IF (cnt EQ 1) THEN BEGIN rrd_hd.SSRASSTP = FIX (tmp) ENDIF ELSE BEGIN tmp = FXPAR(fits_hd,'NX',COUNT=cnt) IF (cnt EQ 1) THEN BEGIN rrd_hd.SSRASSTP = FIX (tmp) ENDIF ELSE BEGIN rrd_hd.SSRASSTP = 1 ENDELSE ENDELSE ; Raster size (RASSIZ/XSTEP) ; -------------------------- tmp = FXPAR(fits_hd,'RASSIZ',COUNT=cnt) IF (cnt EQ 1) THEN BEGIN rrd_hd.SSRASSIZ = BYTE(FIX(tmp)) ENDIF ELSE BEGIN tmp = FXPAR(fits_hd,'XSTEP',COUNT=cnt) IF (cnt EQ 1) THEN BEGIN rrd_hd.SSRASSIZ = BYTE(FIX(tmp)) ENDIF ELSE BEGIN rrd_hd.SSRASSIZ = 0 ENDELSE ENDELSE ; Brightest pixel coordinates (DETBPX,DETBPY) ; ------------------------------------------- tmp1 = FXPAR(fits_hd, 'DETBPX', COUNT=cnt1) tmp2 = FXPAR(fits_hd, 'DETBPY', COUNT=cnt2) IF (cnt1 EQ 1) THEN rrd_hd.SSBPADDY = 1024-FIX(tmp1) $ ELSE rrd_hd.SSBPADDY = 0 IF (cnt2 EQ 1) THEN rrd_hd.SSBPADDZ = FIX (tmp2) $ ELSE rrd_hd.SSBPADDZ = 0 ; Brightest pixel value (DETBPVAL) ; --------------------------------- tmp = FXPAR(fits_hd, 'DETBPVAL', COUNT=cnt) IF (cnt EQ 1) THEN rrd_hd.SSBPCNTS = LONG (tmp) $ ELSE rrd_hd.SSBPCNTS = 0L ; Total counts on detector (DETCNTS) ; ---------------------------------- tmp = FXPAR(fits_hd, 'DETCNTS', COUNT=cnt) IF (cnt EQ 1) THEN rrd_hd.SSIMGTOT = LONG (tmp) $ ELSE rrd_hd.SSIMGTOT = 0L ; locate (LOCATE) ;---------------- tmp = FXPAR(fits_hd, 'PGTYPE', COUNT=cnt) IF (cnt EQ 1) THEN rrd_hd.SSPGTYPE = FIX (tmp) $ ELSE rrd_hd.SSPGTYPE = 0 ; GPOP/UDP id (POPUDP) ; --------------------- tmp = FXPAR(fits_hd, 'POPUDP', COUNT=cnt) IF (cnt EQ 1) THEN rrd_hd.SSPOPUDP = FIX (tmp) $ ELSE rrd_hd.SSPOPUDP = 0 ; IPOP/UDP ID (PROG_ID) ; --------------------- tmp = FXPAR(fits_hd, 'PROG_ID', COUNT=cnt) IF (tmp EQ 1) THEN rrd_hd.SSADMCNT = FIX (tmp) $ ELSE rrd_hd.SSADMCNT = 0 ; Operation counter (OPCNT) ; ------------------------- tmp = FXPAR(fits_hd, 'OPCNT', COUNT=cnt) IF (cnt EQ 1) THEN rrd_hd.SSOPCNT = FIX (tmp) $ ELSE rrd_hd.SSOPCNT = 0 ; Image counter (IMGCNT) ; ---------------------- tmp = FXPAR(fits_hd, 'IMGCNT', COUNT=cnt) rrd_hd.SSIMGCNT = FIX (tmp) ; Compression status (CMPSTAT) ; ---------------------------- tmp = FXPAR(fits_hd, 'CMPSTAT', COUNT=cnt) IF (cnt EQ 1) THEN rrd_hd.CMPSTAT = BYTE(FIX(tmp)) $ ELSE rrd_hd.CMPSTAT = BYTE(1) ; Compression parameters (COMPAR1, COMPAR2, COMPAR3) ; --------------------------------------------------- tmp1 = FXPAR(fits_hd, 'COMPAR1', COUNT=cnt1) tmp2 = FXPAR(fits_hd, 'COMPAR2', COUNT=cnt2) tmp3 = FXPAR(fits_hd, 'COMPAR3', COUNT=cnt3) IF (cnt1 EQ 1) THEN rrd_hd.SSCOMPP1 = LONG (tmp1) $ ELSE rrd_hd.SSCOMPP1 = 0L IF (cnt2 EQ 1) THEN rrd_hd.SSCOMPP2 = LONG (tmp2) $ ELSE rrd_hd.SSCOMPP2 = 0L IF (cnt3 EQ 1) THEN rrd_hd.SSCOMPP3 = LONG (tmp3) $ ELSE rrd_hd.SSCOMPP3 = 0L ; Status (STAT) ; ------------ tmp = FXPAR(fits_hd, 'STAT', COUNT=cnt) IF (cnt EQ 1) THEN rrd_hd.SSSTAT = BYTE(tmp) $ ELSE rrd_hd.SSSTAT = BYTE(0) ; Detector Status (DETSTA) ; ------------------------ tmp = FXPAR(fits_hd, 'DETSTA', COUNT=cnt) IF (cnt EQ 1) THEN rrd_hd.SSDETSTA = FIX (tmp) $ ELSE rrd_hd.SSDETSTA = BYTE(0) ; Data coordiates (INS_X, INS_Y) / (INS_X0, INS_Y0) ; ------------------------------------------------ tmp = FXPAR(fits_hd, 'INS_X', COUNT=cnt) IF (cnt EQ 1) THEN BEGIN rrd_hd.SSSUNY = FIX(FLOAT(tmp)*16.) ENDIF ELSE BEGIN tmp = FXPAR(fits_hd, 'INS_X0', COUNT=cnt) IF (cnt EQ 1) THEN BEGIN rrd_hd.SSSUNY = FIX(FLOAT(tmp)*16.) ENDIF ELSE BEGIN rrd_hd.SSSUNY = 0 ENDELSE ENDELSE tmp = FXPAR(fits_hd, 'INS_Y', COUNT=cnt) IF (cnt EQ 1) THEN BEGIN rrd_hd.SSSUNZ = FIX(-FLOAT(tmp)*16.) ENDIF ELSE BEGIN tmp = FXPAR(fits_hd, 'INS_Y0', COUNT=cnt) IF (cnt EQ 1) THEN BEGIN rrd_hd.SSSUNZ = FIX(-FLOAT(tmp)*16.) ENDIF ELSE BEGIN rrd_hd.SSSUNY = 0 ENDELSE ENDELSE ; II event coordiates (ININVALX,ININVALY) ; --------------------------------------- tmp1 = FXPAR(fits_hd, 'ININVALX', COUNT=cnt1) tmp2 = FXPAR(fits_hd, 'ININVALY', COUNT=cnt2) IF (tmp1 EQ 1) THEN rrd_hd.SSIIDY = FIX(tmp1) $ ELSE rrd_hd.SSIIDY = 0 IF (tmp2 EQ 1) THEN rrd_hd.SSIIDZ = FIX(-tmp2) $ ELSE rrd_hd.SSIIDZ = 0 ; Scientist (SCIENTIS) ; -------------------- tmp = FXPAR(fits_hd, 'SCIENTIS', COUNT=cnt) IF (cnt EQ 1) THEN BEGIN str = STRTRIM(tmp,2) tmp1 = STRMID (str,STRPOS(str,'<')+1, STRPOS(str,'>')-1 ) IF (tmp1 NE '') THEN rrd_hd.SSSCIENT=FIX(tmp1) $ ELSE rrd_hd.SSSCIENT=FIX(tmp) ENDIF ELSE BEGIN rrd_hd.SSSCIENT=-1 ENDELSE ; target ; ------ tmp = FXPAR(fits_hd, 'OBJECT', COUNT=cnt) IF (cnt EQ 1) THEN BEGIN str = STRTRIM(tmp,2) tmp1 = STRMID (str,STRPOS(str,'<')+1, STRPOS(str,'>')-1 ) IF (tmp1 NE '') THEN rrd_hd.SSTARGET=FIX(tmp1) $ ELSE rrd_hd.SSTARGET=FIX(tmp) ENDIF ELSE BEGIN rrd_hd.SSTARGET=-1 ENDELSE ; Datatype (DATA_TYP) ; ------------------- tmp = FXPAR(fits_hd, 'DATA_TYP',COUNT=cnt) IF (cnt EQ 1) THEN BEGIN str = STRTRIM(tmp,2) tmp1 = STRMID (str,STRPOS(str,'<')+1, STRPOS(str,'>')-1 ) IF (tmp1 NE '') THEN rrd_hd.DATATYPE=BYTE(FIX(tmp1)) $ ELSE rrd_hd.DATATYPE=BYTE(FIX(tmp)) ENDIF ELSE BEGIN ; Keyword data_typ not founded: compute it with (ctype1, ctype2) ; -------------------------------------------------------------- ctype1= STRTRIM(FXPAR(fits_hd, 'CTYPE1',COUNT=cnt1),2) ctype2= STRTRIM(FXPAR(fits_hd, 'CTYPE2',COUNT=cnt2),2) IF (cnt1 EQ 1) AND (cnt2 EQ 1) THEN BEGIN naxis1=FXPAR(fits_hd, 'NAXIS1') IF (naxis1 EQ 1) THEN BEGIN CASE 1 OF (ctype1 EQ 'WAVELNTH'): rrd_hd.DATATYPE=BYTE(8) (ctype1 EQ 'SOLAR_X') : rrd_hd.DATATYPE=BYTE(29) (ctype1 EQ 'SOLAR_Y') : rrd_hd.DATATYPE=BYTE(9) (ctype1 EQ 'TEMPORAL'): rrd_hd.DATATYPE=BYTE(10) ELSE : rrd_hd.DATATYPE=BYTE(11) ENDCASE ENDIF ELSE BEGIN CASE 1 OF (ctype1 EQ 'WAVELNTH') AND (ctype2 EQ 'SOLAR_X') : rrd_hd.DATATYPE=BYTE(21) (ctype1 EQ 'WAVELNTH') AND (ctype2 EQ 'SOLAR_Y') : rrd_hd.DATATYPE=BYTE(1) (ctype1 EQ 'WAVELNTH') AND (ctype2 EQ 'TEMPORAL'): rrd_hd.DATATYPE=BYTE(3) (ctype1 EQ 'SOLAR_X') AND (ctype2 EQ 'WAVELNTH') : rrd_hd.DATATYPE=BYTE(25) (ctype1 EQ 'SOLAR_X') AND (ctype2 EQ 'SOLAR_Y') : rrd_hd.DATATYPE=BYTE(2) (ctype1 EQ 'SOLAR_X') AND (ctype2 EQ 'TEMPORAL') : rrd_hd.DATATYPE=BYTE(24) (ctype1 EQ 'SOLAR_Y') AND (ctype2 EQ 'WAVELNTH') : rrd_hd.DATATYPE=BYTE(5) (ctype1 EQ 'SOLAR_Y') AND (ctype2 EQ 'SOLAR_X') : rrd_hd.DATATYPE=BYTE(22) (ctype1 EQ 'SOLAR_Y') AND (ctype2 EQ 'TEMPORAL') : rrd_hd.DATATYPE=BYTE(4) (ctype1 EQ 'TEMPORAL') AND (ctype2 EQ 'WAVELNTH'): rrd_hd.DATATYPE=BYTE(6) (ctype1 EQ 'TEMPORAL') AND (ctype2 EQ 'SOLAR_X') : rrd_hd.DATATYPE=BYTE(27) (ctype1 EQ 'TEMPORAL') AND (ctype2 EQ 'SOLAR_Y') : rrd_hd.DATATYPE=BYTE(7) ELSE : rrd_hd.DATATYPE=BYTE(2) ENDCASE ENDELSE ENDIF ELSE BEGIN rrd_hd.DATATYPE=BYTE(2) ENDELSE ENDELSE ; II master ID (ININM_ID) ; ----------------------- tmp = FXPAR(fits_hd, 'ININM_ID', COUNT=cnt) IF (cnt EQ 1) THEN BEGIN str = STRTRIM(tmp,2) tmp1 = STRMID (str,STRPOS(str,'<')+1, STRPOS(str,'>')-1 ) IF (tmp1 NE '') THEN rrd_hd.SSIIMIDY = FIX(tmp1) $ ELSE rrd_hd.SSIIMIDY = FIX(tmp) ENDIF ELSE BEGIN rrd_hd.SSIIMIDY = -1 ENDELSE ; II solar event (ININSE) ; ----------------------- tmp = FXPAR(fits_hd, 'ININSE', COUNT=cnt) IF (cnt EQ 1) THEN BEGIN str = STRTRIM(tmp,2) tmp1 = STRMID (str,STRPOS(str,'<')+1, STRPOS(str,'>')-1 ) IF (tmp1 NE '') THEN rrd_hd.SSIISEZ = FIX(tmp1) $ ELSE rrd_hd.SSIISEZ = FIX(tmp) ENDIF ELSE BEGIN rrd_hd.SSIISEZ = -1 ENDELSE ; Compression scheme (COMPRESS) ; ----------------------------- tmp = FXPAR(fits_hd, 'COMPRESS', COUNT=cnt) IF (cnt EQ 1) THEN BEGIN str = STRTRIM(tmp,2) tmp1= STRMID (str,STRPOS(str,'<')+1, STRPOS(str,'>')-1 ) IF (tmp1 NE '') THEN rrd_hd.SSCOMPRM = FIX(tmp1) $ ELSE rrd_hd.SSCOMPRM = FIX(tmp) ENDIF ELSE BEGIN rrd_hd.SSCOMPRM = 0 ENDELSE ; Slit (SLIT) ; ----------- tmp = FXPAR(fits_hd, 'SLIT', COUNT=cnt) IF (cnt EQ 1) THEN BEGIN str = STRTRIM(FXPAR(fits_hd, 'SLIT'),2) tmp1 = STRMID (str,STRPOS(str,'<')+1, STRPOS(str,'>')-1 ) IF (tmp1 NE '') THEN rrd_hd.SSSLITNB = FIX(tmp1) $ ELSE rrd_hd.SSSLITNB = FIX(tmp) ENDIF ELSE BEGIN rrd_hd.SSSLITNB = 0 ENDELSE ; Total counts in Image ; --------------------- IF (mode EQ IMAGE) THEN rrd_hd.SSIMGTOT = LONG(TOTAL(curr_data_i)) ; Data format ; ----------- IF mode EQ IMAGE THEN ds = size (curr_data_i) $ ELSE ds = size (curr_data_p) IF (ds(3) EQ 5) THEN BEGIN IF mode EQ IMAGE THEN curr_data_i = FLOAT (curr_data_i) $ ELSE curr_data_p = FLOAT (curr_data_p) ds(3) = 4 ENDIF rrd_hd.DATAFMT = ds(3) ;Init/Load display control structure ;----------------------------------- IF (mode EQ IMAGE) THEN BEGIN curr_header_i = rrd_hd ql_init_dctrl, mode ; Init display control structure dctrl = curr_dctrl_i ql_init_banner,curr_data_i, mode , err ; init image banner ENDIF ELSE BEGIN curr_header_p = rrd_hd ql_init_dctrl, mode ; Init display control structure dctrl = curr_dctrl_p ql_init_banner,curr_data_p, mode , err ; init profile banner ENDELSE sumer_flg = FXPAR(fits_hd, 'SUMQLFLG') IF (sumer_flg EQ 1) THEN BEGIN ql_get_ql_dctrl, fits_hd, dctrl, mode, err ; Restore SUMER QL env data ENDIF ELSE BEGIN dctrl.TITLE = STRING(FXPAR (fits_hd, 'FILENAME'), FORMAT=Title_Format) ENDELSE IF (mode EQ IMAGE) THEN BEGIN curr_header_i = rrd_hd curr_dctrl_i = dctrl load_flag_i = 1 ENDIF ELSE BEGIN curr_header_p = rrd_hd curr_dctrl_p = dctrl load_flag_p = 1 ENDELSE END ;############################################################################## ;#Function name : ql_get_single_data # ;#Author : Emmanuel PETIT # ;############################################################################## PRO ql_get_single_data, fits_header ;============================================================================ ; Common Block in use ;============================================================================ COMMON lff_com COMMON lff2_com COMMON const_com COMMON const2_com COMMON curr_data_i_com COMMON curr_data_p_com COMMON color_com ;============================================================================ ; Initialization ;============================================================================ ;============================================================================ ; Processing ;============================================================================ WIDGET_CONTROL, /HOURGLASS data = READFITS (thefile, hd) naxis1_val = FXPAR (fits_header, 'NAXIS1', COUNT=cnt) IF (naxis1_val EQ 1) THEN mode = PROFILE $ ELSE mode = IMAGE ; Check that data is not too big ; ------------------------------ naxis2_val = FXPAR (fits_header, 'NAXIS2') IF (naxis1_val GT 1024 OR naxis2_val GT 512) THEN BEGIN print, 'Image too big for ql_sumer.' valid_flag=0 RETURN ENDIF print, 'ici' IF (mode EQ IMAGE) THEN BEGIN print, 'image' rrd_header = curr_header_i curr_data_i = data ENDIF ELSE BEGIN print, 'prf' rrd_header = curr_header_p curr_data_p = data ENDELSE ql_init_rrd_hd, rrd_header ql_fill_sd_rrd_hd, rrd_header, fits_header, mode valid_flag=1 IF (mode EQ IMAGE) THEN BEGIN curr_header_i = rrd_header ret = ql_display_data(curr_data_i, 0, curr_dctrl_i, err) ENDIF ELSE BEGIN curr_header_p = rrd_header ; ------------- ; Init curr_x_p ; ------------- s=SIZE (data) sz_x = s(2) curr_x_p = FINDGEN (sz_x) curr_x_p = $ curr_dctrl_p.x.min+curr_x_p*(curr_dctrl_p.x.max-curr_dctrl_p.x.min)/(sz_x-1) ret = ql_display_data(curr_data_p, 100, curr_dctrl_p, err) ENDELSE END ;############################################################################## ;#Function name : ql_dis_fhd_event # ;#LEVEL : # ;# # ;#Author : Emmanuel PETIT # ;#Language : IDL # ;#Purpose : manage read of fits file header # ;#Creation date : 03-05-94 # ;#External modules : # ;# # ;#Call sequence : # ;# # ;#Arguments : # ;# # ;#Description : # ;# # ;# # ;############################################################################## PRO ql_dis_fhd_event, ev ;============================================================================ ; Common Block in use ;============================================================================ COMMON lff_com COMMON lff2_com COMMON color_com ;============================================================================ ; Initialization ;============================================================================ next_hd_flg = 0 prev_hd_flg = 0 data_flg = 0 selected_field = 0 ;============================================================================ ; Processing ;============================================================================ WIDGET_CONTROL, ev.id, GET_UVALUE=value CASE ev.id OF header_txt: BEGIN END header_done : BEGIN WIDGET_CONTROL, ev.top, /DESTROY ph_disp_flg = 0 extend_index = 0 END next_header: BEGIN extend_index = extend_index + 1 header = HEADFITS (thefile, EXTEN=extend_index) WIDGET_CONTROL, header_txt, SET_VALUE=header extend_val = FXPAR (header, 'EXTEND') xtension_val = FXPAR (header, 'XTENSION') naxis2_val = FXPAR (header, 'NAXIS2') tfields_val = FXPAR (header, 'TFIELDS') IF (extend_index GT 0) THEN prev_hd_flg = 1 IF (extend_val EQ 1) THEN next_hd_flg = 1 IF (xtension_val EQ 'BINTABLE') AND $ (naxis2_val EQ 1) AND $ ; NAXIS2 = 1 (tfields_val GE 1) $ ; TFIELDS >= 1 THEN BEGIN data_flg = 1 WIDGET_CONTROL, data_header, /INPUT_FOCUS ENDIF WIDGET_CONTROL, next_header, SENSITIVE=next_hd_flg WIDGET_CONTROL, prev_header, SENSITIVE=prev_hd_flg WIDGET_CONTROL, data_header, SENSITIVE=data_flg END prev_header: BEGIN extend_index = extend_index - 1 header = HEADFITS (thefile, EXTEN=extend_index) WIDGET_CONTROL, header_txt, SET_VALUE=header extend_val = FXPAR (header, 'EXTEND') naxis_val = FXPAR (header, 'NAXIS') IF (extend_index GT 0) THEN prev_hd_flg = 1 IF (extend_val EQ 1) THEN next_hd_flg = 1 IF (naxis_val GT 0) THEN data_flg = 1 WIDGET_CONTROL, next_header, SENSITIVE=next_hd_flg WIDGET_CONTROL, prev_header, SENSITIVE=prev_hd_flg WIDGET_CONTROL, data_header, SENSITIVE=data_flg END data_header : BEGIN ; Field selection ; --------------- header = HEADFITS (thefile, EXTEN=extend_index) x_tension_val = FXPAR (header, 'XTENSION', COUNT=cnt) IF (cnt EQ 0) THEN ql_get_single_data, header $ ; load data from single fits file ELSE ql_get_fits_field , header ; Set selected field from binary table IF (valid_flag EQ 1) THEN BEGIN WIDGET_CONTROL, ev.top, /DESTROY WIDGET_CONTROL, lff_base, /DESTROY ENDIF END ENDCASE END ;############################################################################## ;#Function name : ql_dis_fhd # ;#LEVEL : # ;# # ;#Author : Emmanuel PETIT # ;#Language : IDL # ;#Purpose : display headers of fits file # ;#Creation date : 03-05-94 # ;#External modules : # ;# # ;#Call sequence : # ;# # ;#Arguments :fid: Fits File id # ;# # ;#Description : # ;# # ;# # ;############################################################################## PRO ql_display_fhd, ext_no ;============================================================================ ; Common Block in use ;============================================================================ COMMON lff_com COMMON lff2_com COMMON const_com COMMON const2_com COMMON color_com ;============================================================================ ; Initialization ;============================================================================ x_offset = 500 y_offset = 0 Title = 'FITS HEADER' next_hd_flg = 0 prev_hd_flg = 0 data_flg = 0 ;============================================================================ ; Processing ;============================================================================ WIDGET_CONTROL, /HOURGLASS header = HEADFITS (thefile, EXTEN=ext_no) IF (ph_disp_flg EQ 0) THEN BEGIN header_base = WIDGET_BASE (TITLE=Title,XOFFSET=x_offset,YOFFSET=y_offset, $ /COLUMN,/MODAL) header_txt = WIDGET_TEXT(header_base,VALUE=header,FONT=Courier_Font,/SCROLL,XSIZE=80,YSIZE=52) dummy = WIDGET_BASE (header_base, /ROW) header_done = WIDGET_BUTTON(dummy, VALUE = 'QUIT') next_header = WIDGET_BUTTON(dummy, VALUE = 'NEXT') prev_header = WIDGET_BUTTON(dummy, VALUE = 'PREVIOUS') data_header = WIDGET_BUTTON(dummy, VALUE = 'DATA') ph_disp_flg = 1 ENDIF ELSE BEGIN WIDGET_CONTROL, header_txt, SET_VALUE =header ENDELSE IF (ext_no EQ 0) THEN BEGIN tmp = FXPAR(header, 'DATE_OBS', COUNT=cnt) IF (cnt EQ 1) THEN obt_base = UTC2TAI(tmp) $ ELSE obt_base = DOUBLE (0) ENDIF extend_val = FXPAR (header, 'EXTEND') naxis_val = FXPAR (header, 'NAXIS') IF (extend_index GT 0) THEN prev_hd_flg = 1 IF (extend_val EQ 1) THEN next_hd_flg = 1 IF (naxis_val GT 0) THEN data_flg = 1 WIDGET_CONTROL, next_header, SENSITIVE=next_hd_flg WIDGET_CONTROL, prev_header, SENSITIVE=prev_hd_flg WIDGET_CONTROL, data_header, SENSITIVE=data_flg WIDGET_CONTROL, header_base, /REALIZE XMANAGER, 'ql_dis_fhd', header_base END ;------------------------------------------------------------------------------ ; valid_dir ;------------------------------------------------------------------------------ FUNCTION valid_dir, dir WIDGET_CONTROL, /HOURGLASS IF (!version.os EQ 'vms') THEN BEGIN CD, current = fits_path tmp = dir + "*.*" context = 0L resultant = STRING(BYTARR(256)+32B) ret = CALL_EXTERNAL("LIBRTL", "LIB$FIND_FILE", tmp, resultant, context) RETURN, (ret EQ 65537) ENDIF ELSE BEGIN SPAWN, ['/bin/sh -c "test -d ' + dir +'" && echo 1'], result RETURN, KEYWORD_SET (result) ENDELSE END ;------------------------------------------------------------------------------ ; getdirs ;------------------------------------------------------------------------------ FUNCTION getdirs WIDGET_CONTROL, /HOURGLASS IF (!version.os EQ 'vms') THEN BEGIN WIDGET_CONTROL, /HOURGLASS retval = ['[-]'] results = findfile("*.DIR") ;directories have an IF(KEYWORD_SET(results)) THEN BEGIN ;extension of ".dir" endpath = STRPOS(results(0), "]", 0) + 1 results = strmid(results, endpath, 100) dirs = WHERE(STRPOS(results, ".DIR", 0) NE -1, found) IF (found GT 0) THEN BEGIN results = results(dirs) retval = [retval, results] ENDIF ENDIF RETURN, retval ENDIF ELSE BEGIN retval = ['../'] SPAWN, "ls -lL", results numfound = N_ELEMENTS (results) IF (KEYWORD_SET(results)) THEN BEGIN firsts = STRUPCASE(STRMID(results, 0, 1)) dirs = (WHERE(firsts EQ "D", found)) IF (found GT 0) THEN BEGIN results = results(dirs) spaceinds = WHERE(BYTE(results(0)) EQ 32) spaceindex = spaceinds(N_ELEMENTS(spaceinds)-1) retval = [retval, STRMID(results, spaceindex+1, 100)] ENDIF ENDIF RETURN, retval ENDELSE END ;------------------------------------------------------------------------------ ; getfiles ;------------------------------------------------------------------------------ FUNCTION getfiles, filter WIDGET_CONTROL, /HOURGLASS IF (!version.os EQ 'vms') THEN BEGIN results = findfile(filter) IF (KEYWORD_SET(results)) THEN BEGIN endpath = STRPOS(results(0), "]", 0) + 1 results = strmid(results, endpath, 100) dirs = WHERE(STRPOS(results, ".DIR", 0) EQ -1, found) IF (found GT 0) THEN BEGIN results = results(dirs) return, results ENDIF ENDIF RETURN, "" ENDIF ELSE BEGIN SPAWN, ["/bin/sh", "-c", "ls -lL " + filter + $ " 2> /dev/null"], results, /NOSHELL IF(KEYWORD_SET(results)) THEN BEGIN firsts = STRUPCASE(STRMID(results, 0, 1)) fileinds = (WHERE(((firsts EQ "F") OR (firsts EQ "-") OR $ (firsts EQ "l")), found)) IF (found GT 0) THEN BEGIN results = results(fileinds) FOR i = 0, N_ELEMENTS(results) - 1 DO BEGIN spaceinds = WHERE(BYTE(results(i)) EQ 32) spaceindex = spaceinds(N_ELEMENTS(spaceinds) - 1) results(i) = STRMID(results(i), spaceindex + 1, 100) ENDFOR RETURN, results ENDIF ENDIF RETURN, "" ENDELSE END ;############################################################################## ;#Function name : ql_lff_event # ;#LEVEL : # ;# # ;#Author : Emmanuel PETIT # ;#Language : IDL # ;#Purpose : manage read of fits file # ;#Creation date : 28-02-94 # ;#External modules : # ;# # ;#Call sequence : # ;# # ;#Arguments : # ;# # ;#Description : # ;# # ;# # ;############################################################################## PRO ql_lff_event, ev ;============================================================================ ; Common Block in use ;============================================================================ COMMON lff_com COMMON lff2_com COMMON color_com ;============================================================================ ; Initialization ;============================================================================ ;============================================================================ ; Processing ;============================================================================ WIDGET_CONTROL, filttxt, GET_VALUE = fits_filt fits_filt = fits_filt(0) CASE ev.id OF filttxt : BEGIN WIDGET_CONTROL, ev.id, GET_VALUE=tmp fits_filt = tmp(0) files = getfiles(fits_filt) WIDGET_CONTROL, filelist, SET_VALUE=files, SET_UVALUE=files END pathtxt : BEGIN WIDGET_CONTROL, pathtxt, GET_VALUE = tmp newpath = tmp(0) IF (valid_dir(newpath)) THEN BEGIN fits_path = newpath CD, fits_path directories = getdirs() files = getfiles(fits_filt) WIDGET_CONTROL, filelist, SET_VALUE=files, SET_UVALUE=files WIDGET_CONTROL, dirlist, SET_VALUE=directories, SET_UVALUE=directories ENDIF ELSE BEGIN WIDGET_CONTROL, pathtxt, SET_VALUE = fits_path ENDELSE END dirlist : BEGIN WIDGET_CONTROL, dirlist, GET_UVALUE = directories IF (!version.os EQ 'vms') THEN BEGIN IF (ev.index GT N_ELEMENTS(directories) - 1) THEN RETURN found = STRPOS(directories(ev.index), ".") IF (found NE -1) THEN BEGIN CD, STRMID(directories(ev.index), 0, found) ENDIF ELSE BEGIN found_deb = STRPOS(fits_path,"[") found_end = STRPOS(fits_path,"]") len =found_end-found_deb-1 tmp = STRMID (fits_path,found_deb+1, len) IF (tmp NE '000000') OR (STRLEN(tmp) NE 6) THEN CD,directories(ev.index) ENDELSE ENDIF ELSE BEGIN IF (ev.index GT N_ELEMENTS(directories) - 1) THEN RETURN CD, directories(ev.index) ENDELSE CD, CURRENT = fits_path WIDGET_CONTROL, pathtxt, SET_VALUE = fits_path directories = getdirs() files = getfiles(fits_filt) WIDGET_CONTROL, filelist, SET_VALUE=files, SET_UVALUE=files WIDGET_CONTROL, dirlist , SET_VALUE=directories, SET_UVALUE=directories WIDGET_CONTROL, selecttxt, SET_VALUE = '' WIDGET_CONTROl, view_hd_base , MAP = 0 END filelist : BEGIN fits_idx = ev.index WIDGET_CONTROL, filelist, GET_UVALUE = files IF (!VERSION.OS EQ 'vms') THEN thefile = fits_path+files(fits_idx) $ ELSE thefile = fits_path + '/'+ files(fits_idx) WIDGET_CONTROL, selecttxt, SET_VALUE = thefile WIDGET_CONTROl, view_hd_base , MAP = 1 IF (ph_disp_flg EQ 1) THEN BEGIN WIDGET_CONTROL, selecttxt, GET_VALUE = temp thefile = temp(0) extend_index = 0 ql_display_fhd, extend_index ENDIF END primary_hd: BEGIN WIDGET_CONTROL, selecttxt, GET_VALUE = temp thefile = temp(0) ql_display_fhd, extend_index IF (valid_flag EQ 1) THEN WIDGET_CONTROL, ev.top, /DESTROY END selecttxt: BEGIN WIDGET_CONTROL, selecttxt, GET_VALUE = temp thefile = temp(0) IF ( STRTRIM(temp(0),2) EQ '') THEN BEGIN WIDGET_CONTROl, view_hd_base , MAP = 0 WIDGET_CONTROL,primary_hd, /INPUT_FOCUS ENDIF END cancel : BEGIN thefile = '' WIDGET_CONTROL, ev.top, /DESTROY IF (ph_disp_flg EQ 1) THEN WIDGET_CONTROL,header_base , /DESTROY END ENDCASE END ;*** ;############################################################################## ;#Function name : ql_lff_trt # ;#LEVEL : 1 # ;# # ;#Author : Emmanuel PETIT # ;#Language : IDL # ;#Purpose : manage load of fits files # ;#Creation date : May 94 # ;#External modules : # ;# # ;#Call sequence : Called by Event Handler # ;# # ;#Arguments : # ;# # ;#Description : # ;# # ;# # ;############################################################################## ;*** PRO ql_lff_trt, ev ;============================================================================ ; Common Block in use ;============================================================================ COMMON const_com COMMON const2_com COMMON lff_com COMMON lff2_com COMMON color_com ;============================================================================ ; Initialization ;============================================================================ Title = 'Read FITS File' thefile = '' Hd_Title = Title extend_index = 0 ; extension number valid_flag = 0 x_offset = 0 y_offset = 0 ph_disp_flg = 0 IF (first_ff_flg EQ 0 ) THEN BEGIN fits_filt = 'SUM*.FITS' fits_path = getenv('RRDFITS') fits_idx = 0 first_ff_flg = 1 ENDIF ;============================================================================ ; Processing ;============================================================================ WIDGET_CONTROL, /HOURGLASS ; Save current directory ; build dir and file lists ; ------------------------ CD, CURRENT = dirsave CD, fits_path directories = getdirs() files = getfiles(fits_filt) lff_base = WIDGET_BASE(TITLE=TITLE, XOFFSET=x_offset, YOFFSET=y_offset, $ /COLUMN,/MODAL) widebase = WIDGET_BASE (lff_base, /ROW) label = WIDGET_LABEL (widebase, VALUE='Path:') pathtxt = WIDGET_TEXT (widebase, VAL=fits_path, /EDIT, XSIZE=40) filtbase = WIDGET_BASE (lff_base, /ROW) filtlbl = WIDGET_LABEL (filtbase, VALUE = 'Filter:') filttxt = WIDGET_TEXT (filtbase, VALUE = fits_filt, /EDIT, XSIZE=20) selections = WIDGET_BASE (lff_base, /ROW) dirs = WIDGET_BASE (selections, /COLUMN, /FRAME) lbl = WIDGET_LABEL (dirs, VALUE='Subdirectories'+STRING('',FORMAT='(A25)')) dirlist = WIDGET_LIST (dirs, VALUE=directories, YSIZE=20,UVALUE=directories) fls = WIDGET_BASE (selections, /COLUMN, /FRAME) lbl = WIDGET_LABEL (fls, VALUE = 'Files'+STRING('', FORMAT='(A50)')) filelist = WIDGET_LIST (fls, VALUE=files, YSIZE=20, UVALUE=files) widebase = WIDGET_BASE (lff_base, /COLUMN) label = WIDGET_LABEL (widebase, VALUE = 'Selection:') selecttxt = WIDGET_TEXT (widebase , VAL='', /EDIT, XSIZE=60) dummy = WIDGET_BASE (lff_base,/ROW) rowbase = WIDGET_BASE (dummy,/ROW) cancel = WIDGET_BUTTON(rowbase, VALUE='CANCEL') view_hd_base = WIDGET_BASE (dummy,/ROW, MAP=0) primary_hd = WIDGET_BUTTON(view_hd_base, VALUE='HEADER') WIDGET_CONTROL, lff_base, /REALIZE ; Point on default file IF (fits_idx GE N_ELEMENTS(files)) THEN fits_idx = 0 WIDGET_CONTROL, filelist, SET_LIST_SELECT=fits_idx IF (!VERSION.OS EQ 'vms') THEN thefile = fits_path+files(fits_idx) $ ELSE thefile = fits_path + '/'+ files(fits_idx) WIDGET_CONTROL, selecttxt, SET_VALUE = thefile WIDGET_CONTROl, view_hd_base , MAP = 1 XMANAGER, 'ql_lff', lff_base ; Back to saved directory ; ----------------------- CD, dirsave END