/* REXX edit macro to provide a some spreadsheet-like functions       */
/*** trace ?r ***************************************************** \| *
*               (C) Copyright Robert AH Prins, 1992-2016               *
************************************************************************
*  ------------------------------------------------------------------  *
* | Date       | By   | Remarks                                      | *
* |------------+------+----------------------------------------------| *
* |            |      |                                              | *
* |------------+------+----------------------------------------------| *
* | 2016-02-01 | RAHP | Exclude X'ed lines from processing           | *
* |------------+------+----------------------------------------------| *
* | 2016-01-25 | RAHP | Replace HLQ in examples with userid          | *
* |------------+------+----------------------------------------------| *
* | 2009-06-18 | RAHP | Put under GPL V3                             | *
* |------------+------+----------------------------------------------| *
* | 2009-03-16 | RAHP | Replace LISTDSI by BXPWDYN                   | *
* |------------+------+----------------------------------------------| *
* | 2007-09-24 | RAHP | Remove call to 'GETTEMP'                     | *
* |------------+------+----------------------------------------------| *
* | 2007-08-16 | RAHP | Split comment delimiters in strings          | *
* |------------+------+----------------------------------------------| *
* | 2007-07-25 | RAHP | Use 'MSG' lines in help                      | *
* |------------+------+----------------------------------------------| *
* | 2006-11-16 | RAHP | Include panels in exec                       | *
* |------------+------+----------------------------------------------| *
* | 2003-11-19 | RAHP | Add FD function                              | *
* |------------+------+----------------------------------------------| *
* | 2003-02-28 | RAHP | Right-align short output                     | *
* |------------+------+----------------------------------------------| *
* | 1995-05-30 | RAHP | Use longer messages                          | *
* |------------+------+----------------------------------------------| *
* | 1992-08-13 | RAHP | Initial version                              | *
* |------------+------+----------------------------------------------| *
************************************************************************
* E123 is an edit macro to perform a limited number of spreadsheet     *
* like functions. Currently there is only one function available, a    *
* columnar summation.                                                  *
*                                                                      *
* @S: sum data in columns designated by the cursor or on the command   *
*     line                                                             *
************************************************************************
* Send questions, suggestions and/or bug reports to:                   *
*                                                                      *
* robert@prino.org / robert.ah.prins@gmail.com                         *
*                                                                      *
* Robert AH Prins                                                      *
* Taboralaan 46                                                        *
* 8400 Oostende                                                        *
* Belgium                                                              *
************************************************************************
* This program is free software: you can redistribute it and/or        *
* modify it under the terms of the GNU General Public License as       *
* published by the Free Software Foundation, either version 3 of       *
* the License, or (at your option) any later version.                  *
*                                                                      *
* This program is distributed in the hope that it will be useful,      *
* but WITHOUT ANY WARRANTY; without even the implied warranty of       *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the         *
* GNU General Public License for more details.                         *
*                                                                      *
* You should have received a copy of the GNU General Public License    *
* along with this program. If not, see <http://www.gnu.org/licenses/>  *
***********************************************************************/
parse source source
parse value source with . . moi .

"isredit macro (parm) NOPROCESS"
numeric digits 20

zedsmsg = ''

parse value parm with lcmd ' ' parm
lcmd  = strip(lcmd)
parm  = strip(parm)

lcmd  = translate(lcmd)
dest  = '.zcsr'
line. = ''
type. = 'NOTE'

select
  when lcmd = '' |,
       lcmd = '?' then
    do
      call help
    end

  when left(lcmd, 1) = '?' then
    do
      call help lcmd
    end

  when lcmd = '@S' then
    do
      call @s parm
    end

  otherwise
    do
      type.  = 'MSG'
      i      = 1
      line.i = center('The' moi 'edit macro requires a function as',
               'parameter', 72)
      i      = i + 1
      line.i = center('Enter "'moi '?" for more help', 72)
      line.0 = i

      call message
    end
end

exit 1

/***********************************************************************
* FMT is a function to insert commas in numbers                        *
***********************************************************************/
fmt:
  arg num

  int = reverse(trunc(abs(num)))
  frc = strip(abs(num) - trunc(abs(num)), 'L', '0')

  pre = ''
  do while length(int) > 3
    pre = pre','left(int, 3)
    int = substr(int, 4)
  end

  res = strip(reverse(pre','int),, ',')frc
  if num < 0 then
    res = '-'res

return res

