;---------------------------------------------------------------------------
; Document name: ST_SUMER.PRO
; Created by:    Liyun Wang, NASA/GSFC, September 19, 1996
;
; Last Modified: Sun Dec  3 01:50:01 2000 (GERMEROTT@sumop1.nascom.nasa.gov)
;---------------------------------------------------------------------------
;
;+
; PROJECT:
;       SOHO - SUMER
;
; NAME:
;       ST_SUMER
;
; PURPOSE:
;       Simulation Tool for SUMER
;
; EXPLANATION:
;       The Simulation Tool for SUMER (ST_SUMER) is the front end of
;       the SUMER simulator (the TKI package) that can be used to
;       create simulated UDPs, register simulated UDPs with the SUMER
;       database, and make one-item studies.
;
; CALLING SEQUENCE:
;       ST_SUMER [, file=file]
;
; INPUTS:
;       None.
;
; OPTIONAL INPUTS:
;       None.
;
; OUTPUTS:
;       None.
;
; OPTIONAL OUTPUTS:
;       None.
;
; KEYWORD PARAMETERS:
;       GROUP - ID of calling widget that serves as a group leader
;
; COMMON BLOCKS:
;       @st_sumer_com
;
; RESTRICTIONS:
;       None.
;
; SIDE EFFECTS:
;       The caller widget, if any, is frozen till this program exits.
;
; CATEGORY:
;       Simulator
;
; WORKING ENVIRONMENT:
;       IDL: Version 4.0 and up
;       OS:  VMS
;
; PREVIOUS HISTORY:
;       Written September 19, 1996, Liyun Wang, NASA/GSFC
;
; MODIFICATION HISTORY:
;       Version 1, Liyun Wang, NASA/GSFC, September 19, 1996
;       Version 1.1, October 15, 1996, Liyun Wang, NASA/GSFC
;          Made sure that single quotation mark is removed from title, etc.
;       Version 1.2, November 18, 1996, Liyun Wang, NASA/GSFC
;          Added message reminding the user not to register UDP when
;             he/she really wants to create a study
;          Changed pointing widgets to use the heliocentric system
;          Check imported UDP if pointing has been changed since last
;             simulation
;       Version 1.3, January 27, 1997, Liyun Wang, NASA/GSFC
;          Added mechanism of purging UDP files upon successful creation
;       Version 1.4, February 7, 1997, Liyun Wang, NASA/GSFC
;          Allowed user to rename the SCL related files during registration
;       Version 1.5, April 9, 1997, Liyun Wang, NASA/GSFC
;          Allowed SIRIUS to be the machine capable of registering UDPs
;       Version 1.6, April 15, 1997, Liyun Wang, NASA/GSFC
;          Made it more portable
;       Version 1.7, May 12, 1997, Liyun Wang, NASA/GSFC
;          Added check against database update status
;          Added check against compilation error
;       Version 1.8, June 24, 1997, Liyun Wang, NASA/GSFC
;          Added option to select detector and telemetry rate when running
;             from a non-SUMER machine
;       Version 1.9, October 15, 1999, Dietmar Germerott, MPAE Lindau
;          Added option to go on with current pointing without resimulation
;       Version 2.0, December 3, 2000, Dietmar Germerott, MPAE Lindau
;          Added new SUMER NODE at Lindau (VMS3)
; VERSION:
;       Version 1.9, June 24, 1997
;
; CONTACT:
;       Liyun Wang, NASA/GSFC (Liyun.Wang@gsfc.nasa.gov)
;-
;

PRO st_sumer_msg, mssg
@st_sumer_com
   WIDGET_CONTROL, inst_txt, set_value=mssg
END

PRO st_sumer_button, wid
@st_sumer_com
   has_scl = N_ELEMENTS(udp_src_file) NE 0
   sim_done = N_ELEMENTS(tki_udp_stc) NE 0
   WIDGET_CONTROL, wid.op_bt, sensitive=has_scl
   WIDGET_CONTROL, wid.purge_bt, sensitive=has_scl
   WIDGET_CONTROL, wid.udp_disp_bt, sensitive=sim_done
   WIDGET_CONTROL, wid.udp_spec_bt, sensitive=sim_done
   IF has_db THEN BEGIN
      IF sc_update_status(node_name, site=site) EQ 0 THEN BEGIN
         msg = ['Current operations site is now set to '+site+', and', $
                'access to the Oracle database system at this site', $
                'is temporarily denied. You can no longer make and ',$
                'register any UDP/study in this session.']
         xack, msg, instr='OK', title='ST_SUMER Message', /modal
         has_db = 0
         WIDGET_CONTROL, wid.mkudp_bt, sensitive=0
         WIDGET_CONTROL, wid.mkstd_bt, sensitive=0
      ENDIF
   ENDIF
   IF N_ELEMENTS(udp_src_base) NE 0 THEN BEGIN
      log_file = concat_dir(udp_src_path, udp_src_base+'.log')
      WIDGET_CONTROL, wid.log_disp_bt, sensitive=test_open(log_file)
   ENDIF ELSE $
      WIDGET_CONTROL, wid.log_disp_bt, sensitive=sim_done
END

PRO st_sumer_logo, image, rgb, draw_id
   TVLCT, rgb(*, 0), rgb(*, 1), rgb(*, 2)
   WIDGET_CONTROL, draw_id, get_value=win_id
   sav_index = !d.window
   WSET, win_id
   TV, image
   WSET, sav_index
END

PRO st_sumer_event, event
;---------------------------------------------------------------------------
;  Event handler for ST_SUMER
;---------------------------------------------------------------------------
@st_sumer_com

   WIDGET_CONTROL, event.top, get_uvalue = wid

