source: trunk/SRC/buildinit.pro @ 327

;+
;
; @file_comments
; slightly modified version of cw_field ...
;
; @categories
;
; @param parent {in}{required}
; The ID of the parent widget.
;
; @keyword COLUMN
; Buttons will be arranged in the number of columns specified by this keyword.
;
; @keyword ROW
; Buttons will be arranged in the number of rows specified by this keyword.
;
; @keyword EVENT_FUNC
; The name of an optional user-supplied event function for buttons.
; This function is called with the return value structure whenever a
; button is pressed, and follows the conventions for user-written event functions.
;
; @keyword FLOATING
;
; @keyword INTEGER
;
; @keyword LONG
;
; @keyword STRING
;
; @keyword FONT
; The name of the font to be used for the button titles. If this keyword
; is not specified, the default font is used.
;
; @keyword FRAME
; Specifies the width of the frame to be drawn around the base.
;
; @keyword TITLE
; The title of the window
;
; @keyword UVALUE
; The user value to be associated with the widget.
;
; @keyword VALUE
;
; @keyword RETURN_EVENTS
;
; @keyword ALL_EVENTS
;
; @keyword FIELDFONT
;
; @keyword NOEDIT
;
; @keyword TEXT_FRAME
;
; @keyword XSIZE
; The width of the base
;
; @keyword YSIZE
; The height of the base.
;
; @keyword UNAME
; The user name to be associated with the widget.
;
; @returns
;
; @uses
;
; @restrictions
;
; @examples
;
; @history
;
; @version
; $Id$
;-
FUNCTION cw_field2, parent, COLUMN=column, ROW=row $
    , EVENT_FUNC=efun $
    , FLOATING=float, INTEGER=int, LONG=long, STRING=string $
    , FONT=labelfont, FRAME=frame, TITLE=title, UVALUE=uvalue $
    , VALUE=textvaluein $
    , RETURN_EVENTS=returnevents, ALL_EVENTS=allupdates $
    , FIELDFONT=fieldfont, NOEDIT=noedit, TEXT_FRAME=text_frame $
    , XSIZE=xsize, YSIZE=ysize, UNAME=uname
;   , FLOOR=vmin, CEILING=vmax
;
  compile_opt idl2, strictarrsubs
;
  resolve_routine, 'cw_field', /compile_full_file, /is_function
    ;   Examine our keyword list and set default values
    ;   for keywords that are not explicitly set.

    Column      = KEYWORD_SET(Column)
    Row         = 1 - Column
    AllEvents       = 1 - KEYWORD_SET(NoEdit)

    ; Enum Update { None, All, CRonly }
    Update      = 0
    IF KEYWORD_SET(AllUpdates) THEN Update  = 1
    IF KEYWORD_SET(ReturnEvents) THEN Update    = 2

    IF N_ELEMENTS(efun) LE 0 THEN efun = ''
    IF N_ELEMENTS(Title) EQ 0 THEN Title='Input Field:'
    TextValue = (N_ELEMENTS(TextValueIn) gt 0) ? TextValueIn : ''
    ; Convert non-string values to strings.
    if (SIZE(TextValue, /TNAME) ne 'STRING') then $
        TextValue = STRTRIM(TextValue,2)
    IF N_ELEMENTS(YSize) EQ 0 THEN YSize=1
    IF N_ELEMENTS(uname) EQ 0 THEN uname='CW_FIELD_UNAME'

    Type    = 0 ; string is default
    IF KEYWORD_SET(Float) THEN  Type    = 1
    IF KEYWORD_SET(Int) THEN    Type    = 2
    IF KEYWORD_SET(Long) THEN   Type    = 3

    ;   Don't allow multiline non string widgets
    if (Type ne 0) then $
        YSize=1
    YSize = YSize > 1

    ;   Build Widget

    Base    = WIDGET_BASE(parent, ROW=row, COLUMN=column, UVALUE=uvalue, $
            EVENT_FUNC='CW_FIELD_EVENT', $
            PRO_SET_VALUE='CW_FIELD_SET', $
            FUNC_GET_VALUE='CW_FIELD_GET', $
            FRAME=Frame, UNAME=uname )
    FOR i = 0, n_elements(title)-1 DO $
      Label   = WIDGET_LABEL(Base, VALUE = Title[i], FONT = LabelFont, $
                             UNAME = uname+'_LABEL', /align_left)
    Text    = WIDGET_TEXT(Base, VALUE = TextValue, $
            XSIZE=XSize, YSIZE=YSize, FONT=FieldFont, $
            ALL_EVENTS=AllEvents, $
            EDITABLE=(AllEvents AND TYPE EQ 0), $
            FRAME=Text_Frame , $
            UNAME=uname+'_TEXT')

            ; NO_ECHO=(AllEvents AND (TYPE NE 0)))

    ; Save our internal state in the first child widget
    State   = {     $
    efun: efun,         $
    TextId:Text,        $
    Title:Title,        $
    Update:Update,      $
    Type:Type       $
    }
    WIDGET_CONTROL, WIDGET_INFO(Base, /CHILD), SET_UVALUE=State, /NO_COPY
    RETURN, Base
  END