/***********************************************************************
* HELP:                                                                *
*                                                                      *
* HELP is a general "help" screen displaying routine                   *
***********************************************************************/
help:
  arg parm

  select
    when parm = '?@S' then
      do
        call load_dynlib

        "ispexec libdef ispplib library id("dynlib") stack"

        "ispexec control display save"
        "ispexec select pgm(isptutor) parm(e123h100)"
        "ispexec control display restore"

        "ispexec libdef ispplib"

        "free f("dynlib")"
      end

    otherwise
      do
        type.  = 'NOTE'
        i      = 1
        text   = 'The' moi 'edit macro'
        line.i = center(text, 72)
        type.i = 'MSG'
        i      = i + 1
        line.i = center(left('~', length(text), '~'), 72)
        type.i = 'MSG'
        i      = i + 1
        line.i = center(' Use DOWN to read all "HELP"',
                 'screens ', 72, '*')
        type.i = 'MSG'

        i      = i + 2
        line.i = '  The' moi 'edit macro provides the user with a',
                 'number of spreadsheet-'
        i      = i + 1
        line.i = '  like functions.'

        i      = i + 2
        line.i = '  All functions are accessed by entering the',
                 'required function as'

        i      = i + 2
        line.i = '   - the first argument on the command line, AND'
        i      = i + 1
        line.i = '   - a line command on the line or lines to act upon.'

        i      = i + 2
        line.i = '  The currently available functions are:'
        type.i = 'MSG'

        i      = i + 2
        line.i = '   - @S: sum the columns indicated by either the',
                 'cursor position or the'
        i      = i + 1
        line.i = '         optional column ranges(s) and display the',
                 'result in one or more'
        i      = i + 1
        line.i = '         ==MSG> lines.'

        i      = i + 2
        line.i = '  Examples'
        type.i = 'MSG'

        i      = i + 2
        line.i = '  To see "working" examples of the functions',
                 'described, enter "'moi'"'
        i      = i + 1
        line.i = '  followed by the function prefixed with a "?"',
                 'without intervening'
        i      = i + 1
        line.i = '  space. That is, for examples of the "@S" function,',
                 'you would enter'
        i      = i + 1
        line.i = '  "'moi '?@S" as a command.'

        i      = i + 2
        line.i = center(' End of HELP information ', 72, '*')
        type.i = 'MSG'
        line.0 = i

        call message
      end
  end
return