;---------------------------------------------------------------------------
;  Handle tracking events
;---------------------------------------------------------------------------
   track_flag = STRPOS(TAG_NAMES(event, /struct), 'TRACK') NE -1
   IF track_flag THEN BEGIN
      IF event.enter EQ 0 THEN BEGIN
         st_sumer_msg, ''
         RETURN
      ENDIF
      CASE (event.id) OF
         wid.wid_det: st_sumer_msg, 'Select detector to be used'
         wid.wid_tm: st_sumer_msg, 'Select telemetry rate you expect to have'
         wid.file_bt: st_sumer_msg, 'Pull-down menu button for file '+$
            'related operations'
         wid.op_bt: st_sumer_msg, 'Pull-down menu button for various operations'
         wid.help_bt: st_sumer_msg, 'Pull-down menu button for help'
         wid.udp_disp_bt: st_sumer_msg, 'Bring up a pop-up widget to '+$
            'display the contents of simulated UDP'
         wid.log_disp_bt: st_sumer_msg, 'Bring up a pop-up widget to '+$
            'display simulation log file'
         wid.udp_spec_bt: st_sumer_msg, 'Bring up a widget to '+$
            'display the spectral range of simulated UDP'
         wid.mkudp_bt: st_sumer_msg, 'Get ready to create an UDP in the '+$
            'SUMER database system for future use'
         wid.mkstd_bt: st_sumer_msg, 'Get ready to create a study in the '+$
            'SUMER database system'
         wid.udp_name: st_sumer_msg, 'Enter a name for the UDP/study to '+$
            'be created'
         wid.udp_title: st_sumer_msg, 'Enter a title for the UDP/study '+$
            'to be created'
         wid.udp_purpose: st_sumer_msg, 'Enter a brief description for '+$
            'the UDP/study'
         wid.point_x: st_sumer_msg, 'Set initial pointing value '+$
            'in W/E direction (with W being positive; in arcsecs)'
         wid.point_y: st_sumer_msg, 'Set initial pointing value '+$
            'in N/S direction (with N being positive; in arcsecs)'
         wid.stat_txt: st_sumer_msg, 'Watch out operation status...'
         inst_txt: st_sumer_msg, 'Pay attention here when you move your '+$
            'mouse....'
         ELSE: BEGIN
            WIDGET_CONTROL, event.id, get_uvalue=uvalue
            CASE (uvalue) OF
               'open': st_sumer_msg, 'Load in an UDP written in SCL'
               'import': st_sumer_msg, 'Import an UDP saved in MMD format'
               'quit': st_sumer_msg, 'Quit ST_SUMER'
               'disp_scl': st_sumer_msg, 'Display the SCL code of current UDP'
               'purge': st_sumer_msg, 'Clean up files associated with '+$
                  'current UDP'
               'help': st_sumer_msg, 'Get help tips on various topics'
               'help_abt': st_sumer_msg, 'Information about this software'
               'categ': st_sumer_msg, 'Select appropriate category for UDP'
               'pt_seq': BEGIN
                  IF need_pt THEN $
                     st_sumer_msg, 'Click to exclude the pointing sequence '+$
                     'from the study' $
                  ELSE $
                     st_sumer_msg, 'Click to include a pointing sequence '+$
                     'in the study'
               END
               'zone': st_sumer_msg, 'Select an appropriate pointing zone'
               'go': st_sumer_msg, 'Press to start the process of '+$
                  'creating an UDP/study'
               'cancel': st_sumer_msg, 'Press to cancel the process '+$
                  'of creating an UDP/study'
               'make_udp_stc': st_sumer_msg, 'Run the SUMER simulator to '+$
                  'create an UDP structure and save the UDP in MMD format'
               ELSE:
            ENDCASE
         END
      ENDCASE
      RETURN
   ENDIF

   WIDGET_CONTROL, event.id, get_uvalue = uvalue
   IF N_ELEMENTS(uvalue) EQ 0 THEN RETURN
   WIDGET_CONTROL, /hour

   CASE (uvalue) OF
      'sel_det': BEGIN
         IF event.index EQ 0 THEN tki_current_det = 'A' $
         ELSE tki_current_det = 'B'
      END
      'sel_tm': BEGIN
         IF event.index EQ 0 THEN tki_current_tm = 'L' $
         ELSE tki_current_tm = 'H'
      END
      'mkstd': BEGIN
         WIDGET_CONTROL, wid.msg_bs, map=0
         WIDGET_CONTROL, wid.field_bs, map=1
         WIDGET_CONTROL, wid.pt_seq_bt, map=1
         WIDGET_CONTROL, wid.point_bs, map=need_pt
         WIDGET_CONTROL, wid.mode_label, $
            set_value='Required Fields for Making a Study'
         go_mode = 1
      END

      'mkudp': BEGIN
         WIDGET_CONTROL, wid.msg_bs, map=0
         WIDGET_CONTROL, wid.field_bs, map=1
         WIDGET_CONTROL, wid.pt_seq_bt, map=0
         WIDGET_CONTROL, wid.point_bs, map=0
         WIDGET_CONTROL, wid.mode_label, $
            set_value='Required Fields for Making an UDP'
         go_mode = 0
      END

      'pt_seq': BEGIN
         WIDGET_CONTROL, wid.point_bs, map=event.select
         need_pt = event.select
      END

      'cancel': BEGIN
         WIDGET_CONTROL, wid.field_bs, map=0
         WIDGET_CONTROL, wid.msg_bs, map=1
         st_sumer_logo, image, rgb, wid.draw_id
      END

      'SOHO_LOGO': BEGIN
         IF event.press THEN st_sumer_logo, image, rgb, wid.draw_id
      END

      'open': BEGIN
         mk_dfont, lfont=lfont, bfont=bfont, tfont=tfont
         tmp = pickfile2(filter='*.scl', /fix_filter, path=udp_src_path, $
                        group=event.top, /must_exist, $
                        title='SCL File Selector',font=lfont)
         IF tmp NE '' THEN BEGIN
            break_file, tmp, dir_log, dir, filnam, ext, fversion, node
            WIDGET_CONTROL, wid.stat_txt, set_value=['','Reading '+$
               concat_dir(dir_log+dir, filnam+ext)+'...'], /hour, /append
            codes = rd_ascii2(tmp, err=err)
            IF err NE '' THEN BEGIN
               xack, err, group=event.top, instr='OK', title='I/O Error'
               RETURN
            ENDIF
            WIDGET_CONTROL, wid.stat_txt, set_value='Done.', /append
            udp_src_code = codes
            udp_src_path = dir_log+dir
            udp_src_fname = tmp
            udp_src_base = filnam
            udp_src_file = udp_src_base+ext
            CD, udp_src_path
            WIDGET_CONTROL, wid.scl_name, $
               set_value=concat_dir(udp_src_path, udp_src_file)
            WIDGET_CONTROL, wid.id_txt, set_value='(TBD)'