;
;
;+
;
; @file_comments
; get back the ids of the cw_field widgets
;
; @categories
;
; @param EVENT
;
; @returns
;
; @uses
;
; @restrictions
;
; @examples
;
; @history
;
; @version
; $Id$
;
;-
PRO printerdef_event, event
;
  compile_opt idl2, strictarrsubs
;
  widget_control, event.id, get_uvalue = cwids
  IF size(cwids, /n_dimensions) EQ 1 THEN cwids = reform(cwids, 3, 1)
help, cwids
  dims = size(cwids, /dimensions)
help,  dims
print,  dims
  results = strarr(dims)
  FOR i = 0, dims[1]-1 DO BEGIN
    widget_control, cwids[0, i], get_value = res & results[0, i] = res
    widget_control, cwids[1, i], get_value = res & results[1, i] = res
    widget_control, cwids[2, i], get_value = res & results[2, i] = res
  ENDFOR
  nothing = where(results EQ '', count)
  IF count NE 0 THEN BEGIN
    nothing = dialog_message('Some of the text box are still empty', dialog_parent = event.top, /information)
    return
  ENDIF
; now we give the result to buildinit.pro by using the pointer uvalue
   widget_control, event.top, get_uvalue = ptresult
   *ptresult = temporary(results)
; we destroy the widget
   widget_control, event.top, /destroy
  RETURN
END
;
;
;+
;
; @file_comments
; get back the ids of the cw_field widgets
;
; @categories
;
; @param EVENT
;
; @returns
;
; @uses
;
; @restrictions
;
; @examples
;
; @history
;
; @version
; $Id$
;
;-
PRO papsize_event, event
;
  compile_opt idl2, strictarrsubs
;
  widget_control, event.id, get_uvalue = uvalue
  IF uvalue[0] NE 'ok' THEN return
  idist = widget_info(event.top, find_by_uname = 'list')
  id = widget_info(idist, /list_select)
  widget_control, idist, get_uvalue = selected
  selected = selected[id]
  selected = strsplit(selected, /extract)
; now we give the result to buildinit.pro by using the pointer uvalue
   widget_control, event.top, get_uvalue = ptresult
   *ptresult = [float(selected[3]), float(selected[4])]
; we destroy the widget
   widget_control, event.top, /destroy
  RETURN
END
;
;+
; @file_comments
; now we give the answer to buildinit.pro by using the pointer uvalue
;
; @categories
;
; @param event 
;
; @returns
;
; @uses
;
; @restrictions
;
; @examples
;
; @history
;
; @version
; $Id$
;
;-
PRO xask_event, event
;
  compile_opt idl2, strictarrsubs
;
   widget_control, event.top, get_uvalue = ptranswer
   *ptranswer = event.value
; we destroy the widget
   widget_control, event.top, /destroy
  RETURN
END
;
;+
;
; @file_comments
;
; @categories
;
; @keyword _EXTRA
; Used to pass keywords
;
; @returns
;
; @uses
;
; @restrictions
;
; @examples
;
; @history
;
; @version
; $Id$
;
;-
FUNCTION xask, _EXTRA=ex
;
  compile_opt idl2, strictarrsubs
;
  base = widget_base()
  field = cw_field2(base, /frame, /return_events, /column, _extra = ex)
  ptranswer = ptr_new(/allocate_heap)