/***********************************************************************
* @S performs a spreadsheet-like column summation function             *
***********************************************************************/
@s:
  parse arg parm

  "isredit process range" lcmd

  if rc \= 0 then
    do
      zedlmsg = 'The' lcmd 'function requires an' lcmd 'or',
                lcmd'n line command, or two',
                lcmd || right(lcmd, 1),
                'line commands'
      "ispexec setmsg msg(ISRZ001)"
      exit 1
    end

  "isredit (FL) = linenum .zfrange"
  "isredit (LL) = linenum .zlrange"

  "isredit LABEL .zlrange = .A"

  dest  = '.A'
  fd.   = 0
  lsum. = 0
  ttab  = translate(xrange(), ' ', '-.,0123456789')

  if parm = '' then
    do
      "isredit (LI,CO) = cursor"
      if co = 0 then
        do
          zedlmsg = 'Invalid cursor position,',
                    'the cursor must be on a normal dataline for',
                    'the' lcmd 'column sum function'
          "ispexec setmsg msg(ISRZ001)"
          exit 1
        end

      "isredit (LF) = line .zfrange"
      if datatype(substr(lf, co, 1)) = 'CHAR' then
        do
          zedlmsg = 'The character at the cursor position is not',
                    'a number'
          "ispexec setmsg msg(ISRZ001)"
          "isredit cursor =" li co
          exit 1
        end

      do i = fl to ll
        "isredit (XS) = xstatus" i
        if xs = 'X' then
          iterate i

        "isredit (CL) = line" i

        cl = ' 'translate(cl, ' ', ttab)' '
        fp = lastpos(' ', cl, co + 1)
        lp = pos(' ', cl, co + 1)

        if fp \= lp then
          do
            cl = strip(substr(cl, fp + 1, lp - fp - 1))
            do while pos(',', cl) \= 0
              fd.1 = 1
              cl   = space(translate(cl, ' ', ','), 0)
            end

            if right(cl, 1) = '-' then
              cl = '-' || strip(cl, 'T', '-')

            if datatype(cl) = 'NUM' then
              lsum.1 = lsum.1 + cl
          end
      end

      if fd.1 = 1 then
        lsum.1 = fmt(lsum.1)

      l = left('=', length(lsum.1), '=')

      if length(lsum.1) < co then
        do
          l      = right(l, co)
          lsum.1 = right(lsum.1, co)
        end

      i      = 1
      line.i = l
      type.i = 'INFO'
      i      = i + 1
      line.i = lsum.1
      type.i = 'INFO'
      line.0 = i

      call message
      return
    end

  "isredit (DW)    = data_width"
  "isredit (NM,NT) = number"
  "isredit (RECFM) = recfm"

  if nm    = 'ON' &,
     recfm = 'V' then
    vcol = 8
  else
    vcol = 0

  vcols = 1 + vcol'-'dw + vcol

  fnc = ''
  tmp = parm

  if translate(left(tmp, 3)) = 'DMS' then
    do
      parse value strip(tmp) with . ' ' tmp
      fnc = 'DMS'
    end

  if translate(left(tmp, 2)) = 'FD' then
    do
      parse value strip(tmp) with . ' ' tmp
      fnc = 'FD'
    end

  do ci = 1 by 1 while tmp \= ''
    parse value strip(tmp) with c.ci ' ' tmp

    if datatype(c.ci) \= 'NUM' then
      do
        zedlmsg = 'Argument' ci '(=' c.ci') is not a valid',
                  'column number'
        "ispexec setmsg msg(ISRZ001)"
        exit 1
      end
  end

  c.0 = ci - 1

  if c.0 // 2 \= 0 then
    do
      zedlmsg = 'The' moi lcmd 'function requires an even number',
                'of columns'
      "ispexec setmsg msg(ISRZ001)"
      exit 1
    end

  do ci = 2 to c.0
    cj = ci - 1
    if c.cj > c.ci then
      do
        zedlmsg = 'Col' ci 'less than col' cj,
                  '(Sum columns must be in pairs in ascending order)'
        "ispexec setmsg msg(ISRZ001)"
        exit 1
      end
  end

  do ci = 1 to c.0 by 2
    cj = ci + 1
    if c.ci <  1 + vcol |,
       c.ci > dw + vcol then
      do
        zedlmsg = 'Column value' c.ci 'lies outside the logical data',
                  'width, valid columns are' vcols
        "ispexec setmsg msg(ISRZ001)"
        exit 1
      end

    if c.cj < 1 + vcol |,
       c.cj > dw + vcol then
      do
        zedlmsg = 'Column value' c.cj 'lies outside the logical data',
                  'width, valid columns are' vcols
        "ispexec setmsg msg(ISRZ001)"
        exit 1
      end

  end

  do ci = 1 to c.0 by 2
    i = ci + 1

    do cj = ci + 2 to c.0 by 2
      j = cj + 1

      if c.cj >= c.ci & c.cj <= c.i &,
        (c.j >= c.i | c.j <= c.i) then
      do
        zedlmsg = 'Columns' cj 'and' j 'overlap with columns',
                  ci 'and' i
        "ispexec setmsg msg(ISRZ001)"
        exit 1
      end
    end
  end

  do i = fl to ll
    "isredit (XS) = xstatus" i
    if xs = 'X' then
      iterate i

    "isredit (CL) = line" i
    if fnc \= 'FD' then
      cl = translate(cl, ' ', ttab)

    do ci = 1 to c.0 by 2
      cj = ci + 1
      ck = cj / 2

      cw = strip(substr(cl, c.ci - vcol, c.cj - c.ci + 1))

      if fnc \= 'FD' then
        do while pos(',', cw) \= 0
          fd.ck = 1
          cw    = space(translate(cw, ' ', ','), 0)
        end

      if fnc \= 'FD' then
        if right(cw, 1) = '-' then
          cw = '-' || strip(cw, 'T', '-')

      if fnc          = 'FD' |,
         datatype(cw) = 'NUM' then
        do
          if fnc = '' then
            lsum.ck = lsum.ck + cw
          else
            interpret 'lsum.ck = lsum.ck +' fnc'(cw)'
        end
    end
  end

  do ci = 1 to c.0 / 2
    cj = ci * 2
    if fnc = '' then
      do
        if fd.ci = 1 then
          lsum.ci = fmt(lsum.ci)
      end
    else
      do
        interpret 'lsum.ci = i'fnc'(lsum.ci)'
      end

    llen.ci = length(lsum.ci)
  end

  do ci = 1 to c.0
    c.ci = c.ci - vcol
  end

  dl. = ''
  ul. = ''

  do ci = 1 to c.0
    cj = ci - 1
    ck = ci / 2
    select
      when ci // 2 = 1 then
        do
          ul.ci = left(' ', c.ci - 1)
          dl.ci = left(' ', c.ci - 1)
        end

      otherwise
        do
          ul.ci = left('=', c.ci - c.cj + 1, '=')
          dl.ci = right(lsum.ck, length(ul.ci))
        end
    end
  end

  dd. = ''
  uu. = ''

  do ci = 2 to c.0 by 2
    cj    = ci - 1
    ck    = ci / 2
    d.ck  = dl.cj || dl.ci
    t.ck  = ul.cj || ul.ci
    match = 0

    dtmp = d.ck
    ttmp = t.ck

    do i = 1 by 1 while match = 0
      t.ck = ttmp
      d.ck = dtmp
      l    = length(uu.i)

      do while length(bitor(uu.i, t.ck)) > c.ci &,
               substr(bitor(uu.i, t.ck), l + 1, 1) = '  ' &,
               substr(t.ck, 1, 2) = '  '
        t.ck = substr(t.ck, 2)
        d.ck = substr(d.ck, 2)
      end

      if (length(bitor(uu.i, t.ck)) <= c.ci    &,
          substr(bitor(uu.i, t.ck), l + 1, 1) = '  ') |,
          uu.i = '' then
        do
          match = 1
          uu.i  = bitor(uu.i, t.ck)
          dd.i  = bitor(dd.i, d.ck)
        end
    end
  end

  type. = 'INFO'
  do i = 1 by 1 while uu.i \= ''
    k      = 2 * i
    j      = k - 1
    line.j = uu.i
    line.k = dd.i
  end

  line.0 = k
  call message
  return
return