;---------------------------------------------------------------------------
;           Compile the SCL code if OBJ code does not exist yet
;---------------------------------------------------------------------------
            cmd = 'scc ' + udp_src_file + ' -o -l -m -t -sp200 -sw132'
            WIDGET_CONTROL, wid.stat_txt, $
               SET_VALUE=['', 'Compiling SCL code..', cmd], /append

;---------------------------------------------------------------------------
;           Before compile the SCL code, remove the existing OBJ file,
;           if any
;---------------------------------------------------------------------------
            obj_file = concat_dir(udp_src_path, udp_src_base+'.obj')
            SPAWN, 'DELETE '+obj_file+';*', tmp, /noclisym, /nolognam

            SPAWN, cmd, tmp
            WIDGET_CONTROL, wid.stat_txt, SET_VALUE=[tmp, 'Done.'], /append

            IF test_open(obj_file) EQ 0 THEN BEGIN
               xack, ['Error occurred during compilation. Please check',$
                      'your SCL code for any syntax error.'], group=event.top,$
                  title='Compilation Error'
               delvarx, udp_src_file
               RETURN
            ENDIF

;---------------------------------------------------------------------------
;           If TKI_UDP_STC exists, compare the OBJ code to determine whether
;           TKI_UDP_STC should be kept
;---------------------------------------------------------------------------
            IF N_ELEMENTS(tki_udp_stc) NE 0 THEN BEGIN
               IF NOT st_comp_obj(obj_file, tki_udp_stc) THEN BEGIN
                  MESSAGE, 'Previous TKI_UDP_STC in memory removed..', /cont
                  delvarx, tki_udp_stc
               ENDIF
            ENDIF
            WIDGET_CONTROL, wid.go_button, sensitive=1
            doc_stc = get_udp_head(concat_dir(udp_src_path, udp_src_file))
            st_update_field, doc_stc, wid
         ENDIF
      END

      'go': BEGIN
;---------------------------------------------------------------------------
;        If ID exists, it means that UDP/Study creation is done
;---------------------------------------------------------------------------
         WIDGET_CONTROL, wid.id_txt, get_value=id
         IF STRTRIM(id(0), 2) NE '(TBD)' THEN BEGIN
            xack, 'UDP/Study already created.', group=event.top, instr='OK'
            RETURN
         ENDIF

;---------------------------------------------------------------------------
;        Warn user if his/her intention is to build a study
;---------------------------------------------------------------------------
         IF go_mode EQ 0 THEN BEGIN
            mess = ['Attention: This operation is meant for you to create',$
                    '           and register an UDP that may be used in',$
                    '           compound studies in the future. It will',$
                    '           NOT create a study using the current UDP.','',$
                    'If you only want to build a study using this single UDP,',$
                    'you may want to choose the "Make Study" operation to',$
                    'do so in one step.', '', $
                    'Do you want to continue registering this UDP anyway?']
            IF NOT xanswer(mess, group=event.top, flash=2, /beep) THEN RETURN
         ENDIF

         qstr = STRING(39B) ; Single quote string

;---------------------------------------------------------------------------
;        Check required fields before making an UDP or study
;---------------------------------------------------------------------------
         WIDGET_CONTROL, wid.udp_name, get_value=udp_name_str
         udp_name_str = STRTRIM(udp_name_str(0), 2)
         IF udp_name_str EQ '' THEN BEGIN
            xack, 'You must fill the NAME field.', group=event.top, space=3, $
               title='Required field unfilled', inst='OK', /icon
            RETURN
         ENDIF
         udp_name_str = strep(udp_name_str,qstr,'',/all)

         WIDGET_CONTROL, wid.udp_title, get_value=udp_title_str
         udp_title_str = STRTRIM(udp_title_str(0), 2)
         IF udp_title_str EQ '' THEN BEGIN
            xack, 'You must fill the TITLE field.', group=event.top, space=3, $
               title='Required field unfilled', inst='OK', /icon
            RETURN
         ENDIF
         udp_title_str = strep(udp_title_str,qstr,'',/all)

         WIDGET_CONTROL, wid.udp_purpose, get_value=udp_purpose_str
         str = STRTRIM(udp_purpose_str, 2)
         ii = WHERE(str EQ '', count)
         IF count EQ N_ELEMENTS(str) THEN BEGIN
            xack, 'You must fill the PURPOSE field.', group=event.top, $
               space=3, title='Required field unfilled', inst='OK', /icon
            RETURN
         ENDIF
         FOR i=0, N_ELEMENTS(udp_purpose_str)-1 DO $
            udp_purpose_str(i) = strep(udp_purpose_str(i), qstr, '', /all)

         WIDGET_CONTROL, wid.point_x, get_value=xx
         init_y = FLOAT(xx(0))
         WIDGET_CONTROL, wid.point_y, get_value=yy
         init_z = -FLOAT(yy(0))

         IF datatype(tki_udp_stc) EQ 'STC' THEN BEGIN