; we realize the widget and wait for an answer
  widget_control, base, /realize, set_uvalue = ptranswer
  xmanager, 'xask', base
; we get the answer
  answer = *ptranswer
; we freeing the pointer
  ptr_free, ptranswer
  RETURN, answer
END
;
;+
;
; @file_comments
;
; @categories
;
; @keyword TITLE
; The title of the window
;
; @keyword NOMARK
;
; @keyword NOWRITE
;
; @returns
;
; @uses
;
; @restrictions
;
; @examples
;
; @history
;
; @version
; $Id$
;
;-
FUNCTION getdir, TITLE=title, NOMARK=nomark, NOWRITE=nowrite
;
  compile_opt idl2, strictarrsubs
;

  REPEAT BEGIN
    dir = dialog_pickfile(/directory, /must_exist, title = title)
; make sure dir is ok, check read/write access and directory separator mark
    dir = file_search(dir, /test_directory, /test_read $
                      , test_write = 1 - keyword_set(nowrite) $
                      , mark_directory = 1 - keyword_set(nomark))
    dir = dir[0]
  ENDREP UNTIL dir NE ''

  RETURN, dir
END
;
;
;+
;
; @file_comments
;
; @categories
;
; @returns
;
; @uses
;
; @restrictions
;
; @examples
;
; @history
;
; @version
; $Id$
;
;-
PRO buildinit
;
  compile_opt idl2, strictarrsubs
;
  IF fix(strmid(!version.release, 0, 1)) LT 6 THEN BEGIN
    print, '                   *** ***** ***'
    print, '                   *** ERROR ***'
    print, '                   *** ***** ***'
    print, 'This version of SAXO needs at least IDL version 6.0'
    print, '                   *** ***** ***'
    print, '                   *** ERROR ***'
    print, '                   *** ***** ***'
    return
  ENDIF
  IF lmgr(/demo) EQ 1 THEN BEGIN
    print, 'impossible to use buildinit in demo mode'
    return
  ENDIF
;
  init = [';' $
          , '; This is the initialisation file.' $
          , '; it defines the !path and the defaut values of some of the common variables' $
          , ';' $
          , '; this is supposed to speed-up IDL...' $
          , ';' $
          , '; a = fltarr(1000,1000,100)' $
          , '; a = 0' $
          , ';' $
          , '; path definition' $
          , ';']
;
; define "myIDL" directory
  myIDL = getdir(title = 'Select the home directory (my IDL)', /nomark)
; define "SAXO" directory
  saxodir = getdir(title = 'Select SAXO directory', /nomark, /nowrite)
