;--------------------------------------------------------------------------- ; Document name: SC_CRE_POP_TRT.PRO ; Last Modified: Wed Apr 23 13:08:07 1997 (LWANG@sumop1.nascom.nasa.gov) ;--------------------------------------------------------------------------- ; ;+ ; PROJECT: ; SOHO - SUMER ; ; NAME: ; SC_CRE_POP_TRT, event ; ; PURPOSE: ; UDP creation ; ; CATEGORY: ; SC_SUMER ; ; SYNTAX: ; sc_cre_pop_trt [, event] ; ; INPUTS: ; None. ; ; OPTIONAL INPUTS: ; EVENT - Event structure from SC_SUMER ; ; OUTPUTS: ; None. ; ; OPTIONAL OUTPUTS: ; None. ; ; KEYWORDS: ; None. ; ; COMMON: ; Too many to mention ; ; RESTRICTIONS: ; None. ; ; SIDE EFFECTS: ; None. ; ; HISTORY: ; Version 1, June 8, 1995, Emmanuel Petit, IAS. Written ; Version 2, May 13, 1996, Liyun Wang, NASA/GSFC ; Added filename confliction check ; Version 3, August 7, 1996, Liyun Wang, NASA/GSFC ; Started using the new technical simulator ; Version 4, August 26, 1996, Liyun Wang, NASA/GSFC ; Modified such that .OBJ and .SCL files are copied to the UDP ; directory only when POP/UDP is registered in the DB ; ; CONTACT: ; Liyun Wang, NASA/GSFC (Liyun.Wang.1@gsfc.nasa.gov) ;- ; PRO sc_cre_pop_event, ev ;--------------------------------------------------------------------------- ; Event handler ;--------------------------------------------------------------------------- COMMON scmain_com COMMON sccrepop_com COMMON sim_com COMMON screq_com @tki_common_share CASE ev.id OF ;--------------------------------------------------------------------------- ; file operations ;--------------------------------------------------------------------------- udp_f_new_bt : BEGIN WIDGET_CONTROL, /HOURGLASS previous_file = udp_file_name WIDGET_CONTROL, udp_stat_txt, SET_VALUE='' new_flag = 1 IF (udp_state EQ 2) THEN BEGIN msg = ['' , 'Buffer has been mofified', 'Changes will be lost', $ 'Continue anyway ?', ''] confirm_quit = sc_confirm_act(200, 200, msg) IF (confirm_quit EQ 0) THEN new_flag = 0 ENDIF IF (new_flag EQ 1) THEN BEGIN ;--------------------------------------------------------------------------- ; Create file, buffer ;--------------------------------------------------------------------------- new_sfile_name = '' new_file_name = SC_GET_FILE(PATH=udp_src_path , $ SHORTFNAME=new_sfile_name , $ XOFFSET=70 , $ YOFFSET=100 ) ret = STRPOS (udp_src_path, '[') IF (ret NE -1) THEN log_use_flg = 0 $ ELSE log_use_flg = 1 IF (new_file_name NE '' ) THEN BEGIN OPENW, unit, new_file_name, /GET_LUN, ERROR=err IF (err EQ 0) THEN BEGIN WRITEU, unit, '' FREE_LUN, unit udp_file_name = new_file_name udp_sfilename = new_sfile_name+'.SCL' udp_new_buffer = '' udp_old_buffer = udp_new_buffer WIDGET_CONTROL, udp_src_txt, SET_VALUE=udp_new_buffer WIDGET_CONTROL, udp_src_lbl, SET_VALUE='UDP Source File: '+ $ udp_file_name WIDGET_CONTROL, udp_src_txt, /EDITABLE udp_state = 2 ENDIF ELSE BEGIN sc_err_msg, 'Unable to create file '+ new_file_name ENDELSE ENDIF ELSE BEGIN err = 1 udp_file_name = previous_file ENDELSE ENDIF END udp_f_ope_bt : BEGIN WIDGET_CONTROL, /HOURGLASS previous_file = udp_file_name WIDGET_CONTROL, udp_stat_txt, SET_VALUE='' open_flag = 1 IF (udp_state EQ 2) THEN BEGIN msg = ['' , 'Buffer has been mofified', 'Changes will be lost', $ 'Continue anyway ?', ''] confirm_quit = sc_confirm_act(200, 200, msg) IF (confirm_quit EQ 0) THEN open_flag = 0 ENDIF IF (open_flag EQ 1) THEN BEGIN udp_file_name = sc_load_file(udp_old_buffer , $ shortfname=udp_sfilename , $ path=udp_src_path , $ filter=udp_src_filter , $ x_offset=200 , $ y_offset=200) ret = STRPOS(udp_src_path, '[') IF (ret NE -1) THEN $ log_use_flg = 0 $ ELSE $ log_use_flg = 1 pos = STRPOS (udp_file_name, ';') udp_file_name = STRMID (udp_file_name, 0, pos) IF (udp_file_name NE '') THEN BEGIN WIDGET_CONTROL, udp_src_txt, SET_VALUE=udp_old_buffer WIDGET_CONTROL, udp_src_lbl, SET_VALUE='UDP Source File: '+ $ udp_file_name udp_new_buffer = udp_old_buffer WIDGET_CONTROL, udp_src_txt, /EDITABLE udp_state = 1 ENDIF ELSE BEGIN udp_file_name = previous_file ENDELSE ENDIF END udp_f_sav_as_bt : BEGIN WIDGET_CONTROL, /HOURGLASS save_flag = 0 err = 0 WIDGET_CONTROL, udp_src_txt, GET_VALUE=udp_new_buffer IF (N_ELEMENTS (udp_new_buffer) NE $ N_ELEMENTS(udp_old_buffer)) THEN BEGIN save_flag = 1 ENDIF ELSE BEGIN idem = 1 curr_li = 0 WHILE (idem EQ 1) AND $ (curr_li LT N_ELEMENTS(udp_new_buffer)) DO BEGIN IF (udp_new_buffer(curr_li) NE $ udp_old_buffer(curr_li) ) THEN BEGIN idem = 0 save_flag = 1 ENDIF curr_li = curr_li+1 END ENDELSE IF (save_flag EQ 1) THEN BEGIN ;--------------------------------------------------------------------------- ; Write buffer in given file ;--------------------------------------------------------------------------- new_sfile_name = '' new_file_name = SC_GET_FILE(PATH=udp_src_path , $ SHORTFNAME=new_sfile_name , $ XOFFSET=70 , $ YOFFSET=100) ret = STRPOS (udp_src_path, '[') IF (ret NE -1) THEN $ log_use_flg = 0 $ ELSE $ log_use_flg = 1 IF (new_file_name NE '' ) THEN BEGIN OPENW, unit, new_file_name, /GET_LUN, ERROR=err IF (err EQ 0) THEN BEGIN FOR i=0, N_ELEMENTS(udp_new_buffer)-1 DO $ WRITEU, unit, udp_new_buffer(i) FREE_LUN, unit udp_file_name = new_file_name udp_sfilename = new_sfile_name +'.SCL' udp_old_buffer = udp_new_buffer WIDGET_CONTROL, udp_src_lbl, SET_VALUE='UDP Source File: '+ $ udp_file_name ENDIF ELSE BEGIN sc_err_msg, 'Unable to write file '+ new_file_name ENDELSE ENDIF ELSE BEGIN err = 1 ENDELSE ENDIF IF (err EQ 0) THEN udp_state = 1 END udp_f_sav_bt : BEGIN WIDGET_CONTROL, /HOURGLASS save_flag = 0 WIDGET_CONTROL, udp_src_txt, GET_VALUE=udp_new_buffer IF (N_ELEMENTS (udp_new_buffer) NE $ N_ELEMENTS(udp_old_buffer)) THEN BEGIN save_flag = 1 ENDIF ELSE BEGIN idem = 1 curr_li = 0 WHILE (idem EQ 1) AND $ (curr_li LT N_ELEMENTS(udp_new_buffer)) DO BEGIN IF (udp_new_buffer(curr_li) NE $ udp_old_buffer(curr_li) ) THEN BEGIN idem = 0 save_flag = 1 ENDIF curr_li = curr_li+1 END ENDELSE IF (save_flag EQ 1) THEN BEGIN ;--------------------------------------------------------------------------- ; Write buffer in selected file ;--------------------------------------------------------------------------- OPENW, unit, udp_file_name, /GET_LUN FOR i=0, N_ELEMENTS(udp_new_buffer)-1 DO $ WRITEU, unit, udp_new_buffer(i) FREE_LUN, unit udp_old_buffer = udp_new_buffer ENDIF udp_state = 1 END udp_f_quit_bt : BEGIN WIDGET_CONTROL, /HOURGLASS IF (udp_state EQ 2) THEN BEGIN msg = ['' , 'Buffer has been mofified', 'Quit anyway ?', ''] confirm_quit = sc_confirm_act(200, 200, msg) IF (confirm_quit EQ 1) THEN BEGIN xkill, ev.top WIDGET_CONTROL, scmenu_base, SENSITIVE=1 ; Freeze main menu ENDIF ENDIF ELSE BEGIN xkill, ev.top WIDGET_CONTROL, scmenu_base, SENSITIVE=1 ; Freeze main menu ENDELSE END ;--------------------------------------------------------------------------- ; Other operations ;--------------------------------------------------------------------------- udp_op_purg_bt : BEGIN WIDGET_CONTROL, /HOURGLASS tmp1_name = udp_src_path + STRMID(udp_sfilename, 0, $ STRPOS (udp_sfilename, '.')) + '.*' tmp2_name = 'UDP:' + STRMID(udp_sfilename, 0, $ STRPOS(udp_sfilename, '.')) + '.*' cmd = 'PURGE '+ tmp1_name + ',' + tmp2_name SPAWN, cmd, tmp WIDGET_CONTROL, udp_stat_txt , SET_VALUE=cmd WIDGET_CONTROL, udp_stat_txt , SET_VALUE=tmp, /APPEND END udp_op_comp_bt : BEGIN WIDGET_CONTROL, /HOURGLASS xmessage, ['SCL source compilation in progress...', '', $ 'Please wait.'], wbase=dummy IF (log_use_flg EQ 0) THEN BEGIN cmd = 'SCC ' + udp_file_name + $ ' -o' + udp_src_path + $ ' -l' + udp_src_path + $ ' -m' + udp_src_path + $ ' -t' + udp_src_path + $ ' -sp60 -sw132' ENDIF ELSE BEGIN cmd = 'SCC ' + udp_file_name + ' -o -l -m -t -sp200 -sw132' ENDELSE tmp = [cmd, ''] WIDGET_CONTROL, udp_stat_txt , SET_VALUE=tmp SPAWN, cmd, scc_out WIDGET_CONTROL, udp_stat_txt , SET_VALUE=scc_out, /APPEND xkill, dummy tmp = ['', 'done.'] WIDGET_CONTROL, udp_stat_txt , SET_VALUE=tmp, /APPEND ;--------------------------------------------------------------------------- ; get compilation status ;--------------------------------------------------------------------------- scc_stat = 0 FOR i=0, N_ELEMENTS(scc_out)-1 DO BEGIN IF (STRUPCASE(STRMID(scc_out(i), 0, 16)) EQ $ '%SCC-E-ERRLISTED') THEN $ scc_stat = 1 ENDFOR ;--------------------------------------------------------------------------- ; Get udp short name (no path, no extension) ;--------------------------------------------------------------------------- pos = STRPOS (udp_sfilename, '.') udp_ssfilename = STRMID (udp_sfilename, 0, pos) IF (scc_stat EQ 0) THEN BEGIN ;--------------------------------------------------------------------------- ; Get obj file name ;--------------------------------------------------------------------------- udp_obj_file = udp_src_path + udp_ssfilename +'.OBJ' ;--------------------------------------------------------------------------- ; Before copying SCL and OBJ files into the UDP directory, check ; confliction of filename ;--------------------------------------------------------------------------- sc_init_req db_request.nb_req = 1 db_request.req1_str(0) = "SELECT SOURCE_ADD FROM G_POP_UDP" nb_rec = sc_send_req (rec1, null, null) IF (nb_rec (0) NE 0) THEN BEGIN src_name_list = STRTRIM(STRUPCASE(STRMID(rec1(0, *), 4, 1000)), 2) ii = WHERE(src_name_list EQ $ STRTRIM(STRUPCASE(udp_ssfilename), 2)+'.SCL', cnt) IF cnt GE 1 THEN BEGIN err = ['Proposed POP/UDP SCL filename conflicts with one of', $ 'those registered with the SC_SUMER.', '', $ 'You need to change the SCL filename before you can', $ 'proceed.'] xack, err, group=ev.top, instr='OK', $ title='Filename Confliction' RETURN ENDIF ENDIF ;--------------------------------------------------------------------------- ; Deliver obj and src files in UDP directory ;--------------------------------------------------------------------------- ; cmd = 'COPY ' + udp_obj_file + ',' + udp_file_name+' UDP:' ; SPAWN, cmd, tmp ; WIDGET_CONTROL, udp_stat_txt , SET_VALUE='', /APPEND ; WIDGET_CONTROL, udp_stat_txt , SET_VALUE=cmd, /APPEND ; WIDGET_CONTROL, udp_stat_txt , SET_VALUE=tmp, /APPEND udp_state = 3 ;--------------------------------------------------------------------------- ; Build simu file names ;--------------------------------------------------------------------------- tki_output_file = 'TKI_SIM_OUTPUT.TRC' tki_err_file = 'TKI_SIM_OUTPUT.LOG' ENDIF END udp_op_para_bt : BEGIN WIDGET_CONTROL, /HOURGLASS ;--------------------------------------------------------------------------- ; Define UDP Parameters ;--------------------------------------------------------------------------- xmessage, ['Calling the Token Code Interpretor...', '', $ 'Please wait a moment...'], wbase=dummy ;--------------------------------------------------------------------------- ; Compute number of parameters ;--------------------------------------------------------------------------- WIDGET_CONTROL, udp_stat_txt, SET_VALUE='Calling the TKI..' ;--------------------------------------------------------------------------- ; Set variabled needed by TKI ;--------------------------------------------------------------------------- st_tki_init, obj_file=udp_obj_file tki_tcmd, 'begin' tki_tcmd, 'search_p' tki_tcmd, 'end' xkill, dummy udp_param_lst = tki_param_lst file2widget, tki_err_file, udp_stat_txt ;--------------------------------------------------------------------------- ; Sort parameter, define their types and initial values - Build prl ; file for nrt use ;--------------------------------------------------------------------------- IF (tki_err EQ 0) THEN BEGIN IF (STRTRIM(udp_param_lst(0).type, 2) EQ 'x') THEN BEGIN udp_nb_param = 0 ENDIF ELSE BEGIN udp_nb_param = N_ELEMENTS(udp_param_lst) udp_param_lst(*).type = STRTRIM(udp_param_lst(*).type , 2) udp_param_lst(*).index = STRTRIM(udp_param_lst(*).index , 2) udp_param_lst(*).value = STRTRIM(udp_param_lst(*).value , 2) ret = SORT (FIX(udp_param_lst(*).index)) udp_sort_lst = udp_param_lst udp_sort_lst(*) = udp_param_lst(ret(*)) udp_param_lst = udp_sort_lst ENDELSE ;--------------------------------------------------------------------------- ; Define parameter, Build profile file for NRT use ;--------------------------------------------------------------------------- def_err = 0 IF (udp_nb_param NE 0) THEN sc_def_udp_param, def_err IF (def_err EQ 0) THEN BEGIN ;--------------------------------------------------------------------------- ; Build PRL file for NRT use ;--------------------------------------------------------------------------- prl_sfilename = udp_ssfilename + '.PRL' udp_prl_file = udp_src_path + prl_sfilename OPENW, unit, udp_prl_file, /GET_LUN header = ['! ===========================================', $ '!', $ '! ' +udp_ssfilename+'.PRL' , $ '! This file has been built by sc_sumer on '+ $ SYSTIME() , $ '!', $ '! ==========================================='] FOR i=0, N_ELEMENTS(header)-1 DO WRITEU, unit, header(i) FOR i=0, udp_nb_param-1 DO BEGIN ;--------------------------------------------------------------------------- ; Determine domain name ;--------------------------------------------------------------------------- CASE FIX(udp_param_lst(i).id) OF 0 : domain = 'slit_d' ; slit 1 : domain = 'u10_d' ; ref pix 2 : domain = 'lambda_d' ; wavelength 4 : domain = 'compr_d' ; compression scheme 6 : domain = 'it_d' ; integration time 7 : domain = 'ifmt_d' ; image format 8 : domain = 'rastsz_d' ; raster size 35 : domain = 'calt_d' ; cal tbl 36 : domain = 'cali_d' ; cal index 38 : domain = 'cmdi_d' ; cmdlist index 32 : domain = 'xpopn_d' ; pop number 70 : domain = 'cu_d' ; processor number 56 : domain = 'dir_d' ; sphel direction 46 : domain = 'ffmode_d' ; flat field mode 82 : domain = 'htr_d' ; heater number 27 : domain = 'iif_d' ; iif validity 40 : domain = 'iimrmod_d'; IIM read out mode 28 : domain = 'master_d' ; IIF master 57 : domain = 'mc_d' ; Motor controler number 61 : domain = 'mcmod_d' ; Mc mode 89 : domain = 'mcpat_d' ; MC test pattern 87 : domain = 'mcphv_d' ; high voltage 42 : domain = 'rscit_d ; rear slit integ. time code 24 : domain = 'scan_d' ; full disk mode 45 : domain = 'spat_d' ; binning spatial 22 : domain = 'sphel_d' ; sphel direction 67 : domain = 'thrv_d' ; threshold level 33 : domain = 'udpn_d' ; UDP slot number 32 : domain = 'xpopn_d' ; POP number 12 : domain = 'yz_d' ; sun coordinate 13 : domain = 'yz_d' ; sun coordinate ELSE :BEGIN CASE udp_param_lst(i).type OF 'r' : domain = 'r32_d' 's' : domain = 'i32_d' 'u' : domain = 'u32_d' ELSE : domain = 'r32_d' ENDCASE END ENDCASE ;--------------------------------------------------------------------------- ; Determine format ;--------------------------------------------------------------------------- CASE udp_param_lst(i).type OF 'r' : format = 'R4' 's' : format = 'I4' 'u' : format = 'I4' ELSE : format = 'R4' ENDCASE ;--------------------------------------------------------------------------- ; Build param definition line ;--------------------------------------------------------------------------- line = STRING(FIX(udp_param_lst(i).index), $ FORMAT='(I3.3)') + ' ' + $ format + ' "' + STRTRIM(udp_param_lst(i).prompt, 2) + $ '" ' + ' ' + domain WRITEU, unit, line ENDFOR FREE_LUN, unit udp_state = 4 ENDIF ENDIF END udp_op_regi_bt : BEGIN ;--------------------------------------------------------------------------- ; Register udp in database ;--------------------------------------------------------------------------- sc_reg_udp, err IF (err EQ 0) THEN BEGIN ;--------------------------------------------------------------------------- ; Copy .OBJ, .RST and .SCL files to the UDP directory ;--------------------------------------------------------------------------- cmd = 'COPY ' + udp_obj_file + ',' + udp_file_name+' UDP:' SPAWN, cmd, tmp WIDGET_CONTROL, udp_stat_txt , SET_VALUE='', /APPEND WIDGET_CONTROL, udp_stat_txt , SET_VALUE=cmd, /APPEND WIDGET_CONTROL, udp_stat_txt , SET_VALUE=tmp, /APPEND WAIT, 2 udp_state = 1 buffer = ['UDP is now registered in data base', $ 'POP/UDP->Modification option in menu to manage '+$ 'new SUMER program.'] WIDGET_CONTROL, udp_stat_txt, SET_VALUE=buffer ENDIF END udp_src_txt : BEGIN IF (ev.type NE 3 AND udp_state NE 0) THEN udp_state = 2 END udp_stat_txt : ELSE: BEGIN WIDGET_CONTROL, ev.id, GET_UVALUE=val tmp_name = udp_src_path + udp_ssfilename CASE val OF 'LST': tmp_file = tmp_name+'.LST' 'MAP': tmp_file = tmp_name+'.MAP' 'TOK': tmp_file = tmp_name+'.TOK' 'OBJ': tmp_file = tmp_name+'.OBJ' ENDCASE OPENR, unit, tmp_file, /GET_LUN, ERROR=err IF (err EQ 0) THEN BEGIN nb_lig = 0 curr_lig = '' WHILE NOT EOF(unit) DO BEGIN READF, unit, curr_lig nb_lig = nb_lig + 1 ENDWHILE POINT_LUN, unit, 0 buffer = STRARR (nb_lig) i = 0 WHILE NOT EOF(unit) DO BEGIN READF, unit, curr_lig buffer(i) = curr_lig i = i+1 ENDWHILE FREE_LUN, unit ENDIF ELSE BEGIN buffer = ['Unable to Read file :' + tmp_file] ENDELSE WIDGET_CONTROL, udp_stat_txt, SET_VALUE=buffer END ENDCASE ;--------------------------------------------------------------------------- ; Manage button sensitive ;--------------------------------------------------------------------------- IF (ev.id NE udp_f_quit_bt) THEN BEGIN CASE udp_state OF 0: BEGIN WIDGET_CONTROL, udp_f_new_bt , SENSITIVE=1 WIDGET_CONTROL, udp_f_ope_bt , SENSITIVE=1 WIDGET_CONTROL, udp_f_sav_as_bt , SENSITIVE=0 WIDGET_CONTROL, udp_f_sav_bt , SENSITIVE=0 WIDGET_CONTROL, udp_f_quit_bt , SENSITIVE=1 WIDGET_CONTROL, udp_op_bt , SENSITIVE=0 END 1: BEGIN WIDGET_CONTROL, udp_f_new_bt , SENSITIVE=1 WIDGET_CONTROL, udp_f_ope_bt , SENSITIVE=1 WIDGET_CONTROL, udp_f_sav_as_bt , SENSITIVE=0 WIDGET_CONTROL, udp_f_sav_bt , SENSITIVE=0 WIDGET_CONTROL, udp_f_quit_bt , SENSITIVE=1 WIDGET_CONTROL, udp_op_bt , SENSITIVE=1 WIDGET_CONTROL, udp_op_purg_bt , SENSITIVE=1 WIDGET_CONTROL, udp_op_comp_bt , SENSITIVE=1 WIDGET_CONTROL, udp_op_disp_bt , SENSITIVE=1 WIDGET_CONTROL, udp_op_para_bt , SENSITIVE=0 WIDGET_CONTROL, udp_op_regi_bt , SENSITIVE=0 END 2: BEGIN WIDGET_CONTROL, udp_f_new_bt , SENSITIVE=1 WIDGET_CONTROL, udp_f_ope_bt , SENSITIVE=1 WIDGET_CONTROL, udp_f_quit_bt , SENSITIVE=1 WIDGET_CONTROL, udp_f_sav_as_bt , SENSITIVE=1 STRING = STRUPCASE(STRMID (udp_sfilename, 0, 3)) IF (STRING NE 'POP') AND (STRING NE 'SEQ') THEN $ WIDGET_CONTROL, udp_f_sav_bt, SENSITIVE=1 $ ELSE WIDGET_CONTROL, udp_f_sav_bt, SENSITIVE=0 WIDGET_CONTROL, udp_op_bt , SENSITIVE=0 END 3: BEGIN WIDGET_CONTROL, udp_f_new_bt , SENSITIVE=1 WIDGET_CONTROL, udp_f_ope_bt , SENSITIVE=1 WIDGET_CONTROL, udp_f_sav_as_bt , SENSITIVE=0 WIDGET_CONTROL, udp_f_sav_bt , SENSITIVE=0 WIDGET_CONTROL, udp_f_quit_bt , SENSITIVE=1 WIDGET_CONTROL, udp_op_bt , SENSITIVE=1 WIDGET_CONTROL, udp_op_purg_bt , SENSITIVE=1 WIDGET_CONTROL, udp_op_comp_bt , SENSITIVE=0 WIDGET_CONTROL, udp_op_disp_bt , SENSITIVE=1 WIDGET_CONTROL, udp_op_para_bt , SENSITIVE=1 WIDGET_CONTROL, udp_op_regi_bt , SENSITIVE=0 END 4: BEGIN WIDGET_CONTROL, udp_f_new_bt , SENSITIVE=1 WIDGET_CONTROL, udp_f_ope_bt , SENSITIVE=1 WIDGET_CONTROL, udp_f_sav_as_bt , SENSITIVE=0 WIDGET_CONTROL, udp_f_sav_bt , SENSITIVE=0 WIDGET_CONTROL, udp_f_quit_bt , SENSITIVE=1 WIDGET_CONTROL, udp_op_bt , SENSITIVE=1 WIDGET_CONTROL, udp_op_purg_bt , SENSITIVE=1 WIDGET_CONTROL, udp_op_comp_bt , SENSITIVE=0 WIDGET_CONTROL, udp_op_disp_bt , SENSITIVE=1 WIDGET_CONTROL, udp_op_para_bt , SENSITIVE=0 WIDGET_CONTROL, udp_op_regi_bt , SENSITIVE=1 END 5: BEGIN WIDGET_CONTROL, udp_f_new_bt , SENSITIVE=1 WIDGET_CONTROL, udp_f_ope_bt , SENSITIVE=1 WIDGET_CONTROL, udp_f_sav_as_bt , SENSITIVE=0 WIDGET_CONTROL, udp_f_sav_bt , SENSITIVE=0 WIDGET_CONTROL, udp_f_quit_bt , SENSITIVE=1 WIDGET_CONTROL, udp_op_bt , SENSITIVE=1 WIDGET_CONTROL, udp_op_purg_bt , SENSITIVE=1 WIDGET_CONTROL, udp_op_comp_bt , SENSITIVE=0 WIDGET_CONTROL, udp_op_disp_bt , SENSITIVE=1 WIDGET_CONTROL, udp_op_para_bt , SENSITIVE=0 WIDGET_CONTROL, udp_op_regi_bt , SENSITIVE=0 END ENDCASE ENDIF END PRO sc_cre_pop_trt, ev ;--------------------------------------------------------------------------- ; Main program ;--------------------------------------------------------------------------- COMMON sccrepop_com COMMON scmain_com COMMON scconst_com Title = 'SCG: UDP Creation' udp_state = 0 udp_file_name = '' WIDGET_CONTROL, /HOURGLASS WIDGET_CONTROL, scmenu_base, SENSITIVE=0 ; Freeze main menu ;--------------------------------------------------------------------------- ; Base creation ;--------------------------------------------------------------------------- udp_base = WIDGET_BASE (TITLE=Title, XOFFSET=0, YOFFSET=0, /COLUMN) udp_menu_base = WIDGET_BASE (udp_base, /ROW, FRAME=4) udp_src_base = WIDGET_BASE (udp_base, /COLUMN) udp_stat_base = WIDGET_BASE (udp_base, /COLUMN) ;--------------------------------------------------------------------------- ; Widgets/menu creation ;--------------------------------------------------------------------------- udp_f_bt = WIDGET_BUTTON (udp_menu_base, VALUE='File', MENU=2) udp_f_new_bt = WIDGET_BUTTON (udp_f_bt, VALUE='New...') udp_f_ope_bt = WIDGET_BUTTON (udp_f_bt, VALUE='Open...') udp_f_sav_as_bt = WIDGET_BUTTON (udp_f_bt, VALUE='Save as ...') udp_f_sav_bt = WIDGET_BUTTON (udp_f_bt, VALUE='Save') udp_f_quit_bt = WIDGET_BUTTON (udp_f_bt, VALUE='Quit') udp_op_bt = WIDGET_BUTTON (udp_menu_base, VALUE='Operations', MENU=2) udp_op_purg_bt = WIDGET_BUTTON (udp_op_bt, VALUE='Purge') udp_op_comp_bt = WIDGET_BUTTON (udp_op_bt, VALUE='Compile') udp_op_disp_bt = WIDGET_BUTTON (udp_op_bt, VALUE='Display', MENU=2) udp_op_dlist_bt = WIDGET_BUTTON(udp_op_disp_bt, UVALUE='LST', $ VALUE='Listing File') udp_op_dmap_bt = WIDGET_BUTTON (udp_op_disp_bt , UVALUE='MAP', $ VALUE='Map File') udp_op_dtok_bt = WIDGET_BUTTON (udp_op_disp_bt , UVALUE='TOK', $ VALUE='Token File') udp_op_para_bt = WIDGET_BUTTON (udp_op_bt, VALUE='Define Parameters') udp_op_regi_bt = WIDGET_BUTTON (udp_op_bt, VALUE='Register UDP') dummy = WIDGET_BASE (udp_src_base, /COLUMN) udp_src_lbl = WIDGET_LABEL (dummy, VALUE='UDP Source File: ') udp_src_txt = WIDGET_TEXT (dummy , $ XSIZE=80 , $ YSIZE=35 , $ /ALL_EVENTS , $ /EDITABLE , $ FONT=Courier_Font, $ /SCROLL) ret = WIDGET_INFO (dummy, /GEOMETRY) dummy = WIDGET_BASE (udp_stat_base, /COLUMN, XSIZE=ret.xsize) ret = WIDGET_LABEL (dummy, VALUE='Operation Status') udp_stat_txt = WIDGET_TEXT (dummy , $ XSIZE=80 , $ YSIZE=13 , $ /SCROLL , $ FONT=Hd_Font_Bold) ;--------------------------------------------------------------------------- ; Event Manager ;--------------------------------------------------------------------------- WIDGET_CONTROL, udp_f_new_bt , SENSITIVE=1 WIDGET_CONTROL, udp_f_ope_bt , SENSITIVE=1 WIDGET_CONTROL, udp_f_quit_bt , SENSITIVE=1 WIDGET_CONTROL, udp_f_sav_as_bt , SENSITIVE=0 WIDGET_CONTROL, udp_f_sav_bt , SENSITIVE=0 WIDGET_CONTROL, udp_op_bt , SENSITIVE=0 WIDGET_CONTROL, udp_src_txt , EDITABLE=0 WIDGET_CONTROL, udp_base, /realize XMANAGER, 'sc_cre_pop', udp_base END