;---------------------------------------------------------------------------
;           Check to see if pointing has been changed
;---------------------------------------------------------------------------
            pchanged = (ABS(init_y-tki_udp_stc.def_y) GE 1.e-2 OR $
                        ABS(init_z-tki_udp_stc.def_z) GE 1.e-2)
            IF pchanged THEN BEGIN
               mess = ['Pointing value(s) may have been changed since last', $
                       'simulation. If you intend to use the current pointing', $
                       'values, the UDP will have to be simulated again.', '', $
                       'You can choose the following options:']
               answer = xchoice(mess, ['1. Go ahead using current values and continue (resimulate)', $
                                       '2. Recover previous values and continue      ', $
                                       '3. Recover previous values only              ', $
                                       '4. Using current values but do not resimulate', $
                                       '5. Do nothing (exit)                         '], $
                             group=event.top, buff=2)
               CASE (answer) OF
                  0: delvarx, tki_udp_stc
                  1: BEGIN
                     WIDGET_CONTROL, wid.point_x, set_value=$
                        STRTRIM(STRING(tki_udp_stc.def_y, format='(f15.2)'), 2)
                     WIDGET_CONTROL, wid.point_y, set_value=$
                        STRTRIM(STRING(-tki_udp_stc.def_z, format='(f15.2)'), 2)
                  END
                  2: BEGIN
                     WIDGET_CONTROL, wid.point_x, set_value=$
                        STRTRIM(STRING(tki_udp_stc.def_y, format='(f15.2)'), 2)
                     WIDGET_CONTROL, wid.point_y, set_value=$
                        STRTRIM(STRING(-tki_udp_stc.def_z, format='(f15.2)'), 2)
                     RETURN
                  END
                  3:BEGIN       ;added for no resimulation
                     msg = ['You are using a pointing without simulation', $
                            'this can result in diffrent count rates or', $
                            'in a positon that cannot be reached by SUMER ! ', $
                            ' ']
                     xack, msg, instr='OK', title='ST_SUMER Message', /modal
                     
                     tki_udp_stc.def_y = init_y
                     tki_udp_stc.def_z = init_z
                  END
                  ELSE: RETURN
               ENDCASE
            ENDIF
         ENDIF

         init_pt = {init_y:init_y, init_z:init_z}

         IF N_ELEMENTS(tki_udp_stc) EQ 0 THEN BEGIN
            st_mk_udp_stc, init_pt, event, error=error
            IF error NE '' THEN BEGIN
               st_sumer_button, wid
               RETURN
            ENDIF
         ENDIF

;---------------------------------------------------------------------------
;        Add/change doc header in SCL code
;---------------------------------------------------------------------------
         get_utc, utc, /vms, /truncate
         doc_stc = {name:udp_name_str, title:udp_title_str, $
                    purpose:udp_purpose_str, category:category, $
                    def_y:STRTRIM(STRING(tki_udp_stc.def_y,form='(f12.2)'),2),$
                    def_z:STRTRIM(STRING(tki_udp_stc.def_z,form='(f12.2)'),2),$
                    time_saved:utc}
         scl_code = tki_udp_stc.scl
         add_udp_head, scl_code, doc_stc, error=error
         IF error EQ '' THEN BEGIN
            tki_udp_stc = rem_tag(tki_udp_stc, 'scl')
            tki_udp_stc = add_tag(tki_udp_stc, scl_code, 'scl')
            udp_rst_file = concat_dir(udp_src_path, udp_src_base+'.mmd')
            tki_save_udp, tki_udp_stc, udp_rst_file=udp_rst_file
            IF NOT write_ascii(concat_dir(udp_src_path, udp_src_file), $
                               tki_udp_stc.scl) THEN BEGIN
               xack, 'Rewrite SCL code failed!', group=event.top, /icon
            ENDIF
         ENDIF

;---------------------------------------------------------------------------
;        Make a new structure for creating UDP and/or study in database
;---------------------------------------------------------------------------
         stc_for_db = tki_udp_stc
         junk = {name:udp_name_str, title:udp_title_str, $
                 category:category, purpose:udp_purpose_str, $
                 scl_base:udp_src_base, scl_path:udp_src_path, $
                 udp_id:-1, init_y:init_y, init_z:init_z}
         IF go_mode EQ 1 AND need_pt THEN $
            junk = add_tag(junk, zone_id, 'ZONE_ID')

         stc_for_db = add_tag(stc_for_db, junk, 'UDP_SEQ')

;---------------------------------------------------------------------------
;        Create UDP first
;---------------------------------------------------------------------------
         WIDGET_CONTROL, wid.stat_txt, set_value=['','Register UDP...'], $
            /append
         CALL_PROCEDURE, 'st_reg_udp', stc_for_db, event, error=error
         IF error NE '' THEN BEGIN
            WIDGET_CONTROL, wid.stat_txt, set_value=error, /append
            RETURN
         ENDIF
         WIDGET_CONTROL, wid.stat_txt, set_value='Done.', /append
;---------------------------------------------------------------------------
;        Update UDP source base name (it may get changed in ST_REG_UDP)
;---------------------------------------------------------------------------
         udp_src_base = stc_for_db.udp_seq.scl_base
         udp_src_file = udp_src_base+'.scl'
         WIDGET_CONTROL, wid.scl_name, $
            set_value=concat_dir(udp_src_path, udp_src_file)

;---------------------------------------------------------------------------
;        Create study only if requested
;---------------------------------------------------------------------------
         IF go_mode THEN BEGIN
            WIDGET_CONTROL, wid.stat_txt, $
               set_value=['', 'Register study...'], /append
            CALL_PROCEDURE, 'st_reg_study', stc_for_db, std_id=std_id, $
               error=error, test=testing
            IF error NE '' THEN BEGIN
               WIDGET_CONTROL, wid.stat_txt, set_value=error, /append
               RETURN
            ENDIF
            WIDGET_CONTROL, wid.stat_txt, set_value='Done.', /append
            WIDGET_CONTROL, wid.id_txt, set_value=STRTRIM(std_id,2)
            msg = $
               ["Congratulations! Your study has been successfully created.",$
                "Its ID is "+STRTRIM(std_id,2)+", and the ID of the UDP that "+$
                "builds up this", "study is "+STRTRIM(stc_for_db.udp_seq.udp_id,2)+"."]
         ENDIF ELSE BEGIN
            WIDGET_CONTROL, wid.id_txt, set_value=$
               STRTRIM(stc_for_db.udp_seq.udp_id, 2)
            msg = ["Congratulations! Your UDP has been successfully created.",$
                   "Its ID is "+STRTRIM(stc_for_db.udp_seq.udp_id,2)+"."]
         ENDELSE