; define the !path
  init = [init, '!path = expand_path(''+'' + '''+myIDL+''') $' $
          , '      + path_sep(/search_path) + expand_path(''+'' + '''+saxodir+''') $' $
          , '      + path_sep(/search_path) + expand_path(''+'' + !dir)']
;
; should we keep the compatibility with the old version?
;
  yes = dialog_message(['shall we keep the compatibility' $
                        , 'with the old version ?'], /question, /default_no)
  yes = strlowcase(yes)

  init = [init $
          , ';' $
          , '; compatibility with the old version' $
          , ';' $
          , 'keep_compatibility, ' + strtrim(fix(yes EQ 'yes'), 2)]
;
; define all the commons
;
  init = [init $
          , ';' $
          , '; define all the commons' $
          , ';' $
          , '@all_cm']
;
; define default directories
;
  init = [init $
          , ';' $
          , '; define default directories' $
          , ';' $
          , 'homedir = isadirectory('''+myIDL+'/'', title = ''Select the default HOME directory'')']
  iodir = getdir(title = 'Select the default IO directory')
  init = [init $
          , 'iodir = isadirectory('''+iodir+''', title = ''Select the default IO directory'')']
  psdir = getdir(title = 'Select the default postscripts directory')
  init = [init $
          , 'psdir = isadirectory('''+psdir+''', title = ''Select the default postscripts directory'')']
  imagedir = getdir(title = 'Select the default images directory')
  init = [init $
          , 'imagedir = isadirectory('''+imagedir+''', title = ''Select the default images directory'')']
  animdir = getdir(title = 'Select the default animations directory')
  init = [init $
          , 'animdir = isadirectory('''+animdir+''', title = ''Select the default animations directory'')']
;
; number of printer
;
  ptnumb = xask(title = 'Number of accessible printers', value = 0, /long)
;
; define all the printer parameters
;
  init = [init $
          , ';' $
          , '; define printer parameters' $
          , ';' ]
;
  IF ptnumb NE 0 THEN BEGIN
    base = widget_base(/column, /frame)
    cwids = lonarr(3, ptnumb)
    FOR i = 0, ptnumb-1 DO BEGIN
      subbase = widget_base(base, /row)
      cwids[0, i] = cw_field(subbase, /string $
                             , Title = 'printer_human_names['+strtrim(i, 2)+'] = ')
      cwids[1, i] = cw_field(subbase, /string $
                             , Title = 'printer_machine_names['+strtrim(i, 2)+'] = ')
      cwids[2, i] = cw_field(subbase, /string, value = '\lpr -P' $
                             , Title = 'print_command['+strtrim(i, 2)+'] = ')
    ENDFOR
    trash = widget_button(base, value = 'ok', uvalue = cwids)
    ptresult = ptr_new(/allocate_heap)
; we realize the widget and wait for an answer
    widget_control, base, /realize, set_uvalue = ptresult
    xmanager, 'printerdef', base
;
    init = [init $
            , 'printer_human_names = strarr('+strtrim(ptnumb, 2)+')' $
            , 'printer_machine_names = strarr('+strtrim(ptnumb, 2)+')' $
            , 'print_command = strarr('+strtrim(ptnumb, 2)+')']
    FOR i = 0, ptnumb-1 DO BEGIN
      init = [init $
              , 'printer_human_names['+strtrim(i, 2)+'] = ''' $
              + (*ptresult)[0, i]+'''' $
              , 'printer_machine_names['+strtrim(i, 2)+'] = ''' $
              + (*ptresult)[1, i]+'''' $
              , 'print_command['+strtrim(i, 2)+'] = ''' $
              + (*ptresult)[2, i]+'''']
    ENDFOR
; we freeing the pointer
    ptr_free, ptresult
  ENDIF ELSE BEGIN
    init = [init $
            , 'printer_human_names = ''''' $
            , 'printer_machine_names = ''''' $
            , 'print_command = ''''']
  ENDELSE
;
; Colors
;
  init = [init $
          , ';' $
          , '; colors ...' $
          , ';' $
          , 'device, decomposed = 0' $
          , 'device, retain = 2']
;
; default color tables
;
  loadct, get_names = names

  ntables = 40
  title = ['               --------------------------------------               ' $
           , '               --- Choose the default color table ---               ' $
           , '               --------------------------------------               ', '']
; the following lines come from loadct procedure...
  nlines = (ntables + 2) / 3    ;# of lines to print
  nend = nlines - ((nlines*3) - ntables)
  for i = 0, nend-1 do $        ;Print each line
    title = [title $
             , string(format = "(i2,'- ',a17, 3x, i2,'- ',a17, 3x, i2,'- ',a17)" $
                      , i, names[i], i+nlines, names[i+nlines] $
                      , i+2*nlines < (ntables-1) $
                      , names[i+2*nlines < (ntables-1)])]
  if (nend lt nlines) then begin
    for i = nend, nlines-1 do $
      title = [title $
               , string(format = "(i2,'- ',a17, 3x, i2,'- ',a17)", $
                        i, names[i], i+nlines, names[i+nlines])]
  ENDIF
  title = [title, '']
  ctnumb = 0 > xask(title = title, value = 39, /long) < 39
;
  init = [init $
          , 'lct, '+strtrim(ctnumb, 2)]
;
; postscript position
;
  yes = dialog_message(['the default postscript position', 'is landscape?'], /question)
  init = [init $
          , ';' $
          , '; postscript parameters ...' $
          , ';' $
          , 'key_portrait = '+strtrim(fix(strlowcase(yes) NE 'yes'), 2)]
