home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / rexxalgo.zip / TESTALGO / Combine.CMD < prev    next >
OS/2 REXX Batch file  |  1997-08-25  |  3KB  |  103 lines
  1. /* REXX *********************************************/
  2. /* Program name: Combine                            */
  3. /* Function    : Format a string with the interval  */
  4. /* Syntax      :                                    */
  5. /* Changes     :                                    */
  6. /*                                                  */
  7. /* Author.....: Janosch R. Kowalczyk                */
  8. /* Made use of GREED.  19 Dec 1996 / 13:29:02   JRK */
  9. /****************************************************/
  10. Parse Arg arg1, arg2
  11. /* trace ?r */
  12. /*==============(Exception handling)================*/
  13. Signal On Failure Name CLEARUP
  14. Signal On Halt    Name CLEARUP
  15. Signal On Syntax  Name CLEARUP
  16.  
  17. /*==========(Initialize RexxUtil support)===========*/
  18. If RxFuncQuery('SysLoadFuncs') Then Do
  19.   Call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'
  20.   Call SysLoadFuncs
  21. End /* If RxFuncQuery... */
  22.  
  23. text = 'Test for COMBINE external function'
  24. Say Combine( text, Length(text) )
  25. text = '                                  '
  26. Say Combine( text, Length(text), '_' )
  27. Say
  28. Say '1. Possibilities:'
  29. text = XRange('A', 'X')
  30. Say 'Input :' text
  31. Say 'Output:' Combine( text, Length(text), , 4 )
  32. Say 'Output:' Combine( text, Length(text), ' * ', 2 )
  33. Say 'Output:' Combine( text, Length(text), ' centre ', Length(text)/2 )
  34. Say 'Output:' Combine( text, Length(text), ' third ', Length(text)/3 )
  35. text = '1334567892134'
  36. Say 'Input :' text
  37. Say 'Output:' Combine( text, Length(text), '.', 3 )
  38. text = '10000000000000000'
  39. Say 'Input :' text
  40. Say 'Output:' Combine( text, Length(text), '.', 3 )
  41. text = '10000000000000000'
  42. Say 'Output:' Combine( text, Length(text), ',', 3 )
  43. Say
  44.  
  45. text = '*****'
  46. Say Center(Combine( text, Length(text), '  ' ), 60)
  47. Say
  48. Say '2. Samples for practical using:'
  49. text = '13456783934566212'
  50. Say 'Input :' text
  51. text = Combine( text, Length(text), '+' )
  52. Interpret 'y = 'text
  53. Say 'Output:' text '=' y
  54. text = '4216783'
  55. Say 'Input :' text
  56. text = Combine( text, Length(text), ' * ' )
  57. Interpret 'y = 'text
  58. Say 'Output:' text '=' y
  59. Say
  60.  
  61. Call LineOut , 'Press any key to exit '
  62. Call CharIn
  63.  
  64. /*================(End this program)================*/
  65. Exit
  66.  
  67. CLEARUP:
  68.   Say
  69.   Say 'GREED001E - Break, Failure or Syntax Error'
  70. Exit
  71.  
  72.  
  73. /*====================( Format a string )===================*/
  74.  
  75. Combine: Procedure
  76. Parse Arg _combStr, _combLen, _combTooth, _combRep
  77.  
  78. /*-------(End processing and return formated string)--------*/
  79. If _combLen < 1 | DataType(_combLen, 'N') = 0 Then
  80.   Return _combStr
  81.  
  82. /*------(Check call parameter and set default values)-------*/
  83. _combLen = Trunc( _combLen )
  84.  
  85. If _combTooth = '' Then
  86.   _combTooth = ' '
  87.  
  88. If _combRep < 1 | DataType(_combRep, 'N') = 0 Then
  89.   _combRep = 1
  90. Else If _combRep >= _combLen Then
  91.   Return _combStr
  92.  
  93. _combRep = Trunc( _combRep )
  94.  
  95. /*------------(Set new value for Insert position)-----------*/
  96. _combLen = _combLen - _combRep
  97.  
  98. /*------------(Call recursive for the naxt step)------------*/
  99. Return Combine( Insert( _combTooth, _combStr, _combLen ),,
  100.                 _combLen,,
  101.                 _combTooth,,
  102.                 _combRep )
  103.