home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 5 Edit / 05-Edit.zip / epmmac.zip / MATH.E < prev    next >
Text File  |  1995-09-21  |  15KB  |  507 lines
  1. ; MATH.E      Combines old MATH.E and EXP.E.
  2. ;
  3. ;  Linking version for EOS2:  The bulk of the old MATH.E routines are
  4. ;  placed in another file MATHLIB.E, which is linked only when needed.
  5. ;
  6. define math_link = not (INCLUDE_MATHLIB or E3 or EXTRA_EX or EVERSION >= '6.00c')
  7.  
  8. defc add=
  9.  compile if MATH_LINK
  10.    --- For linking version:  make sure the base routines are linked in.
  11.    link 'mathlib'
  12.    if RC<0 then
  13.       sayerror UNABLE_TO_LINK__MSG 'MathLib'
  14.       return
  15.    endif
  16.  compile endif
  17.  compile if not E3
  18.    if marktype()=='' then
  19.       'xcom L /[0-9]/g'      -- find first number
  20.       if rc then
  21.          sayerror "Can't find a number (from cursor position to end of file)"
  22.          return
  23.       endif
  24.       call psave_pos(save_pos)
  25.       markline
  26.       for i=.line+1 to .last  -- find first line without a number
  27.          if not verify(textline(i),'0123456789','M') then
  28.             leave
  29.          endif
  30.       endfor
  31.       .line=i-1; markline
  32.       call column_math('+')
  33.       unmark        -- Started with no mark
  34.       call prestore_pos(save_pos)
  35.    else
  36.       getmark firstline,lastline,firstcol,lastcol,markfileid
  37.       getfileid fileid
  38.       if fileid<>markfileid then
  39.          sayerror OTHER_FILE_MARKED__MSG UNMARK_OR_EDIT__MSG markfileid.filename
  40.          return
  41.       endif
  42.       if not check_mark_on_screen() then
  43.          sayerror MARK_OFF_SCREEN2__MSG
  44.          return
  45.       endif
  46.  compile else  -- else *is* E3
  47.    call checkmark()
  48.  compile endif
  49.    call column_math('+')
  50.  compile if not E3
  51.   endif
  52.  compile endif
  53.  
  54. defc math=
  55.    call mathcommon(arg(1),'')
  56.  
  57. defc matho=
  58.    call mathcommon(arg(1),'o')
  59.  
  60. defc mathx=
  61.    call mathcommon(arg(1),'x')
  62.  
  63. defc mult=
  64.    call checkmark()
  65.  compile if MATH_LINK
  66.    --- For linking version:  make sure the base routines are linked in.
  67.    link 'mathlib'
  68.    if RC<0 then
  69.       sayerror UNABLE_TO_LINK__MSG 'MathLib'
  70.       return
  71.    endif
  72.  compile endif
  73.    call column_math('*')
  74.  
  75. defproc mathcommon(input,suffix)
  76.  compile if MATH_LINK
  77.    --- For linking version:  make sure the base routines are linked in.
  78.    link 'mathlib'
  79.    if RC<0 then
  80.       sayerror UNABLE_TO_LINK__MSG 'MathLib'
  81.       return
  82.    endif
  83.  compile endif
  84.    if evalinput(result,input,suffix) then
  85.       call experror();stop
  86.    else
  87. compile if EVERSION < 5
  88.       setcommand 'math'suffix input'= 'result
  89. compile else
  90.       sayerror 'math'suffix input'= 'result  -- no setcommand in epm
  91. compile endif
  92.    endif
  93.  
  94. compile if not E3  -- Probably not enough space if we can't link ...
  95.  compile if DECIMAL = ','
  96.    define thou_sep = '.'
  97.  compile else
  98.    define thou_sep = ','
  99.  compile endif
  100.  
  101. defc mathin  -- Like MATH command, but keys in the result
  102.  compile if MATH_LINK
  103.    --- For linking version:  make sure the base routines are linked in.
  104.    link 'mathlib'
  105.    if rc<0 then
  106.       sayerror UNABLE_TO_LINK__MSG 'MathLib'
  107.       return
  108.    endif
  109.  compile endif
  110.    if word(arg(1), 1) = thou_sep then
  111.       parse value arg(1) with sep input
  112.    else
  113.       input = arg(1)
  114.       sep = ''
  115.    endif
  116.    if evalinput(result,input,'') then
  117.       call experror(); stop
  118.    endif
  119.    sayerror 'math' input'= 'result  -- no setcommand in epm
  120.    if sep & (result > 9999) then
  121.       -- parse value result with whole (DECIMAL) fract
  122.       p = pos(DECIMAL, result)
  123.       if p then
  124.          whole = leftstr(result, p-1)
  125.          fract = substr(result, p+1)
  126.       else
  127.          whole = result
  128.          fract = ''
  129.       endif
  130.       outstr = ''
  131.       do while length(whole) > 3
  132.          outstr = outstr || thou_sep || rightstr(whole, 3)
  133.          whole = leftstr(whole, length(whole)-3)
  134.       enddo
  135.       result = whole || outstr
  136.       if fract then
  137.          result = result || DECIMAL || fract
  138.       endif
  139.    endif
  140.    keyin result
  141.  
  142. defc mathxin  -- Like MATHX command, but keys in the result
  143.  compile if MATH_LINK
  144.    --- For linking version:  make sure the base routines are linked in.
  145.    link 'mathlib'
  146.    if rc<0 then
  147.       sayerror UNABLE_TO_LINK__MSG 'MathLib'
  148.       return
  149.    endif
  150.  compile endif
  151.    input = arg(1)
  152.    if evalinput(result, input, 'x') then
  153.       call experror(); stop
  154.    endif
  155.    sayerror 'mathx' input'= 'result  -- no setcommand in epm
  156.    keyin '0x'rightstr(substr(result, 2), 8, 0)
  157. compile endif -- not E3
  158.  
  159. ;  The rest is the same as MATHLIB.E.  Must be compiled into base if we're
  160. ;  not running the linking version of EOS2 (unless INCLUDE_MATHLIB set).
  161. compile if not MATH_LINK
  162.  
  163. defproc column_math
  164.    getmark firstline,lastline,firstcol,lastcol,fileid
  165.    result = arg(1)='*'   -- Result = 1 if '*', or 0 if '+'
  166. ;  if arg(1)='+' then
  167. ;     result=0
  168. ;  else
  169. ;    result=1
  170. ;  endif
  171. compile if not E3
  172.    decimal_flag = 0
  173. compile endif
  174.  
  175.    call pinit_extract()
  176.    loop
  177.       code = pextract_string(line)
  178.       if code = 1 then leave endif
  179.       if code = 0 then  /* ignore blank lines */
  180.          -- Find the number within the line.  Frees the user from having
  181.          -- to have a perfectly-fitting block mark around the numbers.
  182.          -- jbl 12/20/88 bug fix:  line might start with minus sign or decimal.
  183.          -- LAM: The Parse was using only the first number on each line.
  184. compile if E3
  185.          startnum = verify(line,'0123456789-','M')
  186. compile else
  187.          startnum = verify(line,'0123456789-'DECIMAL,'M')
  188. compile endif
  189.          if startnum then
  190. ;           parse value substr(line,startnum) with line .
  191.             line = substr(line,startnum)
  192.          endif
  193.          if evalinput(tempresult, line, '',arg(1)) then
  194.             call experror()
  195.          else
  196.             if arg(1)='+' then
  197. compile if not E3
  198.                if pos('.',tempresult) then
  199.                   decimal_flag = max(length(tempresult)-pos('.',tempresult), decimal_flag)
  200.                endif
  201. compile endif
  202.                result=result+tempresult
  203.             else
  204.                result=result*tempresult
  205.             endif
  206.          endif
  207.       endif
  208.    endloop
  209. compile if not E3
  210.    if decimal_flag then  -- LAM:  Merge in CHC changes
  211.       if pos('.',result) then   -- there's a decimal but the final zero is gone
  212.          result = result || copies(0, decimal_flag - (length(result)-pos('.',result)))
  213.       else
  214.          result = result'.'copies(0, decimal_flag)
  215.       endif
  216.    endif
  217.    -- Line up with decimal point of last line if there is one, else line up
  218.    -- by the last digit of last line.  The old way lined up by the first digit
  219.    -- which was seldom desirable:
  220.    --insertline substr('',1,firstcol-1)result,lastline+1,fileid
  221. compile endif
  222.    res_len = length(result)
  223. compile if not E3
  224.    p = pos(DECIMAL,result)
  225.    if p then
  226.       q = pos(DECIMAL,line)
  227.       if q then
  228.          lpad = startnum+q-p-1
  229.       else
  230.          lpad = startnum+length(line)-p
  231.       endif
  232.    else
  233. compile endif
  234.       lpad = startnum+length(line)-res_len-1
  235. compile if not E3
  236.    endif
  237. compile endif
  238.  
  239.    -- jbl 12/11/88:  make it work with or without a marked area.
  240.    lpad = max(lpad + firstcol -1, 0)
  241.  
  242.    -- If the next line has spaces in the proper posiition, fill them,
  243.    -- don't insert a new line.
  244.    if lastline<.last then
  245.       getline line, lastline+1
  246.    else
  247.       line=''
  248.    endif
  249.    -- If the next line is all same character, like a dotted line, skip over.
  250.    dash = substr(line, lpad+1, res_len)
  251.    ch = substr(dash,1,1)
  252.    if not verify(dash,ch) & ch<>' ' then
  253.       lastline=lastline+1
  254.       if lastline<.last then
  255.          getline line, lastline+1
  256.       endif
  257.    endif
  258.    if not verify(substr(line,lpad+1,res_len),' ') & lastline<.last then
  259. compile if not E3
  260.       replaceline overlay(result,line,lpad+1), lastline+1
  261. compile else                                       -- No overlay() in E3
  262.       replaceline substr(line,1,lpad) || result || substr(line,lpad+res_len+1),
  263.                   lastline+1
  264. compile endif
  265.    else
  266.       pad = substr(' ',1,lpad)
  267.       insertline pad || result,lastline+1,fileid
  268.    endif
  269.  
  270.  
  271. /* returns 0 if expression evaluated successfully. */
  272. /* result is set to evaluation of expression when successful */
  273. /* returns 1 if error.  No message displayed */
  274. defproc evalinput(var result,var sourceline,output)
  275.    universal i,input
  276.    universal exp_stack
  277.    universal sym
  278.  
  279.    exp_stack=''
  280.    i=pos('=',sourceline)
  281.    if i then
  282.       sourceline=substr(sourceline,1,i-1)
  283.    endif
  284.    input=sourceline
  285.    i=1; call next_sym()
  286.    call exp(arg(4))  -- Accept & pass to exp an optional 4th argument
  287.    if sym<>'$' then
  288.       return 1
  289.    else
  290.       result=strip(exp_stack)
  291.       if output='x' then
  292.          result=dec2hex(result)
  293.       elseif output='o' then
  294.          result=dec2hex(result,8)
  295.       endif
  296.       return 0
  297.    endif
  298.  
  299.  
  300. ;  EXP takes an optional argument saying what the default operator
  301. ;  should be.  (I.e., what operator should be assumed if 2 numbers appear one
  302. ;  after the other).  If not given, error.  ('+' was assumed previously.)
  303. defproc exp
  304.    universal sym
  305.    op_stack='$'
  306.    loop
  307.       call unary_exp(arg(1))   -- Pass to unary_exp, because it calls us.
  308.       /* look for dual operator */
  309.       if pos(sym,'+-*%/?') then
  310.          oldsym=''
  311.       else
  312.          if not isnum(sym) & sym<>'(' then  -- '(' OK for column math.
  313.             leave
  314.          endif
  315.          oldsym=sym
  316.          if arg(1) then sym=arg(1); else call experror(); stop; endif
  317.       endif
  318.       while prec(substr(op_stack,length(op_stack)))>=prec(sym) do
  319.          call reduce_dualop(substr(op_stack,length(op_stack)))
  320.          op_stack=substr(op_stack,1,length(op_stack)-1)
  321.       endwhile
  322.       op_stack=op_stack||sym
  323.       if oldsym='' then
  324.          call next_sym()
  325.       else
  326.          sym=oldsym
  327.       endif
  328.    endloop
  329.    for j=length(op_stack) to 2 by -1
  330.       call reduce_dualop(substr(op_stack,j,1))
  331.    endfor
  332.  
  333.  
  334. defproc experror
  335.    sayerror SYNTAX_ERROR__MSG
  336.  
  337.  
  338. /* Dec2Hex       Usage:  HexStringOut=Dec2Hex(DecimalIn)          */
  339. /*               Result will be a string beginning with 'x'.      */
  340. /*  If decimal number is invalid, null string is returned.        */
  341. defproc dec2hex
  342.    if arg(2)<>'' then base=arg(2);output='o' else base=16;output='x' endif
  343.    if base='' then base=16 endif
  344.    dec=arg(1)
  345.    if not isnum(dec) then
  346.       return ''
  347.    endif
  348.    if dec<0 then
  349.       dec=dec+ MAXINT+1
  350.    endif
  351.    vhex=''
  352.    while dec>0 do
  353.       i=dec%base
  354.       vhex=substr('0123456789ABCDEF',dec-i*base+1,1)vhex
  355.       dec=i
  356.    endwhile
  357.    if vhex='' then
  358.       vhex='0'
  359.    endif
  360.    if arg(1)<0 then
  361.       if base=8 then
  362.          vhex='1'vhex
  363.       else
  364.          vhex='F'substr(vhex,2)
  365.       endif
  366.    endif
  367.    return output||vhex
  368.  
  369.  
  370. /* Hex2Dec       Usage:  DecimalOut=Hex2Dec(HexStringIn)                   */
  371. /*                       where HexStringIn may optionally begin with 'X'.  */
  372. /*  If hex number is invalid, null string is returned.                     */
  373. defproc hex2dec
  374.    if arg(2)<>'' then base=arg(2) else base=16 endif
  375.    vhex=arg(1)
  376.    if vhex='' then
  377.       return ''
  378.    endif
  379.    dec=0
  380.    loop
  381.       i=upcase(substr(vhex,1,1))
  382.       if i='' then leave endif
  383.       if i<>'X' then                     /* Ignore initial X if any. */
  384.          i=pos(i,'0123456789ABCDEF')
  385.          if not i then
  386.             return ''
  387.          endif
  388.          dec=dec*base -1 +i
  389.       endif
  390.       vhex=substr(vhex,2)
  391.    endloop
  392.    return dec
  393.  
  394. defproc lex_number
  395.    universal input,i
  396.    universal sym
  397.    universal j
  398.  
  399.    if not j then j=length(input)+1 endif
  400.    sym=substr(input,i+1,j-i-1)
  401.    sym=hex2dec(sym,arg(1))
  402.    if sym=='' then
  403.       call experror();stop
  404.    endif
  405.    i=j
  406.  
  407. defproc next_sym
  408.    universal sym
  409.    universal input,i
  410.    universal j
  411.  
  412.    call skip_spaces()
  413.    if i>length(input) then sym='$';return '' endif
  414.    sym=substr(input,i,1)
  415. compile if EVERSION >= 4            -- OS/2 version - real numbers
  416.    if pos(sym,'Oo\xX0123456789+-/%*()'DECIMAL) then
  417. compile else                        -- DOS version - integers only
  418.    if pos(sym,'Oo\xX0123456789+-/%*()') then
  419. compile endif
  420.       if isnum(sym) then
  421. compile if EVERSION >= 4            -- OS/2 version
  422.          j=verify(input,'0123456789'DECIMAL,'',i)
  423. compile else                        -- DOS version
  424.          j=verify(input,'0123456789','',i)
  425. compile endif
  426.          if not j then j=length(input)+1 endif
  427.          sym=substr(input,i,j-i)
  428. compile if 0 -- DECIMAL <> '.'  -- work in progress...
  429.          i = pos(DECIMAL, sym)
  430.          if i then
  431.             sym = overlay('.', sym, i)
  432.          endif
  433. compile endif  -- DECIMAL <> '.'
  434.          i=j
  435.       elseif upcase(sym)='X' then
  436.          j=verify(input,'0123456789ABCDEFabcdef','',i+1)
  437.          call lex_number(16)
  438.       elseif upcase(sym)='O' or sym='\' then
  439.          j=verify(input,'01234567','',i+1)
  440.          call lex_number(8)
  441.       else
  442.          i=i+1
  443.          if sym='/' & substr(input,i,1)='/' then
  444.             sym = '?'  -- Use '?' to represent '//'
  445.             i=i+1
  446.          endif
  447.       endif
  448.    else
  449.       call experror();stop
  450.    endif
  451.  
  452. defproc prec
  453.    /* Group operators in 4's so +- and *%/? each have same precedence. */
  454.    return pos(arg(1),'$  +-  *%/?')%4+1
  455.  
  456. defproc reduce_dualop
  457.    universal exp_stack
  458.    parse value exp_stack with e2 e1 exp_stack
  459.    if arg(1)='+' then
  460.       exp_stack=e1+e2 exp_stack
  461.    elseif arg(1)='-' then
  462.       exp_stack=e1-e2 exp_stack
  463.    elseif arg(1)='*' then
  464.       exp_stack=e1*e2 exp_stack
  465.    elseif arg(1)='/' then
  466.       exp_stack=e1/e2 exp_stack
  467.    elseif arg(1)='%' then
  468.       exp_stack=e1%e2 exp_stack
  469.    elseif arg(1)='?' then
  470.       exp_stack=e1//e2 exp_stack
  471.    endif
  472.  
  473. defproc skip_spaces
  474.    universal input,i
  475.    j=verify(input,' ','',i)
  476.    if j then
  477.       i=j
  478.    else
  479.       i=length(input)+1
  480.    endif
  481.  
  482. defproc unary_exp
  483.    universal exp_stack
  484.    universal sym
  485.  
  486.    if sym='(' then
  487.       call next_sym()
  488.       call exp(arg(1))
  489.       if sym<>')' then experror();stop endif
  490.       call next_sym()
  491.    elseif isnum(sym) then
  492.       exp_stack=sym exp_stack
  493.       call next_sym()
  494.    elseif sym='-' then
  495.       call next_sym()
  496.       call unary_exp(arg(1))
  497.       parse value exp_stack with e1 exp_stack
  498.       exp_stack=-e1 exp_stack
  499.    elseif sym='+' then
  500.       call next_sym()
  501.       call unary_exp()
  502.    else
  503.       call experror();stop
  504.    endif
  505.  
  506. compile endif -- not MATH_LINK
  507.