/***********************************************************************
* MESSAGE is a general purpose edit message insertion routine          *
***********************************************************************/
message:
  "isredit (STATE) = user_state"
  "isredit caps = off"
  do i = line.0 to 1 by -1
    lin = line.i
    "isredit line_after "dest" = "type.i"line (LIN)"
  end
  "isredit user_state = (STATE)"
  "isredit locate" dest
return

/***********************************************************************
* DMS converts a time in hh.mm format to a decimal hh.dddd equivalent  *
***********************************************************************/
dms:
  arg hms

  parse value hms with hh '.' mm '.' .

  if hh = '' then
    hh = 0

  if mm = '' then
    mm = 0

  return hh + mm / 60

/***********************************************************************
* IDMS converts a time in hh.dddddd format to its equivalent in        *
* hh.mm.ssmmm format                                                   *
***********************************************************************/
idms:
  arg ddd

  parse value(ddd) with . '.' dec
  if length(dec) > 10 then
    rnd = '.'left('0', length(dec) - 4, '0')'1'
  else
    rnd = 0

  ddd = ddd + rnd

  hh = trunc(ddd)
  mm = trunc((ddd - hh) * 60)
  ss = trunc((ddd - hh) * 3600) - mm * 60

  return hh'.'right(mm, 2, '0')

/***********************************************************************
* FD converts a packed decimal to a usable format                      *
***********************************************************************/
fd:
  parse arg q

  q = c2x(q)

  if right(q, 1) = 'C' |,
     right(q, 1) = 'F' then
    q = '+' || q
  else
    if right(q, 1) = 'D' then
      q = '-' || q
    else
      q = '00'

  return substr(q, 1, length(q) - 1)

/***********************************************************************
* IFD is a nop                                                         *
***********************************************************************/
ifd:
  arg nyetski

  return nyetski

/***********************************************************************
* LOAD_DYNLIB:                                                         *
*                                                                      *
* This procedure loads the via EPANQ generated panel, message and/or   *
* skeleton code into a library. Note that there is no reason to use    *
* different libraries for any of these objects, as long as they are    *
* named differently|                                                   *
***********************************************************************/
load_dynlib:
dynlib = 'dyn'random(99999)
alloc  = "alloc fi("dynlib") rtdsn(sysdsname) "   ||,
                   "lrecl(80) blksize(0) dir(5) " ||,
                   "new delete reuse "            ||,
                   "space(1,1)"
rc = bpxwdyn(alloc)

if rc = 0 then
  ispdyn = sysdsname
else
  ispdyn = 'NOT FOUND'

"newstack"

head = left('%Edit       'userid()'.TEXT(TEMP) - 01.00', 58) ||,
       ' !Columns%00001 00072'

member = 'E123H100'

queue ')attr default(%$_)'
queue '/' || '***************************************************' ||,
      '*******************' || '/'
queue '/' || '*              (C) Copyright Robert AH Prins, 1992-' ||,
      '1992              *' || '/'
queue '/' || '***************************************************' ||,
      '*******************' || '/'
queue '/' || '*  ------------------------------------------------' ||,
      '----------------  *' || '/'
queue '/' || '* | Date       | By   | Remarks                    ' ||,
      '                | *' || '/'
queue '/' || '* |------------+------+----------------------------' ||,
      '----------------| *' || '/'
queue '/' || '* |            |      |                            ' ||,
      '                | *' || '/'
queue '/' || '* |------------+------+----------------------------' ||,
      '----------------| *' || '/'
queue '/' || '* | 1992-08-14 | RAHP | Initial version            ' ||,
      '                | *' || '/'
queue '/' || '* |------------+------+----------------------------' ||,
      '----------------| *' || '/'
queue '/' || '***************************************************' ||,
      '*******************' || '/'
queue '/' || '* Panel - E123H100                                 ' ||,
      '                  *' || '/'
queue '/' || '***************************************************' ||,
      '*******************' || '/'
queue ' ¢ type(text)   intens(high) color(yellow)'
queue ' \ type(text)   intens(high) color(turq)'
queue ' ! type(output) intens(high) color(yellow)'
queue ' '
queue ')body width(80) asis'
queue '\Tutorial ---------------- E123 Edit Macro @S Function ---' ||,
      '------------- Tutorial'
queue '¢Option%==>_zcmd                                          ' ||,
      '              &ztime'
queue '$'
queue '%                        -------------------------------'
queue '%                        | E123 Edit Macro @S Function |'
queue '%                        -------------------------------'
queue '$'
queue '$  The%@S$option of the%E123$edit macro provides a simple ' ||,
      'spreadsheet-like'
queue '$  summation function for one or more columns containing n' ||,
      'umerical data.'
queue '$'
queue '$  The following examples are presented in sequence, or ma' ||,
      'y be selected by'
queue '$  number:'
queue '$'
queue '%   1$- Summing a single column based on the position of t' ||,
      'he cursor'
queue '%   2$- Summing one or more columns using column ranges on' ||,
      ' the command line'