;---------------------------------------------------------------------------
;        Clean up UDP associated files
;---------------------------------------------------------------------------
         st_sumer_purge, wid
         file_tmp = concat_dir(udp_src_path, udp_src_base)
         cmd = 'DELETE '+file_tmp+'.mmd;*,'+file_tmp+'.obj;*'
         WIDGET_CONTROL, wid.stat_txt, SET_VALUE=['', cmd], /append
         SPAWN, cmd, tmp, /noclisym, /nolognam

         IF go_mode THEN WIDGET_CONTROL, wid.go_button, sensitive=0
         xack, msg, group=event.top, title='Congratulations'
      END

      'import': BEGIN
         IF N_ELEMENTS(tki_udp_stc) NE 0 THEN BEGIN
            IF NOT xanswer(['Importing a new UDP will overwrite what you ',$
                            'have in memory.', '', $
                            'Are you sure about that?'], $
                           group=event.top, /beep) THEN RETURN
         ENDIF
         WIDGET_CONTROL, /hour
         mk_dfont, lfont=lfont, bfont=bfont, tfont=tfont
         tmp = pickfile2(filter='*.mmd', /fix_filter, path=udp_src_path, $
                         group=event.top, /must_exist, $
                         title='UDP MMD File Selector', font=lfont)
         IF tmp NE '' THEN BEGIN
            break_file, tmp, dir_log, dir, filnam, ext, fversion, node
            scl_tmp = concat_dir(dir_log+dir,filnam+'.scl')
            IF file_exist(scl_tmp) THEN BEGIN
               IF NOT xanswer(['The UDP to be imported would clobber your '+$
                               'SCL file '+filnam+'.scl.', $
                               'You can change name of the UDP MMD file '+$
                               'and try again, or preceed the process.', '', $
                               'Preceed this UDP importing process?'], $
                              group=event.top, /beep) THEN RETURN
            ENDIF
            WIDGET_CONTROL, wid.stat_txt, set_value=['', 'Importing UDP..'],$
               /hour, /append
            IF N_ELEMENTS(tki_udp_stc) NE 0 THEN udp_stc_save = tki_udp_stc
            RESTORE, tmp
            IF N_ELEMENTS(make_my_day) EQ 0 THEN BEGIN
               msg = ['Invalid UDP format.', 'Importing process aborted.']
               WIDGET_CONTROL, wid.stat_txt, set_value=msg, /append
               xack, msg, group=event.top, title='Warning'
               RETURN
            ENDIF
            delvarx, make_my_day
            WIDGET_CONTROL, wid.stat_txt, set_value='Done.', /append
            udp_src_path = dir_log+dir
            udp_src_base = filnam
            udp_src_file = udp_src_base+'.scl'
            udp_src_fname = concat_dir(udp_src_path, udp_src_file)
            udp_src_code = tki_udp_stc.scl
;---------------------------------------------------------------------------
;           Write SCL array to a file
;---------------------------------------------------------------------------
            IF NOT write_ascii(udp_src_fname, tki_udp_stc.scl, error=error) $
               THEN BEGIN
               xack, error, group=event.top, title='Warning'
               RETURN
            ENDIF

            CD, udp_src_path
;---------------------------------------------------------------------------
;           Compile the newly written SCL code
;---------------------------------------------------------------------------
            cmd = 'scc ' + udp_src_file + ' -o -l -m -t -sp200 -sw132'
            WIDGET_CONTROL, wid.stat_txt, $
               SET_VALUE=['', 'Compiling SCL code..', cmd], /append
            SPAWN, cmd, tmp
            WIDGET_CONTROL, wid.stat_txt, SET_VALUE=[tmp, 'Done.'], /append

