mg_dlm__define.pro (dist

; docformat = 'rst'

;+
; Class representing a DLM made from a list of wrapper routines.
; 
; :Examples:
;    This example creates a DLM to access a few internal IDL routines, but 
;    this class could be used to access any C routines. The internal routines
;    are::
;
;       char *IDL_OutputFormatFunc(int type)
;       int IDL_OutputFormatLenFunc(int type)
;       int IDL_TypeSizeFunc(int type)
;       char *IDL_TypeNameFunc(int type)
;       void IDL_TTYReset(void)
;
;    To create a DLM of wrapper to access these routines, first create a 
;    `MG_DLM` object with at least the `BASENAME` property::
;
;       f = mg_dlm(basename='format_example', $
;                  name='FORMAT_EXAMPLE', $
;                  description='Example of using dist_tools bindings', $
;                  version='1.0', source='dist_tools')
;
;    Next, add the prototypes of the routines requiring wrappers::
; 
;       f->addRoutineFromPrototype, 'char *IDL_OutputFormatFunc(int type)'
;       f->addRoutineFromPrototype, 'int IDL_OutputFormatLenFunc(int type)'
;       f->addRoutineFromPrototype, 'int IDL_TypeSizeFunc(int type)'
;       f->addRoutineFromPrototype, 'char *IDL_TypeNameFunc(int type)' 
;       f->addRoutineFromPrototype, 'void IDL_TTYReset(void)'
;
;    Alternatively, these prototype definitions could be placed in a file and
;    specified with the `addRoutinesFromHeaderFile` method.
;
;    Next, a wrapper to access the value of a `#define` constant is also 
;    created::
; 
;       f->addPoundDefineAccessor, 'IDL_TYP_UNDEF', type=3L
;
;    The `write` method writes the `.c` and `.dlm` files::
;
;       f->write
;
;    The `build` method invokes the compiler and linker to make the shared 
;    object file containing the wrappers::
;
;       f->build, /show_all_output
;
;    The `register` method registers the DLM to be accessed in the current
;    IDL session::
;
;       f->register
;
;    The `MG_DLM` object is no longer needed::
;
;       obj_destroy, f
;
;    These commands are in a main-level program at the end of the file. To run 
;    them do::
;
;       IDL> .run mg_dlm__define
;
;    Then you have access to the routines from IDL::
;
;       IDL> print, idl_outputformatfunc(5)
;       %#16.8g
;       IDL> print, idl_outputformatlenfunc(5)
;                 16
;       IDL> print, idl_typesizefunc(5)
;                  8
;       IDL> print, idl_typenamefunc(5)
;       DOUBLE
;       IDL> print, get_idl_typ_undef()
;                  0
;
; :Properties:
;    basename
;       basename (including possible path) for `.c` and `.dlm` files
;    name
;       name in DLM header
;    description
;       description in DLM header
;    version
;       version in DLM header
;    source
;       source in DLM header
;    build_date
;       date in DLM header
;-


;+
; Set properties.
;-
pro mg_dlm::setProperty, basename=basename, $
                         name=name, description=description, version=version, $
                         source=source, build_date=build_date
  compile_opt strictarr
  
  if (n_elements(basename) gt 0L) then self.basename = basename
  if (n_elements(name) gt 0L) then self.name = name
  if (n_elements(description) gt 0L) then self.description = description
  if (n_elements(version) gt 0L) then self.version = version
  if (n_elements(source) gt 0L) then self.source = source
  if (n_elements(build_date) gt 0L) then self.build_date = build_date
end


;+
; Get properties.
;-
pro mg_dlm::getProperty, name=name
  compile_opt strictarr
  
  if (arg_present(name)) then name = self.name
end


;+
; Returns the `.c` file text as a string.
; 
; :Private:
;
; :Returns:
;    string
;-
function mg_dlm::output_c
  compile_opt strictarr

  ; header
  output = string(systime(), format='(%"// Generated by dist_tools: %s")')
  
  output += mg_newline()
  
  ; system includes
  foreach i, self.systemIncludes do begin
    output += string(mg_newline(), i, format='(%"%s#include <%s>")')    
  endforeach
  
  output += mg_newline()
  
  ; user includes  
  foreach i, self.userIncludes do begin
    output += string(mg_newline(), i, format='(%"%s#include \"%s\"")')    
  endforeach
  
  output += mg_newline()
  
  ; MG_GET_TYPE definitions
  idltypes_filename = filepath('mg_get_idltypes.c', root=mg_src_root())
  nlines = file_lines(idltypes_filename)
  lines = strarr(nlines)
  openr, lun, idltypes_filename, /get_lun
  readf, lun, lines
  free_lun, lun
  
  output += mg_strmerge(lines)
  
  output += mg_newline()
  output += mg_newline()
  
  ; routine bindings
  foreach r, self.routines do begin
    output += r->output()
    output += mg_newline()
    output += mg_newline()
  endforeach
  
  output += mg_newline()
  
  ; IDL_Load

  output += string(mg_newline(), format='(%"int IDL_Load(void) {%s")')
  output += string(self.name, mg_newline(), mg_newline(), $
                   format='(%"  if (!(msg_block = IDL_MessageDefineBlock(\"%s\", IDL_CARRAY_ELTS(msg_arr), msg_arr))) { return IDL_FALSE; } %s%s")') 
    
  if (self.nFunctions gt 0L) then begin
    output += string(mg_newline(), format='(%"  static IDL_SYSFUN_DEF2 function_addr[] = {%s")')
  
    foreach r, self.routines do begin
      r->getProperty, name=name, $
                      prefix=prefix, $
                      cprefix=cprefix, $
                      return_type=returnType, $
                      n_min_parameters=nMinParameters, $
                      n_max_parameters=nMaxParameters
      if (returnType eq 0L) then continue
      output += string(cprefix, $
                       name, $
                       strupcase(prefix + name), $
                       nMinParameters, $
                       nMaxParameters, $
                       mg_newline(), $
                       format='(%"    { %s_%s, \"%s\", %d, %d, 0, 0 },%s")')
    endforeach  
    output += string(mg_newline(), format='(%"  };%s")')

    output += mg_newline()
  endif

  if (self.nProcedures gt 0L) then begin
    output += string(mg_newline(), format='(%"  static IDL_SYSFUN_DEF2 pro_addr[] = {%s")')
  
    foreach r, self.routines do begin
      r->getProperty, name=name, $
                      prefix=prefix, $
                      cprefix=cprefix, $
                      return_type=returnType, $
                      n_min_parameters=nMinParameters, $
                      n_max_parameters=nMaxParameters
      if (returnType ne 0L) then continue
      output += string(cprefix, $
                       name, $
                       strupcase(prefix + name), $
                       nMinParameters, $
                       nMaxParameters, $
                       mg_newline(), $
                       format='(%"    { (IDL_SYSRTN_GENERIC) %s_%s, \"%s\", %d, %d, 0, 0 },%s")')
    endforeach  
    output += string(mg_newline(), format='(%"  };%s")')

    output += mg_newline()
  endif
  
  func_reg = 'IDL_SysRtnAdd(function_addr, TRUE, IDL_CARRAY_ELTS(function_addr))'
  pro_reg = 'IDL_SysRtnAdd(pro_addr, FALSE, IDL_CARRAY_ELTS(pro_addr))'
  
  output += string(self.nFunctions gt 0L ? func_reg : '', $
                   (self.nFunctions gt 0L && self.nProcedures gt 0L) ? ' && ' : '', $
                   self.nProcedures gt 0L ? pro_reg : '', $
                   format='(%"  return %s%s%s;")')

  output += string(mg_newline(), format='(%"%s}")')
  
  return, output
end


;+
; Returns the `.dlm` file text as a string.
; 
; :Private:
;
; :Returns:
;    string
;-
function mg_dlm::output_dlm
  compile_opt strictarr
  
  output = ''
  
  ; header
  output += string(self.name, mg_newline(), format='(%"MODULE %s%s")')
  if (self.description ne '') then begin
    output += string(self.description, mg_newline(), format='(%"DESCRIPTION %s%s")')
  endif
  if (self.version ne '') then begin
    output += string(self.version, mg_newline(), format='(%"VERSION %s%s")')
  endif
  if (self.source ne '') then begin
    output += string(self.source, mg_newline(), format='(%"SOURCE %s%s")')
  endif
  output += string(self.build_date, mg_newline(), format='(%"BUILD_DATE %s%s")')
  
  output += mg_newline()
  
  ; routine definitions
  foreach r, self.routines do begin
    r->getProperty, name=name, $
                    prefix=prefix, $
                    return_type=returnType, $
                    n_min_parameters=nMinParameters, $
                    n_max_parameters=nMaxParameters
    format = string(strlen(name) > 30, format='(%"(\%\"\%-10s \%-%ds \%4d \%4d\%s\")")')
    output += string(returnType eq 0L ? 'PROCEDURE' : 'FUNCTION', $                     
                     strupcase(prefix + name), $
                     nMinParameters, $
                     nMaxParameters, $
                     mg_newline(), $
                     format=format)                    
  endforeach
  
  return, output
end


;+
; Writes the `.c` and `.dlm` files to the `BASENAME` location.
;-
pro mg_dlm::write
  compile_opt strictarr

  output = [self->output_c(), self->output_dlm()]
  ext = ['.c', '.dlm']
  
  for i = 0, 1 do begin
    openw, lun, self.basename + ext[i], /get_lun
    printf, lun, output[i]
    free_lun, lun
  endfor
end


;+
; Compiles and links the DLM.
;
; :Keywords:
;    _extra : in, optional, type=keywords
;       keywords to the `MG_MAKE_DLL` routine
;-
pro mg_dlm::build, _extra=e
  compile_opt strictarr
    
  if (n_elements(self.includeDirs) gt 0L) then begin
    includes = strjoin('-I"' + self.includeDirs->toArray() + '"', ' ')
  endif else includes = ''

  if (n_elements(self.libFiles) gt 0L) then begin
    if (n_elements(self.libDirs) gt 0L) then begin
      libs = strjoin('-L' + self.libDirs->toArray(), ' ')
    endif else libs = ''
    
    libs += ' '
    
    if (n_elements(self.libFiles) gt 0L) then begin
      libs += strjoin('-l' + self.libFiles->toArray(), ' ')
    endif
  endif else libs = ''
  
  mg_make_dll, self.basename, $
               extra_cflags=includes, extra_lflags=libs, $
               _extra=e
end


;+
; Register the DLM.
;-
pro mg_dlm::register
  compile_opt strictarr
  
  dlm_register, self.basename + '.dlm'
end


;+
; Load the DLM.
;-
pro mg_dlm::load
  compile_opt strictarr
  
  dlm_load, self.basename
end


;+
; Add an include file to the DLM.
;
; :Params:
;    name : in, required, type=string
;       name of the include file, including the .h
;
; :Keywords:
;    system : in, optional, type=boolean
;       set to indicate that the include is a system include file, i.e., that
;       there should be <>'s around the name instead of ""'s
;    header_directory : in, optional, type=string
;       filepath to include file, if not in a standard location
;    lib_directory : in, optional, type=string
;       directory of lib files
;    lib_files : in, optional, type=strarr
;       library files
;-
pro mg_dlm::addInclude, name, system=system, $
                        header_directory=headerDir, $
                        lib_directory=libDir, lib_files=libFiles
  compile_opt strictarr
  
  if (keyword_set(system)) then begin
    if (total(self.systemIncludes eq name, /integer) eq 0L) then begin
      self.systemIncludes->add, name
    endif
  endif else begin
    found = 0B
    foreach n, name do begin
      if (total(self.userIncludes eq n, /integer) eq 0L) then begin
        self.userIncludes->add, n
      endif else found = 1B
    endforeach

    if (~found) then begin
      if (n_elements(headerDir) gt 0L) then self.includeDirs->add, expand_path(headerDir)
      if (n_elements(libDir) gt 0L) then begin
        _libDir = libDir
        for d = 0L, n_elements(libDir) - 1L do begin
          _libDir[d] = expand_path(libDir[d])
        endfor
        self.libDirs->add, _libDir, /extract
      endif
      if (n_elements(libFiles) gt 0L) then self.libFiles->add, libFiles, /extract
    endif
  endelse
end


;+
; Adds a wrapper routine to the DLM.
;
; :Params:
;    routine : in, required, type=routine object
;       routine object to add to the DLM
;-
pro mg_dlm::addRoutine, routine
  compile_opt strictarr

  self.routines->add, routine
  routine->getProperty, return_type=returnType
  if (returnType eq 0L) then self.nProcedures++ else self.nFunctions++
end


;+
; Adds a wrapper routine defined by a prototype given by a string to the DLM.
;
; :Params:
;    proto : in, required, type=string
;       prototype of the routine to add to the DLM
;-
pro mg_dlm::addRoutineFromPrototype, proto
  compile_opt strictarr
  
  name = mg_parse_cprototype(proto, params=params, return_type=return_type)

  r = mg_routinebinding(name=name, return_type=return_type, prototype=proto)
  
  for i = 0L, n_elements(params) - 1L do begin
    param_type = mg_parse_cdeclaration(params[i], $
                                       pointer=pointer, array=array, $
                                       device=device)
    if (param_type ne 0) then begin
      r->addParameter, type=param_type, $
                       pointer=pointer, array=array, device=device, $
                       prototype=params[i]
    endif
  endfor

  self->addRoutine, r
end


;+
; Adds wrapper routines from a header file.
;
; :Params:
;    filename : in, required, type=string
;       header filename
;-
pro mg_dlm::addRoutinesFromHeaderFile, filename
  compile_opt strictarr
  on_error, 2
  
  if (~file_test(filename)) then message, 'header file not found'
  
  nlines = file_lines(filename)
  prototypes = strarr(nlines)
  openr, lun, filename, /get_lun
  readf, lun, prototypes
  free_lun, lun
  
  foreach p, prototypes do begin
    ; if not an empty line or a comment then add a binding for the line
    if (strtrim(p, 2) ne '' && strmid(strtrim(p, 2), 0, 2) ne '//') then begin
      self->addRoutineFromPrototype, p
    endif
  endforeach
end


;+
; Adds wrapper routine to access the given `#define` value.
;
; :Params:
;    name : in, required, type=string
;       name of `#define`
;
; :Keywords:
;    type : in, required, type=long
;       `SIZE` type code for `#define` value
;-
pro mg_dlm::addPoundDefineAccessor, name, type=type
  compile_opt strictarr

  self->addRoutine, mg_routinePoundDefineAccessor(name=name, return_type=type)
end


;+
; Free resources.
;-
pro mg_dlm::cleanup
  compile_opt strictarr
  
  obj_destroy, [self.routines, $
                self.systemIncludes, self.userIncludes, $
                self.includeDirs, self.libDirs, self.libFiles]
end


;+
; Create the DLM object.
;-
function mg_dlm::init, _extra=e
  compile_opt strictarr

  self.systemIncludes = list()
  self.userIncludes = list()
  self.routines = list()
  self.includeDirs = list()
  self.libDirs = list()
  self.libFiles = list()
    
  ; required include files
  self.systemIncludes->add, 'stdio.h'
  self.userIncludes->add, 'idl_export.h'

  self.source = 'Generated by dist_tools'
  self.build_date = systime()
  
  self->setProperty, _extra=e
  
  return, 1
end


;+
; Define instance variables.
;
; :Fields:
;    basename
;       basename (including possible path) for `.c` and `.dlm` files
;    name
;       name in DLM header
;    description
;       description in DLM header
;    version
;       version in DLM header
;    source
;       source in DLM header
;    build_date
;       date in DLM header
;    routines
;       `LIST` of routine objects
;    nFunctions
;       the number of functions added to the DLM
;    nProcedures
;       the number of procedures added to the DLM
;    systemIncludes
;       `LIST` of system include names
;    userIncludes
;       `LIST` of user include names
;    includeDirs
;       `LIST` of include directories
;    libDirs
;       `LIST` of lib directories
;    libFiles
;       `LIST` of lib files
;-
pro mg_dlm__define
  compile_opt strictarr
  
  define = { mg_dlm, $
             basename: '', $
             name: '', $
             description: '', $
             version: '', $
             source: '', $
             build_date: '', $
             routines: obj_new(), $
             nFunctions: 0L, $
             nProcedures: 0L, $
             systemIncludes: obj_new(), $
             userIncludes: obj_new(), $
             includeDirs: obj_new(), $
             libDirs: obj_new(), $
             libFiles: obj_new() $
           }
end


; main-level example

; This example creates a DLM to access a few internal routines:
;
;   char *IDL_OutputFormatFunc(int type)
;   int IDL_OutputFormatLenFunc(int type)
;   int IDL_TypeSizeFunc(int type)
;   char *IDL_TypeNameFunc(int type)
;   void IDL_TTYReset(void)

f = mg_dlm(basename='format_example', $
           name='FORMAT_EXAMPLE', $
           description='Example of using dist_tools bindings', $
           version='1.0', source='dist_tools')

f->addRoutineFromPrototype, 'char *IDL_OutputFormatFunc(int type)'
f->addRoutineFromPrototype, 'int IDL_OutputFormatLenFunc(int type)'
f->addRoutineFromPrototype, 'int IDL_TypeSizeFunc(int type)'
f->addRoutineFromPrototype, 'char *IDL_TypeNameFunc(int type)' 
f->addRoutineFromPrototype, 'void IDL_TTYReset(void)'
f->addRoutineFromPrototype, 'IDL_LONG64 IDL_SysRtnNumEnabled(int is_function, int enabled)'

f->addPoundDefineAccessor, 'IDL_TYP_UNDEF', type=3L

;f->addInclude, 'curl.h', header_directory='/usr/include/curl', lib_file='/usr/lib/libcurl.dylib'
;f->addRoutineFromPrototype, 'void *curl_easy_init(void)'

f->write
f->build, /show_all_output
f->register

obj_destroy, f

; normally, the routines in the DLM can't be called until IDL returns to the 
; command line, but EXECUTE, CALL_PROCEDURE, and CALL_FUNCTION can be used
; to get around this
print, 'Calling a routine from the created DLM...'
status = execute('print, IDL_OutputFormatFunc(5L), format=''(%"Default double format: %s")''')

print, 'Accessing a #define from idl_export.h...'
status = execute('print, get_idl_typ_undef(), format=''(%"#define IDL_TYP_UNDEF %d")''')

end