queue '$'
queue '$'
queue '$'
queue '$'
queue '$'
queue '$'
queue '$'
queue '$  Press!end $to return to your edit session'
queue '$'
queue ')init'
queue '  .help  = e123h110'
queue '  &end   = pfk(end)'
queue ')proc'
queue '  &zsel = trans(trunc(&zcmd 1)'
queue '                1, e123h110'
queue '                2, e123h110'
queue '              '' '', e123h110'
queue '                *, ''?'')'
queue ' '
queue '  &ex   = trans(trunc(&zcmd 1) '' '' 1 * *)'
queue ')end'

call put_object

"newstack"

member = 'E123H110'

queue ')attr default(%$_)'
queue '/' || '***************************************************' ||,
      '*******************' || '/'
queue '/' || '*              (C) Copyright Robert AH Prins, 1992-' ||,
      '1992              *' || '/'
queue '/' || '***************************************************' ||,
      '*******************' || '/'
queue '/' || '*  ------------------------------------------------' ||,
      '----------------  *' || '/'
queue '/' || '* | Date       | By   | Remarks                    ' ||,
      '                | *' || '/'
queue '/' || '* |------------+------+----------------------------' ||,
      '----------------| *' || '/'
queue '/' || '* |            |      |                            ' ||,
      '                | *' || '/'
queue '/' || '* |------------+------+----------------------------' ||,
      '----------------| *' || '/'
queue '/' || '* | 1992-08-14 | RAHP | Initial version            ' ||,
      '                | *' || '/'
queue '/' || '* |------------+------+----------------------------' ||,
      '----------------| *' || '/'
queue '/' || '***************************************************' ||,
      '*******************' || '/'
queue '/' || '* Panel - E123H110                                 ' ||,
      '                  *' || '/'
queue '/' || '***************************************************' ||,
      '*******************' || '/'
queue ' ¢  type(text)   intens(high) color(yellow)'
queue ' \  type(text)   intens(high) color(turq)'
queue ' !  type(text)   intens(high) color(green)'
queue ' ~  type(text)   intens(high) color(red)'
queue ' '
queue ')body width(80) asis'
queue '\Tutorial ---------------- E123 Edit Macro @S Function ---' ||,
      '------------- Tutorial'
queue '¢cmd ==>_zcmd'
queue '$'
queue '$The examples on the next pages will show the various poss' ||,
      'ible ways of using'
queue '$the%E123 @S$edit macro to perform column summations.'
queue '$'
queue '$The first example demonstrates summing a column using the' ||,
      ' cursor to select'
queue '$the required column, the second uses additional parameter' ||,
      's to sum a number of'
queue '$columns. Both examples use the following excerpt from a t' ||,
      'ypical edit session.'
queue '$'
queue head
queue '!Command ===>                                             ' ||,
      '    !Scroll ===>~CSR'
queue '~******$***************************** TOP OF DATA ********' ||,
      '**********************'
queue '~=COLS>%----+----1----+----2----+----3----+----4----+----5' ||,
      '----+----6----+----7--'
queue '!000001   30.195870     123'
queue '!000002   23.714745       1'
queue '!000003   18.924885  -2,222'
queue '!000004    7.098375 444,444.00001'
queue '!000005   12.653625 777,777.00001'
queue '~******$**************************** BOTTOM OF DATA ******' ||,
      '**********************'
queue '$'
queue '$Press¢ENTER$to proceed.'
queue ')init'
queue '  if (&ex = 1)'
queue '    &zcont = e123h120'
queue ' '
queue '  if (&ex = 2)'
queue '    &zcont = e123h130'
queue ' '
queue '  &ex = 1'
queue ')proc'
queue ')end'

call put_object

"newstack"

member = 'E123H120'

queue ')attr default(%$_)'
queue '/' || '***************************************************' ||,
      '*******************' || '/'
queue '/' || '*              (C) Copyright Robert AH Prins, 1992-' ||,
      '1992              *' || '/'
queue '/' || '***************************************************' ||,
      '*******************' || '/'
queue '/' || '*  ------------------------------------------------' ||,
      '----------------  *' || '/'
queue '/' || '* | Date       | By   | Remarks                    ' ||,
      '                | *' || '/'
queue '/' || '* |------------+------+----------------------------' ||,
      '----------------| *' || '/'
queue '/' || '* |            |      |                            ' ||,
      '                | *' || '/'
queue '/' || '* |------------+------+----------------------------' ||,
      '----------------| *' || '/'
queue '/' || '* | 1992-08-14 | RAHP | Initial version            ' ||,
      '                | *' || '/'
queue '/' || '* |------------+------+----------------------------' ||,
      '----------------| *' || '/'
queue '/' || '***************************************************' ||,
      '*******************' || '/'
queue '/' || '* Panel - E123H120                                 ' ||,
      '                  *' || '/'
queue '/' || '***************************************************' ||,
      '*******************' || '/'
queue ' :  area(dynamic)'
queue ' 01 type(dataout) intens(high) color(white)'
queue ' 02 type(dataout) intens(low)  color(blue)'
queue ' 03 type(dataout) intens(high) color(red)'
queue ' 04 type(dataout) intens(high) color(turq)'
queue ' 05 type(dataout) intens(high) color(yellow)'
queue ' ¢  type(text)    intens(high) color(yellow)'
queue ' \  type(text)    intens(high) color(turq)'
queue ' !  type(text)    intens(high) color(green)'
queue ' ~  type(text)    intens(high) color(red)'
queue ' }  type(output)  intens(high) color(green)'
queue ' {  type(output)  intens(high) color(green)'
queue ' #  type(output)  intens(high) color(blue) caps(off)'
queue ' '
queue ')body width(80) asis'
queue '\Tutorial ---------------- E123 Edit Macro @S Function ---' ||,
      '------------- Tutorial'
