home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / addeg.zip / adde.cmd next >
OS/2 REXX Batch file  |  1996-11-07  |  19KB  |  494 lines
  1. /* OS/2-REXX-Program Adde.CMD, 06.11.1996  */
  2. Call RxFuncAdd 'SysLoadFuncs', RexxUtil, 'SysLoadFuncs'
  3. Call SysLoadFuncs
  4. "@ echo off"
  5. numeric digits 16
  6. Call SysCls
  7. say
  8. Call CsrAttrib "High";   Call Color "YELLOW","BLACK"
  9. Call Charout,"  A Simple Addition Program for Values of Invoices or Any Costs of Daily Life"; say
  10. Call Charout,"  ==========================================================================="; say
  11. Call CsrAttrib "Normal"
  12. Call Charout,"                 whose "
  13. Call CsrAttrib "High";     Call Color "magenta"
  14. Call Charout,"absolute values"
  15. Call CsrAttrib "Normal"
  16. Call Charout," are larger than 1.0E-6"; say
  17. Call Charout,"                                      and smaller than 1.0E+6"; say
  18. Call Charout,"                                          or exact equal Zero."; say; say
  19. Call Charout,"First type the label of the invoice or something similar"; say
  20. Call Charout,"-- with no more than 40 characters (includung blanks) -- and hit the Enter key."; say; say
  21. Call Charout,"Then type the value of the invoice or something similar"; say
  22. Call Charout,"-- if it is a decimal fraction with decimal point or decimal comma -- "; say
  23. Call Charout,"and hit the Enter key."; say; say
  24. Call Charout,"If You hit the Enter key twice without typing something before";say
  25. Call Charout,"the addition procedure will be finished.";say;say;say
  26. Call Charout,"                                                                     value     ";say
  27. Call Charout,"  label                                          value               of the    ";say
  28. Call Charout,"  of the                                         of the              interim   ";say
  29. Call Charout,"  invoice                                        invoice               sum     ";say
  30. Call Charout,"========================================║======================================"
  31. say
  32.  
  33. "del" SUM.DAT "1>NUL 2>NUL"
  34.  
  35. /* Writing header in the file SUM.DAT */
  36. ret=LineOut(SUM.DAT, "                                                                   valuee      ")
  37. ret=LineOut(SUM.DAT, "  label                                        value               of the      ")
  38. ret=LineOut(SUM.DAT, "  of the                                       of the              interim     ")
  39. ret=LineOut(SUM.DAT, "  invoice                                      invoice               sum       ")
  40. ret=LineOut(SUM.DAT, "========================================║======================================")
  41. ret=LineOut(SUM.DAT, "" )
  42.  
  43. n=1; x.1=0; x.0=0; s.0=0; p=0;
  44.  
  45. wieder:
  46. ret=SysCurState("ON")
  47.   Call Charout,"                                                                              "
  48.   Call CsrLeft 78
  49.   /* pulling label */
  50.   parse pull txt
  51.   /* Too much characters */
  52.   if length(txt) > 40 then signal AnzTXT
  53.  
  54. weiter:
  55.   ret=SysCurState("ON")
  56.   /* pulling value */
  57.   pull x
  58.  
  59.   /* If x was typed with a decimal comma                */
  60.   /* the position of the decimal comma will be defined  */
  61.   sop = Pos(",", x)
  62.  
  63.   /* If x was typed with a decimal comma                */
  64.   /* ist  sop <> 0.  In this case the decimal comma     */
  65.   /* will be replaced by a dezimal point.               */
  66.   if sop <> 0 then x = OverLay(".", x, sop)
  67.  
  68.   /* Hittig the Enter key closes Adde.CMD */
  69.   if length(x) == 0 then signal AnzErg
  70.  
  71.   /* Warning after pulling a string which is no REXX-number */
  72.   if datatype(x) == CHAR then signal Anz1
  73.   /* Warning after pulling too much figures */
  74.   if length(x) > 13 then signal Anz2
  75.   /* Warning after pulling a value                  */
  76.   /* which absolute value is larger than 1.0E+0006  */
  77.   if abs(x) > 1.0E+0006 then signal Anz3
  78.   /* The value 0 is allowed */
  79.   if abs(x) = 0 then signal www
  80.   /* Warning after pulling a value                  */
  81.   /* which absolute value is smaller than 1.0E-0006 */
  82.   if abs(x) < 1.0E-0006 then signal Anz4
  83.   www:
  84.   s.n = s.p + x
  85.   if abs(s.n) >= 1.0E0007 then Call Zuviel
  86.   /* Showing on screen */
  87.   Call CsrUp 2
  88.   Call Charout,txt
  89.   ll1=44-length(txt)
  90.   i=1
  91.   zw1=""; zw0=" ";
  92.   do while i < ll1
  93.     zw1=zw1||zw0
  94.     i=i+1
  95.   end
  96.  
  97.   Call Charout,zw1; Call Charout,format(x, 8)
  98.   /* Creating a string  zw  which length depends from the numbers */
  99.   /* of figures including the sign and a decimal point            */
  100.   /* or a decimal comma                                           */
  101.   lz = length(format(x, 8, 7)) - length(format(x, 8))
  102.   ll = 8+lz
  103.   i=1
  104.   zw=""; zw0=" ";
  105.   do while i < ll
  106.     zw=zw||zw0
  107.     i=i+1
  108.   end
  109.  
  110.   /* still showing on screen */
  111.   Call CsrAttrib "High";     Call Color "white"
  112.   Call Charout,zw;       Call Charout,format(s.n, 8, 2);
  113.   Call CsrAttrib "Normal";
  114.   say
  115.  
  116.   ll2=43-length(txt)
  117.   i=1
  118.   zw2=""; zw0=" ";
  119.   do while i < ll2
  120.     zw2=zw2||zw0
  121.     i=i+1
  122.   end
  123.  
  124.   ll3=8+lz
  125.   i=1
  126.   zw3=""; zw0=" ";
  127.   do while i < ll3
  128.     zw3=zw3||zw0
  129.     i=i+1
  130.   end
  131.  
  132.   str=txt||zw2||format(x, 8)||zw3||format(s.n, 8, 2)
  133.   ret1=LineOut(SUM.DAT, str)
  134.   n=n+1; p=n-1
  135.   signal wieder
  136.  
  137.  
  138. ende:
  139. /* The command "call charout(SUM.DAT)" is necessary          */
  140. /* because otherwise the file  SUM.DAT  could not be deleted */
  141. call charout(SUM.DAT)
  142. "del" SUM.DAT "1>NUL 2>NUL"
  143. Call SysCls
  144. EXIT
  145.  
  146. /*************************** eigene Prozeduren ******************************/
  147.  
  148. AnzTXT:
  149.   say
  150.   ret=SysCurState("OFF")
  151.   Call CsrAttrib "High";   Call Color "white"
  152.   Call Charout,"You typed too much symbols or blanks !"; say; say
  153.   Call CsrAttrib "Normal"
  154.   Call Charout,"Hit the Enter key and repeat typing the label of the invoice."; say
  155.   Call Charout,"Please do not type more than 40 characters (symbols or blanks)."; say
  156.   Beep(444, 200); Beep(628,300)
  157.   pull
  158.   Call CsrUp 5
  159.   Call Charout,"                                                                             ";say
  160.   Call Charout,"                                                                             ";say
  161.   Call Charout,"                                                                             ";say
  162.   Call Charout,"                                                                             ";say
  163.   Call Charout,"                                                                             ";say
  164.   Call CsrUp 7
  165.   Call Charout,"                                                                              "
  166.   Call CsrLeft 78
  167.   signal wieder
  168.  
  169.  
  170.  
  171. Anz1:
  172.   say
  173.   ret=SysCurState("OFF")
  174.   Call CsrAttrib "High";   Call Color "white"
  175.   Call Charout,"You typed the number in a wrong format !"; say; say
  176.   Call CsrAttrib "Normal"
  177.   Call Charout,"Hit the Enter key and repeat typing of the value of the invoice."; say
  178.   Beep(444, 200); Beep(628,300)
  179.   pull
  180.   Call CsrUp 4
  181.   Call Charout,"                                                                             ";say
  182.   Call Charout,"                                                                             ";say
  183.   Call Charout,"                                                                             ";say
  184.   Call Charout,"                                                                             ";say
  185.   Call CsrUp 6
  186.   Call Charout,"                                                                              "
  187.   Call CsrLeft 78
  188.   signal weiter
  189.  
  190. Anz2:
  191.   say
  192.   ret=SysCurState("OFF")
  193.   Call CsrAttrib "High";   Call Color "white"
  194.   Call Charout,"Yoe have typed too much figures or blanks !"; say; say
  195.   Call CsrAttrib "Normal"
  196.   Call Charout,"Hit the Enter key and repeat typing of the value of the invoice."; say
  197.   Beep(444, 200); Beep(628,300)
  198.   pull
  199.   Call CsrUp 4
  200.   Call Charout,"                                                                             ";say
  201.   Call Charout,"                                                                             ";say
  202.   Call Charout,"                                                                             ";say
  203.   Call Charout,"                                                                             ";say
  204.   Call CsrUp 6
  205.   Call Charout,"                                                                              "
  206.   Call CsrLeft 78
  207.   signal weiter
  208.  
  209. Anz3:
  210.   say
  211.   ret=SysCurState("OFF")
  212.   Call CsrAttrib "High";   Call Color "white"
  213.   Call Charout,"The absolute value of the number You typed is larger than "
  214.                            Call Color "CYAN"
  215.   Call Charout,"1.0E+6"
  216.                            Call Color "white"
  217.   Call Charout," !"; say
  218.   Call Charout,"This value can not be used in this simple addition procedure."; say; say
  219.   Call CsrAttrib "Normal"
  220.   Call Charout,"Hit the Enter key and repeat typing of the value of the invoice."; say
  221.   Beep(444, 200); Beep(628,300)
  222.   pull
  223.   Call CsrUp 5
  224.   Call Charout,"                                                                             ";say
  225.   Call Charout,"                                                                             ";say
  226.   Call Charout,"                                                                             ";say
  227.   Call Charout,"                                                                             ";say
  228.   Call Charout,"                                                                             ";say
  229.   Call CsrUp 7
  230.   Call Charout,"                                                                              "
  231.   Call CsrLeft 78
  232.   signal weiter
  233.  
  234. Anz4:
  235.   say
  236.   ret=SysCurState("OFF")
  237.   Call CsrAttrib "High";   Call Color "white"
  238.   Call Charout,"The absolute value of the number You typed"; say
  239.   Call Charout,"is greater than "
  240.                            Call Color "CYAN"
  241.   Call Charout,"Zero"
  242.                            Call Color "white"
  243.   Call Charout," and smaller than "
  244.                            Call Color "CYAN"
  245.   Call Charout,"1.0E-6"
  246.                            Call Color "white"
  247.   Call Charout," !"; say
  248.   Call Charout,"This value can not be used in this simple addition procedure."; say; say
  249.   Call CsrAttrib "Normal"
  250.   Call Charout,"Hit the Enter key and repeat typing of the value of the invoice."; say
  251.   Beep(444, 200); Beep(628,300)
  252.   pull
  253.   Call CsrUp 6
  254.   Call Charout,"                                                                              ";say
  255.   Call Charout,"                                                                              ";say
  256.   Call Charout,"                                                                              ";say
  257.   Call Charout,"                                                                              ";say
  258.   Call Charout,"                                                                              ";say
  259.   Call Charout,"                                                                              ";say
  260.   Call CsrUp 8
  261.   Call Charout,"                                                                              "
  262.   Call CsrLeft 78
  263.   signal weiter
  264.  
  265.  
  266. Zuviel:
  267.   say
  268.   ret=SysCurState("OFF")
  269.   Call CsrAttrib "High";   Call Color "white"
  270.   Call Charout,"The absolute value of the result would reach or exceed "
  271.                            Call Color "CYAN"
  272.   Call Charout,"1.0E+7"
  273.                            Call Color "white"
  274.   Call Charout," !"; say
  275.   Call Charout,"This value can not be used in this simple addition procedure."; say; say
  276.   Call CsrAttrib "Normal"
  277.   Call Charout,"Hit the Enter key and repeat typing of the value of the invoice."; say
  278.   Beep(444, 200); Beep(628,300)
  279.   pull
  280.   Call CsrUp 5
  281.   Call Charout,"                                                                              ";say
  282.   Call Charout,"                                                                              ";say
  283.   Call Charout,"                                                                              ";say
  284.   Call Charout,"                                                                              ";say
  285.   Call Charout,"                                                                              ";say
  286.   Call CsrUp 7
  287.   Call Charout,"                                                                              "
  288.   Call CsrLeft 78
  289.   signal weiter
  290.  
  291. AnzErg:
  292.   say
  293.   Call CsrAttrib "High";   Call Color "white"
  294.   Call Charout,"The value of the resulting sum";say
  295.   Call Charout,"of the "
  296.                            Call Color "green"
  297.   n=n-1
  298.   Call Charout,n
  299.                            Call Color "white"
  300.   Call Charout," typed values is: "
  301.                            Call Color "YELLOW"
  302.   Call Charout,s.n
  303.   Call CsrAttrib "Normal"; say
  304.  
  305.   strErg1="The value of the resulting sum              "
  306.   strErg2="of the typed values is:                     "||format(s.n, 8, 7)
  307.   strErg3="                                            "
  308.   strErg4="Value of the resulting sum:                 "||format(s.n, 8, 2)
  309.   strErg5="(rounded up to 2 figures                    "
  310.   strErg6=" after the decimal point)                   "
  311.  
  312.   ret=LineOut(SUM.DAT, "")
  313.   ret=LineOut(SUM.DAT, strErg1)
  314.   ret=LineOut(SUM.DAT, strErg2)
  315.   ret=LineOut(SUM.DAT, strErg3)
  316.   ret=LineOut(SUM.DAT, strErg4)
  317.   ret=LineOut(SUM.DAT, strErg5)
  318.   ret=LineOut(SUM.DAT, strErg6)
  319.   ret=LineOut(SUM.DAT, "")
  320.  
  321.   say
  322.   Call Charout,"Would You like to see once more the resulting sum"; say
  323.   Call Charout,"together with all values of the interim sums with the aid of the "
  324.  
  325.   Call CsrAttrib "High";   Call Color "cyan"
  326.   Call Charout,"EPM-EDITOR"; say
  327.  
  328.   Call CsrAttrib "Normal"
  329.   Call Charout,"and -- if required -- to print them ? (y/*) "; pull x
  330.  
  331.   select
  332.   when x == 'Y' then
  333.   do
  334.     Call SysCls
  335.     ret=SysCurState("OFF")
  336.     Call CsrAttrib "High";   Call Color "white","blue"
  337.     Call Locate  5,  2
  338.     Call Charout,"╔════════════════════════════════════════════════════════════════════════════╗"
  339.     Call Locate  6,  2
  340.     Call Charout,"║                                                                            ║"
  341.     Call Locate  7,  2
  342.     Call Charout,"║   In the "
  343.                              Call Color "yellow"
  344.     Call Charout,"options"
  345.                              Call Color "white"
  346.     Call Charout," of the "
  347.                              Call Color "cyan"
  348.     Call Charout,"EPM EDITOR"
  349.                              Call Color "white"
  350.     Call Charout,"                                         ║"; say
  351.     Call Locate  8,  2
  352.     Call Charout,"║   he following point should be activated:"
  353.                              Call Color "yellow"
  354.     Call Charout,"   font: "
  355.                              Call Color "green"
  356.     Call Charout," Courier Bitmap 13*8"
  357.                              Call Color "white","blue"
  358.     Call Charout,"     ║"
  359.     Call Locate  9,  2
  360.     Call Charout,"║                                                                            ║"
  361.     Call Locate 10,  2
  362.     Call Charout,"║                                                                            ║"
  363.     Call Locate 11,  2
  364.     Call Charout,"║   If the result should be printed,                                         ║"
  365.     Call Locate 12,  2
  366.     Call Charout,"║   in the window "
  367.                              Call Color "yellow"
  368.     Call Charout,"Print"
  369.                              Call Color "white"
  370.     Call Charout," of the "
  371.                              Call Color "cyan"
  372.     Call Charout,"EPM EDITOR"
  373.                              Call Color "white"
  374.     Call Charout,"                                    ║"
  375.     Call Locate 13,  2
  376.     Call Charout,"║                                                                            ║"
  377.     Call Locate 14,  2
  378.     Call Charout,"║   the point "
  379.                              Call Color "green"
  380.     Call Charout,"Unformatted ASCII-Text"
  381.                              Call Color "white"
  382.     Call Charout," should be activated.                    ║"
  383.     Call Locate 15,  2
  384.     Call Charout,"║                                                                            ║"
  385.     Call Locate 16,  2
  386.     Call Charout,"║                                                                            ║"
  387.     Call Locate 17,  2
  388.     Call Charout,"║                             "
  389.                              Call Color "green","blue"
  390.     Call Charout,"Hit the Enter key"
  391.                              Call Color "white","blue"
  392.     Call Charout,"                              ║"
  393.     Call Locate 18,  2
  394.     Call Charout,"║                                                                            ║"
  395.     Call Locate 19,  2
  396.     Call Charout,"╚════════════════════════════════════════════════════════════════════════════╝"
  397.     Call CsrAttrib "Normal"
  398.     pull
  399.     Call SysCls
  400.     EPM SUM.DAT
  401.   end
  402.   otherwise NOP
  403.   end
  404.   signal ende
  405.  
  406. /***************************** ANSI-Prozeduren ******************************/
  407.  
  408. /* Ansi Procedures for moving the cursor */
  409. Locate: Procedure   /*  Call Locate Row,Col */
  410. Row = arg(1)
  411. Col = Arg(2)
  412. Rc = Charout(,D2C(27)"["Row";"col"H")
  413. return ""
  414.  
  415. CsrUp: Procedure  /* CsrUp(Rows) */
  416. Arg u
  417. Rc = Charout(,D2C(27)"["u"A")
  418. return ""
  419.  
  420. CsrDown: Procedure /* CsrDn(Rows) */
  421. Arg d
  422. Rc = Charout(,D2C(27)"["d"B")
  423. return ""
  424.  
  425. CsrRight: Procedure  /* CsrRight(Cols) */
  426. arg r
  427. Rc = Charout(,D2C(27)"["r"C")
  428. Return ""
  429.  
  430. CsrLeft: procedure  /* CsrLeft(Cols) */
  431. arg l
  432. Rc = Charout(,D2C(27)"["l"D")
  433. Return ""
  434.  
  435.  
  436. /*
  437. A------------------------------------------------------------:*
  438. SaveCsr and PutCsr are meant to be used together for saving  :*
  439. and restoring the cursor location. Do not confuse            :*
  440. with Locate, CsrRow, CsrCol, these are different routines.   :*
  441. SaveCsr Returns a string that PutCsr can use.                :*
  442. A:*/
  443. SaveCsr: procedure  /* cursor_location = SaveCsr() (for PutCsr(x))*/
  444. Rc = Charout(,D2C(27)"[6n")
  445. Pull Q
  446. Call CsrUp
  447. return Q
  448.  
  449. PutCsr: procedure  /* Call PutCsr <Previous_Location>  (From SaveCsr() ) */
  450. Where = arg(1)
  451. Rc = Charout(,substr(Where,1,7)"H")
  452. return ""
  453. /*
  454. A:*/
  455. /* clear screen :*/
  456. Cls: Procedure      /* cls() Call Cls */
  457. Rc = CharOut(,D2C(27)"[2J")
  458. return ""
  459.  
  460.     /* get cursors Line */
  461. CsrRow: Procedure      /* Row = CsrRow()*/
  462. Rc = Charout(,D2C(27)"[6n")
  463. Pull Q
  464. Return substr(Q,3,2)
  465.  
  466.    /* get cursors column */
  467. CsrCol: Procedure          /*  Col = CsrCol()  */
  468. Rc = Charout(,D2C(27)"[6n")
  469. Pull Q
  470. return Substr(Q,6,2)
  471.  
  472. /* procedure to color screen
  473. A:--------------------------------------------------------------*
  474. accepts colors: BLACK RED GREEN YELLOW BLUE MAGENTA CYAN WHITE  *
  475. */
  476. Color: Procedure /* Call Color <ForeGround>,<BackGround> */
  477. arg F,B
  478. Colors = "BLACK RED GREEN YELLOW BLUE MAGENTA CYAN WHITE"
  479. return CHAROUT(,D2C(27)"["WORDPOS(F,COLORS)+29";"WORDPOS(B,COLORS)+39";m")
  480.  
  481. /*  change screen attributes
  482. A:---------------------------------------------------------------*
  483. attributes: NORMAL HIGH LOW ITALIC UNDERLINE BLINK RAPID REVERSE *
  484. */
  485. CsrAttrib: Procedure  /* call CsrAttrib <Attrib> */
  486. Arg A
  487. attr = "NORMAL HIGH LOW ITALIC UNDERLINE BLINK RAPID REVERSE"
  488. return CHAROUT(,D2C(27)"["WORDPOS(A,ATTR) - 1";m")
  489.  
  490. EndAll:
  491. Call Color "White","Black"
  492. CALL CsrAttrib "Normal"
  493.  
  494.