home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 5 Edit / 05-Edit.zip / epmmac.zip / MATHLIB.E < prev    next >
Text File  |  1994-10-26  |  10KB  |  340 lines
  1. ;  MATHLIB.E   added to EOS2 4.02 to make the bulk of the math procedures
  2. ;              linkable on an as-needed basis.
  3. ;
  4. include 'STDCONST.E'
  5. define INCLUDING_FILE = 'MATHLIB.E'
  6. tryinclude 'mycnf.e'
  7.  
  8. compile if not defined(SITE_CONFIG)
  9.    const SITE_CONFIG = 'SITECNF.E'
  10. compile endif
  11. compile if SITE_CONFIG
  12.    tryinclude SITE_CONFIG
  13. compile endif
  14.  
  15. compile if not defined(DECIMAL)
  16. const DECIMAL = '.'
  17. compile endif
  18. compile if not defined(NLS_LANGUAGE)
  19.   const NLS_LANGUAGE = 'ENGLISH'
  20. compile endif
  21. include NLS_LANGUAGE'.e'
  22.  
  23.  
  24. defproc column_math
  25.    getmark firstline,lastline,firstcol,lastcol,fileid
  26.    result = arg(1)='*'   -- Result = 1 if '*', or 0 if '+'
  27. ;  if arg(1)='+' then
  28. ;     result=0
  29. ;  else
  30. ;    result=1
  31. ;  endif
  32.    decimal_flag = 0
  33.  
  34.    call pinit_extract()
  35.    loop
  36.       code = pextract_string(line)
  37.       if code = 1 then leave endif
  38.       if code = 0 then  /* ignore blank lines */
  39.          -- Find the number within the line.  Frees the user from having
  40.          -- to have a perfectly-fitting block mark around the numbers.
  41.          -- jbl 12/20/88 bug fix:  line might start with minus sign or decimal.
  42.          -- LAM: The Parse was using only the first number on each line.
  43.          startnum = verify(line,'0123456789-'DECIMAL,'M')
  44.          if startnum then
  45. ;           parse value substr(line,startnum) with line .
  46.             line = substr(line,startnum)
  47.          endif
  48.          if evalinput(tempresult, line, '',arg(1)) then
  49.             call experror()
  50.          else
  51.             if arg(1)='+' then
  52.                if pos('.',tempresult) then
  53.                   decimal_flag = max(length(tempresult)-pos('.',tempresult), decimal_flag)
  54.                endif
  55.                result=result+tempresult
  56.             else
  57.                result=result*tempresult
  58.             endif
  59.          endif
  60.       endif
  61.    endloop
  62.    if decimal_flag then  -- LAM:  Merge in CHC changes
  63.       if pos('.',result) then   -- there's a decimal but the final zero is gone
  64.          result = result || copies(0, decimal_flag - (length(result)-pos('.',result)))
  65.       else
  66.          result = result'.'copies(0, decimal_flag)
  67.       endif
  68.    endif
  69.    -- Line up with decimal point of last line if there is one, else line up
  70.    -- by the last digit of last line.  The old way lined up by the first digit
  71.    -- which was seldom desirable:
  72.    --insertline substr('',1,firstcol-1)result,lastline+1,fileid
  73.    res_len = length(result)
  74.    p = pos(DECIMAL,result)
  75.    if p then
  76.       q = pos(DECIMAL,line)
  77.       if q then
  78.          lpad = startnum+q-p-1
  79.       else
  80.          lpad = startnum+length(line)-p
  81.       endif
  82.    else
  83.       lpad = startnum+length(line)-res_len-1
  84.    endif
  85.  
  86.    -- jbl 12/11/88:  make it work with or without a marked area.
  87.    lpad = max(lpad + firstcol -1, 0)
  88.  
  89.    -- If the next line has spaces in the proper posiition, fill them,
  90.    -- don't insert a new line.
  91.    if lastline<.last then
  92.       getline line, lastline+1
  93.    else
  94.       line=''
  95.    endif
  96.    -- If the next line is all same character, like a dotted line, skip over.
  97.    dash = substr(line, lpad+1, res_len)
  98.    ch = substr(dash,1,1)
  99.    if not verify(dash,ch) & ch<>' ' then
  100.       lastline=lastline+1
  101.       if lastline<.last then
  102.          getline line, lastline+1
  103.       endif
  104.    endif
  105.    if not verify(substr(line,lpad+1,res_len),' ') & lastline<.last then
  106.       replaceline overlay(result,line,lpad+1), lastline+1
  107.    else
  108.       pad = substr(' ',1,lpad)
  109.       insertline pad || result,lastline+1,fileid
  110.    endif
  111.  
  112.  
  113. /* returns 0 if expression evaluated successfully. */
  114. /* result is set to evaluation of expression when successful */
  115. /* returns 1 if error.  No message displayed */
  116. defproc evalinput(var result,var sourceline,output)
  117.    universal i,input
  118.    universal exp_stack
  119.    universal sym
  120.  
  121.    exp_stack=''
  122.    i=pos('=',sourceline)
  123.    if i then
  124.       sourceline=substr(sourceline,1,i-1)
  125.    endif
  126.    input=sourceline
  127.    i=1; call next_sym()
  128.    call exp(arg(4))  -- Accept & pass to exp an optional 4th argument
  129.    if sym<>'$' then
  130.       return 1
  131.    else
  132.       result=strip(exp_stack)
  133.       if output='x' then
  134.          result=dec2hex(result)
  135.       elseif output='o' then
  136.          result=dec2hex(result,8)
  137.       endif
  138.       return 0
  139.    endif
  140.  
  141.  
  142. ;  EXP takes an optional argument saying what the default operator
  143. ;  should be.  (I.e., what operator should be assumed if 2 numbers appear one
  144. ;  after the other).  If not given, error.  ('+' was assumed previously.)
  145. defproc exp
  146.    universal sym
  147.    op_stack='$'
  148.    loop
  149.       call unary_exp(arg(1))   -- Pass to unary_exp, because it calls us.
  150.       /* look for dual operator */
  151.       if pos(sym,'+-*%/?') then
  152.          oldsym=''
  153.       else
  154.          if not isnum(sym) & sym<>'(' then  -- '(' OK for column math.
  155.             leave
  156.          endif
  157.          oldsym=sym
  158.          if arg(1) then sym=arg(1); else call experror(); stop; endif
  159.       endif
  160.       while prec(substr(op_stack,length(op_stack)))>=prec(sym) do
  161.          call reduce_dualop(substr(op_stack,length(op_stack)))
  162.          op_stack=substr(op_stack,1,length(op_stack)-1)
  163.       endwhile
  164.       op_stack=op_stack||sym
  165.       if oldsym='' then
  166.          call next_sym()
  167.       else
  168.          sym=oldsym
  169.       endif
  170.    endloop
  171.    for j=length(op_stack) to 2 by -1
  172.       call reduce_dualop(substr(op_stack,j,1))
  173.    endfor
  174.  
  175.  
  176. defproc experror
  177.    sayerror SYNTAX_ERROR__MSG
  178.  
  179.  
  180. /* Dec2Hex       Usage:  HexStringOut=Dec2Hex(DecimalIn)          */
  181. /*               Result will be a string beginning with 'x'.      */
  182. /*  If decimal number is invalid, null string is returned.        */
  183. defproc dec2hex
  184.    if arg(2)<>'' then base=arg(2);output='o' else base=16;output='x' endif
  185.    if base='' then base=16 endif
  186.    dec=arg(1)
  187.    if not isnum(dec) then
  188.       return ''
  189.    endif
  190.    if dec<0 then
  191.       dec=dec+ MAXINT+1
  192.    endif
  193.    vhex=''
  194.    while dec>0 do
  195.       i=dec%base
  196.       vhex=substr('0123456789ABCDEF',dec-i*base+1,1)vhex
  197.       dec=i
  198.    endwhile
  199.    if vhex='' then
  200.       vhex='0'
  201.    endif
  202.    if arg(1)<0 then
  203.       if base=8 then
  204.          vhex='1'vhex
  205.       else
  206.          vhex='F'substr(vhex,2)
  207.       endif
  208.    endif
  209.    return output||vhex
  210.  
  211.  
  212. /* Hex2Dec       Usage:  DecimalOut=Hex2Dec(HexStringIn)                   */
  213. /*                       where HexStringIn may optionally begin with 'X'.  */
  214. /*  If hex number is invalid, null string is returned.                     */
  215. defproc hex2dec
  216.    if arg(2)<>'' then base=arg(2) else base=16 endif
  217.    vhex=arg(1)
  218.    if vhex='' then
  219.       return ''
  220.    endif
  221.    dec=0
  222.    loop
  223.       i=upcase(substr(vhex,1,1))
  224.       if i='' then leave endif
  225.       if i<>'X' then                     /* Ignore initial X if any. */
  226.          i=pos(i,'0123456789ABCDEF')
  227.          if not i then
  228.             return ''
  229.          endif
  230.          dec=dec*base -1 +i
  231.       endif
  232.       vhex=substr(vhex,2)
  233.    endloop
  234.    return dec
  235.  
  236. defproc lex_number
  237.    universal input,i
  238.    universal sym
  239.    universal j
  240.  
  241.    if not j then j=length(input)+1 endif
  242.    sym=substr(input,i+1,j-i-1)
  243.    sym=hex2dec(sym,arg(1))
  244.    if sym=='' then
  245.       call experror();stop
  246.    endif
  247.    i=j
  248.  
  249. defproc next_sym
  250.    universal sym
  251.    universal input,i
  252.    universal j
  253.  
  254.    call skip_spaces()
  255.    if i>length(input) then sym='$';return '' endif
  256.    sym=substr(input,i,1)
  257.    if pos(sym,'Oo\xX0123456789+-/%*()'DECIMAL) then
  258.       if isnum(sym) then
  259.          j=verify(input,'0123456789'DECIMAL,'',i)
  260.          if not j then j=length(input)+1 endif
  261.          sym=substr(input,i,j-i)
  262. compile if 0 & DECIMAL <> '.'  -- work in progress...
  263.          i = pos(DECIMAL, sym)
  264.          if i then
  265.             sym = overlay('.', sym, i)
  266.          endif
  267. compile endif  -- DECIMAL <> '.'
  268.          i=j
  269.       elseif upcase(sym)='X' then
  270.          j=verify(input,'0123456789ABCDEFabcdef','',i+1)
  271.          call lex_number(16)
  272.       elseif upcase(sym)='O' or sym='\' then
  273.          j=verify(input,'01234567','',i+1)
  274.          call lex_number(8)
  275.       else
  276.          i=i+1
  277.          if sym='/' & substr(input,i,1)='/' then
  278.             sym = '?'  -- Use '?' to represent '//'
  279.             i=i+1
  280.          endif
  281.       endif
  282.    else
  283.       call experror();stop
  284.    endif
  285.  
  286. defproc prec
  287.    /* Group operators in 4's so +- and *%/? each have same precedence. */
  288.    return pos(arg(1),'$  +-  *%/?')%4+1
  289.  
  290. defproc reduce_dualop
  291.    universal exp_stack
  292.    parse value exp_stack with e2 e1 exp_stack
  293.    if arg(1)='+' then
  294.       exp_stack=e1+e2 exp_stack
  295.    elseif arg(1)='-' then
  296.       exp_stack=e1-e2 exp_stack
  297.    elseif arg(1)='*' then
  298.       exp_stack=e1*e2 exp_stack
  299.    elseif arg(1)='/' then
  300.       exp_stack=e1/e2 exp_stack
  301.    elseif arg(1)='%' then
  302.       exp_stack=e1%e2 exp_stack
  303.    elseif arg(1)='?' then
  304.       exp_stack=e1//e2 exp_stack
  305.    endif
  306.  
  307. defproc skip_spaces
  308.    universal input,i
  309.    j=verify(input,' ','',i)
  310.    if j then
  311.       i=j
  312.    else
  313.       i=length(input)+1
  314.    endif
  315.  
  316. defproc unary_exp
  317.    universal exp_stack
  318.    universal sym
  319.  
  320.    if sym='(' then
  321.       call next_sym()
  322.       call exp(arg(1))
  323.       if sym<>')' then experror();stop endif
  324.       call next_sym()
  325.    elseif isnum(sym) then
  326.       exp_stack=sym exp_stack
  327.       call next_sym()
  328.    elseif sym='-' then
  329.       call next_sym()
  330.       call unary_exp(arg(1))
  331.       parse value exp_stack with e1 exp_stack
  332.       exp_stack=-e1 exp_stack
  333.    elseif sym='+' then
  334.       call next_sym()
  335.       call unary_exp()
  336.    else
  337.       call experror();stop
  338.    endif
  339.  
  340.