;
; paper size
;
  list = ['a0           33.0556    46.7778    83.9611   118.816' $
          , 'a1           23.3889    33.0556    59.4078   83.9611' $
          , 'a2           16.5278    23.3889    41.9806   59.4078' $
          , 'a3           11.6944    16.5278    29.7039   41.9806' $
          , 'a4           8.26389    11.6944    20.9903   29.7039' $
          , 'a5           5.84722    8.26389    14.8519   20.9903' $
          , 'a6           4.125      5.84722    10.4775   14.8519' $
          , 'a7           2.91667    4.125      7.40833   10.4775' $
          , 'a8           2.05556    2.91667    5.22111   7.40833' $
          , 'a9           1.45833    2.05556    3.70417   5.22111' $
          , 'a10          1.02778    1.45833    2.61056   3.70417' $
          , 'b0           39.3889    55.6667    100.048   141.393' $
          , 'b1           27.8333    39.3889    70.6967   100.048' $
          , 'b2           19.6944    27.8333    50.0239   70.6967' $
          , 'b3           13.9167    19.6944    35.3483   50.0239' $
          , 'b4           9.84722    13.9167    25.0119   35.3483' $
          , 'b5           6.95833    9.84722    17.6742   25.0119' $
          , 'archA        9          12         22.86     30.48' $
          , 'archB        12         18         30.48     45.72' $
          , 'archC        18         24         45.72     60.96' $
          , 'archD        24         36         60.96     91.44' $
          , 'archE        36         48         91.44     121.92' $
          , 'flsa         8.5        13         21.59     33.02' $
          , 'flse         8.5        13         21.59     33.02' $
          , 'halfletter   5.5        8.5        13.97     21.59' $
          , 'note         7.5        10         19.05     25.4' $
          , 'letter       8.5        11         21.59     27.94' $
          , 'legal        8.5        14         21.59     35.56' $
          , '11x17        11         17         27.94     43.18' $
          , 'ledger       17         11         43.18     27.94']
  base = widget_base(/column)
  trash = widget_label(base, value = '--- Select the paper size ---')
  trash = widget_label(base, value = '')
  trash = widget_label(base, value = 'PAPERSIZE    X inches   Y inches   X cm      Y cm', /align_left, uvalue = 'dummy')
  listid = widget_list(base, value = list, uvalue = list, uname = 'list', ysize = n_elements(list) < 15)
  widget_control, listid, set_list_select = 4
  trash = widget_button(base, value = 'ok', uvalue = 'ok')
  ptresult = ptr_new(/allocate_heap)
; we realize the widget and wait for an answer
  widget_control, base, /realize, set_uvalue = ptresult
  xmanager, 'papsize', base
;
  papsize = *ptresult
; we freeing the pointer
  ptr_free, ptresult
  init = [init $
          , 'page_size = [' + strtrim(papsize[0], 2) $
          + ', ' +strtrim(papsize[1], 2) + ']']
;
; window size
;
  title = ['         --- Size of the Window ---', '' $
           , 'The size of window (in cm) is given by:' $
           , 'windowsize_scale * page_size, with ' $
           , 'page_size = [' + strtrim(papsize[0], 2)+ ', ' +strtrim(papsize[1], 2) + ']' $
           , 'Please select a value for windowsize_scale ']
  wsize_scale = xask(title = title, value = 1, /floating)
  init = [init, 'windowsize_scale = ' + strtrim(wsize_scale, 2)]

;
; postscript archiving...
;
  title = ['     --- Select the default postscript archiving method ---', ''$
           , '0 : never archive the postscript' $
           , '1 : always archive the postscript when printed' $
           , '2 : ask if the postscript must be archived each time its printed', '']
  archive_ps = 0 > xask(title = title, value = 0, /long) < 2
  init = [init $
          , 'archive_ps = '+strtrim(archive_ps, 2) $
          , ';' $
          , ';========================================================' $
          , '; end of the part that should be modified by the users...' $
          , ';========================================================' $
          , ';' $
          , '; if needed, keep compatibility with the old version' $
          , ';' $
          , '@updateold' $
          , ';' ]

  filename = xask(title = ['name of the init file', '(written in homedir: ' + myIDL + ')'], value = 'init.pro', /string)
  journal, myIDL + '/' + filename
  FOR i = 0, n_elements(init)-1 DO journal, init[i]
  journal

  RETURN
END