queue '¢cmd ==>_zcmd'
queue '$'
queue '$The example below shows how to sum the contents of the fi' ||,
      'rst three rows of'
queue '$the first column.'
queue '$'
queue '$To do so, we have to enter an%@S3$line command in the seq' ||,
      'uence field of line'
queue '$one, the required%E123 @S$command in the command field, a' ||,
      'nd finally the cursor'
queue '$somewhere on a number in column one.'
queue '$'
queue head
queue '!Command ===>}cmd                                         ' ||,
      '    !Scroll ===>~CSR'
queue '~******$***************************** TOP OF DATA ********' ||,
      '**********************'
queue '~=COLS>%----+----1----+----2----+----3----+----4----+----5' ||,
      '----+----6----+----7--'
queue '}lin     {dat'
queue '!000002   23.714745       1'
queue '!000003   18.924885  -2,222'
queue '!000004    7.098375 444,444.00001'
queue '!000005   12.653625 777,777.00001'
queue '~******$**************************** BOTTOM OF DATA ******' ||,
      '**********************'
queue '$'
queue ':dyna                                                     ' ||,
      '                     :'
queue ')init'
queue '  &dat = ''30.195870     123'''
queue ' '
queue '  if (&ex = 5)'
queue '    &ex    = 1'
queue ' '
queue '  if (&ex = 4)'
queue '    .attrchar(}) = ''color(red)'''
queue '    .csrpos      = 9'
queue '    .cursor      = dat'
queue ' '
queue '    &dyna  = ''' ||,
      x2c(02) ||,
      'Press' ||,
      x2c(05) ||,
      'ENTER' ||,
      x2c(02) ||,
      'to perform the summation.'''
queue '    &cmd   = ''E123 @S'''
queue '    &ex    = 5'
queue '    &lin   = ''@S3'''
queue '    &zcont = e123h121'
queue ' '
queue '  if (&ex = 3)'
queue '    .attrchar(}) = ''color(red)'''
queue '    .cursor      = cmd'
queue ' '
queue '    &dyna  = ''' ||,
      x2c(02) ||,
      'Press' ||,
      x2c(05) ||,
      'ENTER' ||,
      x2c(02) ||,
      'to place the cursor' ||,
      x2c(04) ||,
      'anywhere' ||,
      x2c(02) ||,
      'in the first +'
queue '              row/column to be summed.'''
queue '    &cmd   = ''E123 @S'''
queue '    &ex    = 4'
queue '    &lin   = ''@S3'''
queue '    &zcont = e123h120'
queue ' '
queue '  if (&ex = 2)'
queue '    .attrchar(}) = ''color(red)'''
queue '    .cursor      = lin'
queue ' '
queue '    &dyna  = ''' ||,
      x2c(02) ||,
      'Press' ||,
      x2c(05) ||,
      'ENTER' ||,
      x2c(02) ||,
      'to enter the' ||,
      x2c(03) ||,
      '"E123 @S"' ||,
      x2c(02) ||,
      'primary command.'''
queue '    &cmd   = &z'
queue '    &ex    = 3'
queue '    &lin   = ''@S3'''
queue '    &zcont = e123h120'
queue ' '
queue '  if (&ex = 1)'
queue '    &dyna  = ''' ||,
      x2c(02) ||,
      'Press' ||,
      x2c(05) ||,
      'ENTER' ||,
      x2c(02) ||,
      'to enter the' ||,
      x2c(03) ||,
      '"@S3"' ||,
      x2c(02) ||,
      'line command.'''
queue '    &cmd   = &z'
queue '    &ex    = 2'
queue '    &lin   = ''000001'''
queue '    &zcont = e123h120'
queue ')proc'
queue ')end'

call put_object

"newstack"

member = 'E123H121'

queue ')attr default(%$_)'
queue '/' || '***************************************************' ||,
      '*******************' || '/'
queue '/' || '*              (C) Copyright Robert AH Prins, 1992-' ||,
      '1992              *' || '/'
queue '/' || '***************************************************' ||,
      '*******************' || '/'
queue '/' || '*  ------------------------------------------------' ||,
      '----------------  *' || '/'
queue '/' || '* | Date       | By   | Remarks                    ' ||,
      '                | *' || '/'
queue '/' || '* |------------+------+----------------------------' ||,
      '----------------| *' || '/'
queue '/' || '* |            |      |                            ' ||,
      '                | *' || '/'
queue '/' || '* |------------+------+----------------------------' ||,
      '----------------| *' || '/'
queue '/' || '* | 1992-08-14 | RAHP | Initial version            ' ||,
      '                | *' || '/'