;---------------------------------------------------------------------------
;           Compare the OBJ code to determine whether TKI_UDP_STC still valid
;---------------------------------------------------------------------------
            obj_file = concat_dir(udp_src_path, udp_src_base+'.obj')
            obj_ok = st_comp_obj(obj_file, tki_udp_stc)
            key_ok = compare_var(tki_udp_stc.key, global_key)
            IF NOT obj_ok OR NOT key_ok THEN BEGIN
               msg = ''
               IF NOT key_ok THEN $
                  msg = [msg, 'Global parameters have been changed.']
               IF NOT obj_ok THEN $
                  msg = [msg, 'Object code in imported UDP differ from new object code.']
               msg = [msg, '', $
                      'Imported UDP "expired". You must resimulate this UDP..']
               WIDGET_CONTROL, wid.stat_txt, SET_VALUE=msg, /append
               delvarx, tki_udp_stc
            ENDIF ELSE BEGIN
               WIDGET_CONTROL, wid.point_x, $
                  set_value=STRTRIM(STRING(tki_udp_stc.def_y, form='(f15.2)'), 2)
               WIDGET_CONTROL, wid.point_y, $
                  set_value=STRTRIM(STRING(-tki_udp_stc.def_z, form='(f15.2)'), 2)
            ENDELSE
            WIDGET_CONTROL, wid.scl_name, set_value=udp_src_fname
            WIDGET_CONTROL, wid.id_txt, set_value='(TBD)'
            WIDGET_CONTROL, wid.go_button, sensitive=1
            doc_stc = get_udp_head(concat_dir(udp_src_path, udp_src_file))
            st_update_field, doc_stc, wid
         ENDIF
      END

      'disp_udp': BEGIN
         IF N_ELEMENTS(tki_udp_stc) EQ 0 THEN RETURN
         show_struct, tki_udp_stc
      END

      'disp_spe': BEGIN
         IF N_ELEMENTS(tki_udp_stc) EQ 0 THEN RETURN
         TVLCT, r, g, b, /get
         st_sumer_win, group=event.top, tki_udp_stc=tki_udp_stc
         TVLCT, r, g, b
      END

      'quit': BEGIN
         xkill, event.top
         RETURN
      END

      'help': BEGIN
         widg_help, 'st_sumer', title='ST_SUMER Help', group=event.top, $
            font='9x15bold', subtopic='Overview'
      END

      'categ': BEGIN
         CASE (event.index) OF
            0: category = 'OP'
            1: category = 'CLB'
            2: category = 'TEST'
            ELSE:
         ENDCASE
      END

      'zone': BEGIN
         zone_id = event.index
      END

      'help_abt': BEGIN
         xack, about_msg, group=event.top, space=3, inst='OK', $
            title='About ST_SUMER'
      END

      'purge': BEGIN
         st_sumer_purge, wid
      END

      'disp_scl': BEGIN
         IF N_ELEMENTS(udp_src_code) EQ 0 THEN RETURN
         xtext, udp_src_code, title='SCL File: '+udp_src_file, /modal, $
            group=event.top, /no_print, /no_save
      END

      'disp_log': BEGIN
         log_file = concat_dir(udp_src_path, udp_src_base+'.log')
         IF test_open(log_file) THEN BEGIN
            log_str = rd_ascii2(log_file)
            xtext, log_str, title='Simulation Log File: '+log_file, $
               /modal, group=event.top,/no_print,/no_save,instr='Close'
         ENDIF ELSE BEGIN
            WIDGET_CONTROL, wid.stat_txt, set_value=$
               ['','Simulation log file does not exist!'], /append
         ENDELSE
      END

      'make_udp_stc': BEGIN
         WIDGET_CONTROL, wid.point_x, get_value=xx
         WIDGET_CONTROL, wid.point_y, get_value=yy
         temp = {init_x:FLOAT(xx(0)), init_y:FLOAT(yy(0))}
         xstruct, temp, /edit, accept='Accept', nx=1, /modal, $
            title='(values in arcsecs)', group=event.top, $
            instru='Initial Pointing Confirmation', status=status
         IF status EQ 0 THEN RETURN
         init_pt = {init_y:FLOAT(temp.init_x), init_z:-FLOAT(temp.init_y)}
         WIDGET_CONTROL, /hour
         st_mk_udp_stc, init_pt, event, error=error
      END

      ELSE:
   ENDCASE
   st_sumer_button, wid
   RETURN
END

PRO ST_SUMER, group=group, test=test, modal=modal
;---------------------------------------------------------------------------
;  Widget interface builder
;---------------------------------------------------------------------------
@st_sumer_com

   ON_ERROR, 2

   IF xregistered('st_sumer') THEN BEGIN
      MESSAGE, 'Another copy of ST_SUMER is already running...', /cont
      RETURN
   ENDIF

   IF !version.release LT '4.0' THEN BEGIN
      PRINT, 'Sorry, but this widget program requires IDL version 4.0 and up.'
      RETURN
   ENDIF

   IF N_ELEMENTS(udp_src_path) EQ 0 THEN BEGIN
      CD, curr=idl_dir
      udp_src_path = idl_dir
   ENDIF
   IF !version.os EQ 'vms' THEN BEGIN
      SPAWN, 'write sys$output f$getsyi("NODENAME")', node_name, $
         /noclisym, /nolognam
      node_name = STRTRIM(node_name(0), 2)
      has_db = (node_name EQ 'SUMOP1' OR node_name EQ 'SIRIUS' OR $
                node_name EQ 'LINSU1' OR node_name EQ 'VMS3')
   ENDIF ELSE BEGIN
      has_db = 0
      node_name = ''
   ENDELSE

   IF has_db THEN BEGIN
      has_db = sc_update_status(node_name, site=site)
      IF has_db EQ 0 THEN BEGIN
         msg = ['Current operations site is set to '+site+', and', $
                'access to the Oracle database system at this site', $
                'is temporarily denied. You cannot make and register',$
                'any UDP/study in this session.']
         xack, msg, instr='OK', title='ST_SUMER Message'
      ENDIF
   ENDIF

;---------------------------------------------------------------------------
;  Initialization
;---------------------------------------------------------------------------
   go_mode = 0
   need_pt = 1
   udp_stc_base = -1L
   st_init_x = 700.0
   st_init_y = 0.0
   IF has_db THEN sc_tki_init

   IF N_ELEMENTS(test) EQ 0 THEN testing = 0 ELSE testing = 1

   IF N_ELEMENTS(global_key) EQ 0 THEN BEGIN
      st_tki_init, error=error, has_db=has_db
      IF error NE '' THEN BEGIN
         delvarx, glo_par_file
         xack, error, group=group, /icon, title='No TKI Global File Found'
         RETURN
      ENDIF

      get_compiled_tki
      tki_init_main

