strmem.gsf

*
* act = 'set' : set variable
*
* act = 'get' : get variable
*
* ' Copyright (C) 2010-2015 Chihiro Kodama'
* ' Distributed under GNU GPL (http://www.gnu.org/licenses/gpl.html)'
*
function strmem( act, name, str )
  _version = '0.01r1'
  rc = gsfallow( 'on' )

********** BELOW PLEASE SET PATH FOR TEMPORARY BUFFER ************
  path = '/var/tmp'
********** ABOVE PLEASE SET PATH FOR TEMPORARY BUFFER ************

  if( act != 'set' & act != get )
    say 'error in strmem.gsf : no action specified'
    return -1
  endif
  if( name = '' )
    say 'error in strmem.gsf : no variable name'
    return -1
  endif

********** create dummy control file if necessary **********
* whether at least one control file is opened or not
  'q files'

  flag = sublin( result, 1 )
  if( flag = 'No files open' ) ; flag = 'dummy' ; endif
  if( flag = 'dummy' )
    gs = path % '/grads_strmem_dummy.ctl'
    i = 1
    maxi = 10
    while( i <= maxi )
      ret = read( gs )
      stat = sublin( ret, 1 )
      if( stat = 1 ) ; ret = write( gs, '*' ) ; break ; endif
      if( stat = 0 ) ; ret = close( gs ) ; endif
      if( i = maxi )
        say 'error : ' % gs % ' is locked by other process'
        exit
      endif
      '!sleep 1s'
      i = i + 1
    endwhile

*   dummy control file is created, opened, and removed
    ret = write( gs, 'DSET ^dummy%y4.grd' )
    ret = write( gs, 'OPTIONS TEMPLATE' )
    ret = write( gs, 'UNDEF 0' )
    ret = write( gs, 'XDEF 1 LEVELS 0' )
    ret = write( gs, 'YDEF 1 LEVELS 0' )
    ret = write( gs, 'ZDEF 1 LEVELS 0' )
    ret = write( gs, 'TDEF 1 LINEAR 01jan2000 1mo' )
    ret = write( gs, 'VARS 1' )
    ret = write( gs, 'dummy 0 99 dummy' )
    ret = write( gs, 'ENDVARS' )
    ret = close( gs )
    'open 'gs
    '!rm -f 'gs
  endif

********** set string **********
  if( act = 'set' )
    length = math_strlen(str)
    i = 1
    while( i <= length )
      char = substr( str, i, 1 )
      int = atoi( char )

*      say char ' ' int

      ''name''i' = 'int

      i = i + 1
    endwhile
    ''name'0 = 'i-1
    if( flag = 'dummy' ) ; 'close 1' ; endif
    return
  endif

********** get string **********
  if( act = 'get' )
    str = ''
*    'd 'name'0'
    'q defval 'name'0 1 1'
*    length = subwrd( result, 4 )
    length = subwrd( result, 3 )
    if( valnum(length) = 0 ) ; exit ; endif
    i = 1
    while( i <= length )
*      'd 'name''i
      'q defval 'name''i' 1 1'
*       int = subwrd( result, 4 )
       int = subwrd( result, 3 )
       if( valnum(int) = 0 ) ; say 'error at 'i ; exit ; endif
       str = str % itoa( int )
      i = i + 1
    endwhile

    if( flag = 'dummy' ) ; 'close 1' ; endif
    return str
  endif

********** nothing to do **********
  if( flag = 'dummy' ) ; 'close 1' ; endif
  say 'nothing to do in strmem.gs'
return -1



***** char -> integer *****
*function atoi( char )
*
** avoid bug in GrADS 1.9 or less ('e' and '+' are assumed to be same)
*  a='1'char'5'
*  if( a = 1e+5 )  ; return 101 ; endif
*  if( a = '1+5' ) ; return 43  ; endif
*
*if( char = a ) ; return 43 ; endif
*  if( char = 'e' ) ; return 101 ; endif
*  i = 32
*  while( i <= 126 )
*    if( itoa(i) = char ) ; return i ; endif
*    i = i + 1
*  endwhile
*return -1


***** integer -> char *****
*function itoa( int )
** ascii character table
*  table = ' !"#$%&'
*  table = table % "'"
*  table = table % '()*+,-./0123456789:;<=>?@'
*  table = table % 'ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`'
*  table = table % 'abcdefghijklmnopqrstuvwxyz{|}~'
*
*  if( int >= 32 & int <= 126 )
*    return substr( table, int-31, 1 )
*  endif
*return -1