queue '/' || '* |------------+------+----------------------------' ||,
      '----------------| *' || '/'
queue '/' || '***************************************************' ||,
      '*******************' || '/'
queue '/' || '* Panel - E123H121                                 ' ||,
      '                  *' || '/'
queue '/' || '***************************************************' ||,
      '*******************' || '/'
queue ' ¢  type(text)   intens(high) color(yellow)'
queue ' \  type(text)   intens(high) color(turq)'
queue ' !  type(text)   intens(high) color(green)'
queue ' ~  type(text)   intens(high) color(red)'
queue ' '
queue ')body width(80) asis'
queue '\Tutorial ---------------- E123 Edit Macro @S Function ---' ||,
      '------------- Tutorial'
queue '¢cmd ==>_zcmd'
queue '$'
queue '$The display below shows the result of the three actions p' ||,
      'erformed on the'
queue '$previous screen. As you can see, two~======$lines contain' ||,
      'ing the result of'
queue '$the summation have been inserted in the data.'
queue '$'
queue head
queue '!Command ===>                                             ' ||,
      '    !Scroll ===>~CSR'
queue '~******$***************************** TOP OF DATA ********' ||,
      '**********************'
queue '~=COLS>%----+----1----+----2----+----3----+----4----+----5' ||,
      '----+----6----+----7--'
queue '!000001   30.195870     123'
queue '!000002   23.714745       1'
queue '!000003   18.924885  -2,222'
queue '~====== % ========='
queue '~====== % 72.835500'
queue '!000004    7.098375 444,444.00001'
queue '!000005   12.653625 777,777.00001'
queue '~******$**************************** BOTTOM OF DATA ******' ||,
      '**********************'
queue '$'
queue '$'
queue '$Press¢ENTER$to continue with the next example.'
queue ')init'
queue '  &zhtop = e123h100'
queue '  &zcont = e123h130'
queue ' '
queue '  &ex = 1'
queue ')proc'
queue ')end'

call put_object

"newstack"

member = 'E123H130'

queue ')attr default(%$_)'
queue '/' || '***************************************************' ||,
      '*******************' || '/'
queue '/' || '*              (C) Copyright Robert AH Prins, 1992-' ||,
      '1992              *' || '/'
queue '/' || '***************************************************' ||,
      '*******************' || '/'
queue '/' || '*  ------------------------------------------------' ||,
      '----------------  *' || '/'
queue '/' || '* | Date       | By   | Remarks                    ' ||,
      '                | *' || '/'
queue '/' || '* |------------+------+----------------------------' ||,
      '----------------| *' || '/'
queue '/' || '* |            |      |                            ' ||,
      '                | *' || '/'
queue '/' || '* |------------+------+----------------------------' ||,
      '----------------| *' || '/'
queue '/' || '* | 1992-08-14 | RAHP | Initial version            ' ||,
      '                | *' || '/'
queue '/' || '* |------------+------+----------------------------' ||,
      '----------------| *' || '/'
queue '/' || '***************************************************' ||,
      '*******************' || '/'
queue '/' || '* Panel - E123H130                                 ' ||,
      '                  *' || '/'
queue '/' || '***************************************************' ||,
      '*******************' || '/'
queue ' :  area(dynamic)'
queue ' 01 type(dataout) intens(high) color(white)'
queue ' 02 type(dataout) intens(low)  color(blue)'
queue ' 03 type(dataout) intens(high) color(red)'
queue ' 04 type(dataout) intens(low)  color(blue)   hilite(uscore' ||,
      ')'
queue ' 05 type(dataout) intens(high) color(yellow)'
queue ' ¢  type(text)    intens(high) color(yellow)'
queue ' \  type(text)    intens(high) color(turq)'
queue ' !  type(text)    intens(high) color(green)'
queue ' ~  type(text)    intens(high) color(red)'
queue ' }  type(output)  intens(high) color(green)'
queue ' {  type(output)  intens(high) color(green)'
queue ' #  type(output)  intens(high) color(blue) caps(off)'
queue ' '
queue ')body width(80) asis'
queue '\Tutorial ---------------- E123 Edit Macro @S Function ---' ||,
      '------------- Tutorial'
queue '¢cmd ==>_zcmd'
queue '$'
queue '$The example below shows how to sum the contents of five r' ||,
      'ows of two columns'
queue '$at the same time.'
queue '$'
queue '$To do so, we have to enter an%@S5$line command in the seq' ||,
      'uence field of line'
queue '$one and the required%E123 @S$command, followed by the two' ||,
      ' column ranges in'
queue '$the command line.'
queue '$'
queue head
queue '!Command ===>}cmd                                         ' ||,
      '    !Scroll ===>~CSR'
queue '~******$***************************** TOP OF DATA ********' ||,
      '**********************'
queue '~=COLS>%----+----1----+----2----+----3----+----4----+----5' ||,
      '----+----6----+----7--'
queue '}lin     !30.195870     123'
queue '!000002   23.714745       1'
queue '!000003   18.924885  -2,222'
queue '!000004    7.098375 444,444.00001'
queue '!000005   12.653625 777,777.00001'
queue '~******$**************************** BOTTOM OF DATA ******' ||,
      '**********************'