;---------------------------------------------------------------------------
;     Build up the global key
;---------------------------------------------------------------------------
      OPENR, inpar_idx, glo_par_file, /GET_LUN
      global_key = tki_version
      FOR glo=0, 255 DO BEGIN
         READF, inpar_idx, paridx, InPar, InType
         global_key = [global_key, STRING(inpar)]
      ENDFOR
      FREE_LUN, inpar_idx
      global_key = BYTE(global_key(0:150))
   ENDIF

   about_msg = ['This Simulation Tool for  SUMER  was  developed  by  Liyun Wang', $
                '(Liyun.Wang.1@gsfc.nasa.gov) of NASA/GSFC and Dietmar Germerott', $
                '(GERMEROTT@linmpi.mpg.de)  of  MPAE/Lindau  for the joint', $
                'SOHO/SUMER project between NASA and ESA.']

   mk_dfont, lfont=lfont, bfont=bfont, tfont=tfont

   base = WIDGET_BASE(title='Simulation Tool  for  SUMER     (Version 1.8)', $
                      /column, mbar=mbar)
   file_bt = WIDGET_BUTTON(mbar, value='File', /menu, font=bfont, /track)
   open_scl = WIDGET_BUTTON(file_bt, value='Open SCL File', uvalue='open', $
                            font=bfont, /track)
   import_udp = WIDGET_BUTTON(file_bt, value='Import New UDP', font=bfont, $
                              uvalue='import', /track)
   purge_bt = WIDGET_BUTTON(file_bt, value='Purge UDP Files', $
                            uvalue='purge', font=bfont, /track)
   quit = WIDGET_BUTTON(file_bt, value='Quit', uvalue='quit', $
                        resource='QuitButton', font=bfont, /track)

   op_bt = WIDGET_BUTTON(mbar, value='Operations', /menu, font=bfont, /track)

   disp_bt = WIDGET_BUTTON(op_bt, value='Display SCL Code', $
                           uvalue='disp_scl', font=bfont, /track)

   udp_disp_bt = WIDGET_BUTTON(op_bt, value='Display UDP Structure', $
                               uvalue='disp_udp', font=bfont, /track)

   log_disp_bt = WIDGET_BUTTON(op_bt, value='Display Simulation Log', $
                               uvalue='disp_log', font=bfont, /track)

   udp_spec_bt = WIDGET_BUTTON(op_bt, value='Display Spectral Range', $
                               uvalue='disp_spe', font=bfont, /track)

   udp_stc_bt = WIDGET_BUTTON(op_bt, value='Simulate UDP', $
                              uvalue='make_udp_stc', font=bfont, /track)
   mkudp_bt = WIDGET_BUTTON(op_bt, value='Register UDP', $
                            uvalue='mkudp', font=bfont, /track)
   mkstd_bt = WIDGET_BUTTON(op_bt, value='Make Study', $
                            uvalue='mkstd', font=bfont, /track)

   help_bt = WIDGET_BUTTON(mbar, value='Help', /menu, font=bfont, /HELP, /trac)
   help_g = WIDGET_BUTTON(help_bt, value='General Help', font=bfont, $
                          uvalue='help', /track)
   help_abt = WIDGET_BUTTON(help_bt, value='About ST_SUMER', font=bfont, $
                            uvalue='help_abt', /track)

   tmp = WIDGET_BASE(base, /column, /frame)
   row = WIDGET_BASE(tmp, /row)
   lb = WIDGET_LABEL(row, value='SCL Code', font=lfont)
   scl_name = WIDGET_TEXT(row, value='', font=lfont, xsize=81)
   IF N_ELEMENTS(udp_src_file) NE 0 THEN $
      WIDGET_CONTROL, scl_name, set_value=udp_src_path+udp_src_file

   tmp = WIDGET_BASE(base, /column, /frame)
   tmp1 = WIDGET_LABEL(tmp, value='Operation Status', /align_center)
   stat_txt = WIDGET_TEXT(tmp, value='', ysize=10, xsize=88, $
                          font=lfont, /scroll, /track)

   tmp = WIDGET_BASE(base, /row, /frame)
   tmp1 = WIDGET_LABEL(tmp, value='    Detector:', font=lfont)
   IF NOT has_db THEN BEGIN
      wid_det = WIDGET_DROPLIST(tmp, value=['A', 'B'], font=lfont, $
                                uvalue='sel_det', /track)
      IF tki_current_det EQ 'B' THEN $
         WIDGET_CONTROL, wid_det, set_droplist=1
   ENDIF ELSE BEGIN 
      wid_det = WIDGET_LABEL(tmp, value=tki_current_det, font=lfont)
   ENDELSE

   tmp1 = WIDGET_LABEL(tmp, value='    Telemetry Rate (kB/s):', font=lfont)
   IF NOT has_db THEN BEGIN 
      wid_tm = WIDGET_DROPLIST(tmp, value=['10', '21'], font=lfont, $
                               uvalue='sel_tm', /track)
      IF tki_current_tm EQ 'H' THEN $
         WIDGET_CONTROL, wid_tm, set_droplist=1
   ENDIF ELSE BEGIN
      wid_tm = WIDGET_LABEL(tmp, value='', font=lfont)
      IF tki_current_tm EQ 'L' THEN $
         WIDGET_CONTROL, wid_tm, set_value='10' $
      ELSE $
         WIDGET_CONTROL, wid_tm, set_value='20'
      junk = WIDGET_LABEL(tmp, value='   (both are resetable via SC_SUMER)', $
                          font=lfont)
   ENDELSE

   double_base = WIDGET_BASE(base)

   msg_bs = WIDGET_BASE(double_base, /row, map=0, xpad=30, ypad=50)
   img_sz = 150
   IF N_ELEMENTS(image) EQ 0 THEN BEGIN
      look = loc_file('sohologo.gif', path=get_lib(), count=nf)
      IF nf GT 0 THEN BEGIN
         read_gif, look(0), image, r, g, b
         image = congrid(image, img_sz, img_sz)
         cur_min = MIN(image)
         cur_max = FIX(MAX(image))
         ncolor = !d.n_colors-1 < 255
         IF cur_max LT ncolor THEN BEGIN
            r(cur_max:ncolor) = 255
            g(cur_max:ncolor) = 255
            b(cur_max:ncolor) = 255
         ENDIF
         rgb = [[r(0:ncolor)], [g(0:ncolor)], [b(0:ncolor)]]
      ENDIF
   ENDIF
   IF N_ELEMENTS(image) NE 0 THEN $
      draw_id = WIDGET_DRAW(msg_bs, xsize=img_sz, ysize=img_sz, /button, $
                            uvalue='SOHO_LOGO')

   tmp = WIDGET_BASE(msg_bs, /column)
   lb = ['', '', '                        About ST_SUMER', '', about_msg]
   FOR i=0, N_ELEMENTS(lb)-1 DO $
      junk = WIDGET_LABEL(tmp, value=lb(i), font=lfont, /align_left)

   field_bs = WIDGET_BASE(double_base, /column, map=0)
   mode_label = WIDGET_LABEL(field_bs, value='', /align_center)

   tmp = WIDGET_BASE(field_bs, /column, /frame)

   row = WIDGET_BASE(tmp, /row)
   lb = WIDGET_LABEL(row, value='   Name:', font=lfont)
   udp_name = WIDGET_TEXT(row, value='', font=lfont, xsize=15, /edit, /track)

   junk = WIDGET_LABEL(row, value='   Category:', font=lfont)
   category = 'OP'
   udp_category = WIDGET_DROPLIST(row, value=['OP', 'CLB', 'TEST'], $
                                  uvalue='categ', font=lfont, /track)

   junk = WIDGET_LABEL(row, value='   ID:', font=lfont)
   id_txt = WIDGET_LABEL(row, value='(TBD)', font=lfont)

   junk = WIDGET_LABEL(row, value='  ', font=lfont)
   pt_seq_bt = WIDGET_BASE(row, /nonexclusive, map=0)
   junk = WIDGET_BUTTON(pt_seq_bt, value='Pointing Sequence', $
                            uvalue='pt_seq', font=lfont, /track)
   WIDGET_CONTROL, junk, set_button=need_pt

   row = WIDGET_BASE(tmp, /row)
   lb = WIDGET_LABEL(row, value='  Title:', font=lfont)
   udp_title = WIDGET_TEXT(row, value='', font=lfont, xsize=80, /edit, /track)

   row = WIDGET_BASE(tmp, /row)
   lb = WIDGET_LABEL(row, value='Purpose:', font=lfont)
   udp_purpose = WIDGET_TEXT(row, value='', font=lfont, xsize=80, $
                             ysize=5, /edit, /track)

   pt_base = WIDGET_BASE(tmp, /row)