queue '$'
queue ':dyna                                                     ' ||,
      '                     :'
queue ')init'
queue '  if (&ex = 4)'
queue '    &ex    = 1'
queue ' '
queue '  if (&ex = 3)'
queue '    .attrchar(}) = ''color(red)'''
queue ' '
queue '    &dyna  = ''' ||,
      x2c(02) ||,
      'Press' ||,
      x2c(05) ||,
      'ENTER' ||,
      x2c(02) ||,
      'to perform the summation.'''
queue '    &cmd   = ''E123 @S 3 11 13 25'''
queue '    &ex    = 4'
queue '    &lin   = ''@S5'''
queue '    &zcont = e123h131'
queue ' '
queue '  if (&ex = 2)'
queue '    .attrchar(}) = ''color(red)'''
queue '    .cursor      = lin'
queue ' '
queue '    &dyna  = ''' ||,
      x2c(02) ||,
      'Press' ||,
      x2c(05) ||,
      'ENTER' ||,
      x2c(02) ||,
      'to enter the' ||,
      x2c(03) ||,
      '"E123 @S 3 11 13 25"' ||,
      x2c(02) ||,
      '+'
queue '             primary command.'''
queue '    &cmd   = &z'
queue '    &ex    = 3'
queue '    &lin   = ''@S5'''
queue '    &zcont = e123h130'
queue ' '
queue '  if (&ex = 1)'
queue '    &dyna  = ''' ||,
      x2c(02) ||,
      'Press' ||,
      x2c(05) ||,
      'ENTER' ||,
      x2c(02) ||,
      'to enter the' ||,
      x2c(03) ||,
      '"@S5"' ||,
      x2c(02) ||,
      'line command.'''
queue '    &cmd   = &z'
queue '    &ex    = 2'
queue '    &lin   = ''000001'''
queue '    &zcont = e123h130'
queue ' '
queue '  &zhtop = e123h100'
queue ')proc'
queue ')end'

call put_object

"newstack"

member = 'E123H131'

queue ')attr default(%$_)'
queue '/' || '***************************************************' ||,
      '*******************' || '/'
queue '/' || '*              (C) Copyright Robert AH Prins, 1992-' ||,
      '1992              *' || '/'
queue '/' || '***************************************************' ||,
      '*******************' || '/'
queue '/' || '*  ------------------------------------------------' ||,
      '----------------  *' || '/'
queue '/' || '* | Date       | By   | Remarks                    ' ||,
      '                | *' || '/'
queue '/' || '* |------------+------+----------------------------' ||,
      '----------------| *' || '/'
queue '/' || '* |            |      |                            ' ||,
      '                | *' || '/'
queue '/' || '* |------------+------+----------------------------' ||,
      '----------------| *' || '/'
queue '/' || '* | 1992-08-14 | RAHP | Initial version            ' ||,
      '                | *' || '/'
queue '/' || '* |------------+------+----------------------------' ||,
      '----------------| *' || '/'
queue '/' || '***************************************************' ||,
      '*******************' || '/'
queue '/' || '* Panel - E123H131                                 ' ||,
      '                  *' || '/'
queue '/' || '***************************************************' ||,
      '*******************' || '/'
queue ' ¢  type(text)   intens(high) color(yellow)'
queue ' \  type(text)   intens(high) color(turq)'
queue ' !  type(text)   intens(high) color(green)'
queue ' ~  type(text)   intens(high) color(red)'
queue ' '
queue ')body width(80) asis'
queue '\Tutorial ---------------- E123 Edit Macro @S Function ---' ||,
      '------------- Tutorial'
queue '¢cmd ==>_zcmd'
queue '$'
queue '$The display below shows the result of the three actions p' ||,
      'erformed on the'
queue '$previous screen. As you can see, four -to avoid overlap-~' ||,
      '======$lines'
queue '$containing the result of the summation have been inserted' ||,
      ' in the data.'
queue '$'
queue head
queue '!Command ===>                                             ' ||,
      '    !Scroll ===>~CSR'
queue '~******$***************************** TOP OF DATA ********' ||,
      '**********************'
queue '~=COLS>%----+----1----+----2----+----3----+----4----+----5' ||,
      '----+----6----+----7--'
queue '!000001   30.195870     123'
queue '!000002   23.714745       1'
queue '!000003   18.924885  -2,222'
queue '!000004    7.098375 444,444.00001'
queue '!000005   12.653625 777,777.00001'
queue '~====== % ========='
queue '~====== % 92.587500'
queue '~====== %         ==============='
queue '~====== %         1,220,123.00002'
queue '~******$**************************** BOTTOM OF DATA ******' ||,
      '**********************'
queue '$Press¢ENTER$to return to the first help screen.'
queue ')init'
queue '  &zcont = e123h100'
queue ')proc'
queue ')end'

put_object:
  tfil = 'tfil'random(9999)

  "alloc f("tfil") da('"ispdyn"("member")') shr reu"
  "execio" queued() "diskw "tfil" (finis"
  "free f("tfil")"

  "delstack"
return

Flags