;---------------------------------------------------------------------------
;  Pointing Zone List must be in the order of corresponding Zone ID
;---------------------------------------------------------------------------
   zone_id = 0
   zone_list = ['Quiet Sun - Cell', $
                'Quiet Sun - Network', $
                'Coronal Hole - Cell', $
                'Off Limb', $
                'Coronal Hole - Network', $
                'Active Sun', $
                'Very Active Sun', $
                'Limb']
   point_bs = WIDGET_BASE(pt_base, /row, map=0)
   junk = WIDGET_LABEL(point_bs, value='  Zone:', font=lfont)
   zone = WIDGET_DROPLIST(point_bs, value=zone_list, uvalue='zone', $
                          font=lfont, /track)

   junk = WIDGET_LABEL(pt_base, value='   Initial X:', font=lfont)
   point_x = WIDGET_TEXT(pt_base, value='', xsize=7, font=lfont, /edit, /track)
   junk = WIDGET_LABEL(pt_base, value='  Y:', font=lfont)
   point_y = WIDGET_TEXT(pt_base, value='', xsize=7, font=lfont, /edit, /track)
   WIDGET_CONTROL, point_x, set_value=$
      STRTRIM(STRING(st_init_x, form='(f15.2)'), 2)
   WIDGET_CONTROL, point_y, set_value=$
      STRTRIM(STRING(st_init_y, form='(f15.2)'), 2)
   junk = WIDGET_LABEL(pt_base, value=' (in arcsecs)', font=lfont)

   tmp = WIDGET_BASE(field_bs, /row)
   go_button = WIDGET_BUTTON(tmp, value=' GO! ', uvalue='go', $
                             font=bfont, /track)

   junk = WIDGET_BUTTON(tmp, value=' Cancel ', uvalue='cancel', $
                             font=bfont, /track)

   inst_txt = WIDGET_TEXT(base, /frame, value='', ysize=1, font=lfont, $
                         /track)

   wid = {open_scl:open_scl, import_udp:import_udp, log_disp_bt:log_disp_bt,$
          file_bt:file_bt, op_bt:op_bt, help_bt:help_bt, stat_txt:stat_txt, $
          mkudp_bt:mkudp_bt, mkstd_bt:mkstd_bt, scl_name:scl_name, $
          udp_disp_bt:udp_disp_bt, udp_name:udp_name, udp_title:udp_title,$
          udp_purpose:udp_purpose, udp_category: udp_category, $
          point_bs:point_bs, purge_bt:purge_bt, udp_spec_bt:udp_spec_bt, $
          field_bs:field_bs, msg_bs:msg_bs, mode_label:mode_label, $
          draw_id:draw_id, point_x:point_x, point_y:point_y, id_txt:id_txt,$
          pt_seq_bt:pt_seq_bt, inst_txt:inst_txt, go_button:go_button, $
          disp_bt:disp_bt, wid_det:wid_det, wid_tm:wid_tm}

   IF N_ELEMENTS(udp_src_file) NE 0 THEN BEGIN
      doc_stc = get_udp_head(concat_dir(udp_src_path, udp_src_file))
      st_update_field, doc_stc, wid
   ENDIF

   IF N_ELEMENTS(tki_udp_stc) NE 0 THEN BEGIN
      WIDGET_CONTROL, point_x, $
         set_value=STRTRIM(STRING(tki_udp_stc.def_y, form='(f15.2)'), 2)
      WIDGET_CONTROL, point_y, $
         set_value=STRTRIM(STRING(-tki_udp_stc.def_z, form='(f15.2)'), 2)
   ENDIF

   WIDGET_CONTROL, base, /realize, set_uvalue=wid

   IF N_ELEMENTS(draw_id) NE 0 THEN BEGIN
      st_sumer_logo, image, rgb, draw_id
   ENDIF

   WIDGET_CONTROL, msg_bs, map=1

   IF NOT has_db THEN BEGIN
      WIDGET_CONTROL, mkudp_bt, sensitive=0
      WIDGET_CONTROL, mkstd_bt, sensitive=0
   ENDIF
   st_sumer_button, wid

   xmanager, 'st_sumer', base, modal=modal, group=group
   IF N_ELEMENTS(idl_dir) NE 0 THEN CD, idl_dir
   IF NOT KEYWORD_SET(group) THEN xmanager

END

;---------------------------------------------------------------------------
; End of 'ST_SUMER.PRO'.
;---------------------------------------------------------------------------