home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / rexxalgo.zip / RexxAlgo.INF (.txt) < prev    next >
OS/2 Help File  |  1997-08-28  |  62KB  |  1,700 lines
  1.  
  2. ΓòÉΓòÉΓòÉ 1. About ... ΓòÉΓòÉΓòÉ
  3.  
  4.            RexxAlgo is a collection of various REXX source codes routines. 
  5.           Refer to the chapters: 
  6.           REXX Algorithms, 
  7.           Available source code or 
  8.           Using and testing 
  9.  
  10.           for more information, please . 
  11.  
  12.  
  13. ΓòÉΓòÉΓòÉ 2. Notices ΓòÉΓòÉΓòÉ
  14.  
  15.  
  16.           This chapter refers to: 
  17.  
  18.               Disclaimer, 
  19.               Copyright, 
  20.               Author. 
  21.  
  22.  
  23. ΓòÉΓòÉΓòÉ 2.1. Disclaimer. ΓòÉΓòÉΓòÉ
  24.  
  25.  
  26.           This package is provided as is, without any guarantees or warrantees 
  27.           whatsoever. The author is not liable or responsible for any loss or 
  28.           damage of any kind whatsoever, including, but not limited to, losses 
  29.           of a financial, physical, emotional, marital, social, or mental 
  30.           nature that may result from the use or the purported use of anything 
  31.           in this package, for any purpose whatsoever. 
  32.           Thanks to Michael Shillingford for this wording. 
  33.  
  34.  
  35. ΓòÉΓòÉΓòÉ 2.2. Copyright. ΓòÉΓòÉΓòÉ
  36.  
  37.  
  38.           (C) Copyright Janosch R. Kowalczyk, 1996, 1997. All rights reserved. 
  39.           You may distribute this document in the original format to any one. 
  40.           You can use this document and software for all non-commercial 
  41.           purposes only. Commercial users must obtain the permission of the 
  42.           author first. 
  43.           You aren't allowed to distribute this document in printed form 
  44.           without the written permission of the author 
  45.  
  46.  
  47. ΓòÉΓòÉΓòÉ 2.3. Author. ΓòÉΓòÉΓòÉ
  48.  
  49.                     Janosch R. Kowalczyk
  50.                     Oberwaldstrasse 42
  51.                     D-63538 Grosskrotzenburg
  52.                     GERMANY
  53.  
  54.                     Telephone  0049 6186 201676
  55.                     CompuServe  101572,2160            Please send your improvement suggestions
  56.                     Internet   101572.2160@compuserve.com    and your bug reports via email.
  57.  
  58.  
  59. ΓòÉΓòÉΓòÉ 3. Current version. ΓòÉΓòÉΓòÉ
  60.  
  61.  
  62.           The current version of Rexx Algorithms is 1.31. 
  63.           The current source files are: 
  64.  
  65.               RXALG131.CMD 
  66.               RXALG131.FNC (for Greed) 
  67.  
  68.           Last revision date: July 2, 1997 
  69.  
  70.  
  71. ΓòÉΓòÉΓòÉ 4. REXX algorithms - introduction. ΓòÉΓòÉΓòÉ
  72.  
  73.  
  74.           I work as a systems programmer for MVS security systems and I work 
  75.           quite often under both the TSO and OS/2 environments. That's why I'm 
  76.           so happy to have Rexx - I can write my programs only once and they 
  77.           work on these two systems. 
  78.           I've written already a lot of Rexx programs. Doing this I wrote many 
  79.           simple but rather useful Rexx subroutines. They are both common 
  80.           well-known algorithms and my own solutions for Rexx or OS specific 
  81.           problems. 
  82.           I think that many Rexx programmers can use these subroutines to solve 
  83.           their problems and not have to develop these things for themselves. 
  84.           The file RXALGxxx.* contains the collection of my useful Rexx 
  85.           algorithms. These algorithms are at the Release 1.31 level and are 
  86.           subdivided into the following thematic groups: 
  87.  
  88.             1. Searching and sorting. 
  89.  
  90.                    Binary search (BiSearch) 
  91.                    Bubble sort (BubSort) 
  92.                    Insertion sort (InsSort) 
  93.                    Quick sort (QSort) 
  94.                    Shell sort (ShlSort) 
  95.  
  96.             2. Date and time. 
  97.  
  98.                    Gregorian date to Julian date (G2J) 
  99.                    Julian date to Gregorian date (J2G) 
  100.                    Date with century (Date2000) 
  101.  
  102.             3. Strings. 
  103.  
  104.                    Translate umlauts to lower case (ToLower) 
  105.                    Recursive formatting (Combine) 
  106.                    Replace a string (ReplaceString) 
  107.                    Remove umlaut characters (NoUmlaut). This is a sample for 
  108.                     using ReplaceString. 
  109.  
  110.             4. Mathematical functions. 
  111.  
  112.                    Square root evolution (SqrRoot) 
  113.                    Cube root evolution (CubeRoot) 
  114.                    Greatest common divisor (EuclidGCD) 
  115.  
  116.             5. File system. 
  117.  
  118.                    Recursive creating directory path (MakePath) 
  119.                    Delete directory path (ErasePath) 
  120.  
  121.             6. Multimedia. 
  122.  
  123.                    Digital Audio Player with mciRexx (PlayFile) 
  124.  
  125.             7. Miscellaneous. 
  126.  
  127.                    Exclude multiple items (NoMult) 
  128.  
  129.            All these code templates are written as internal subroutines.  I 
  130.           have placed the same subroutines into two files: 
  131.  
  132.               first, as plain text into the Rexx command file named 
  133.                RXALGxxx.CMD 
  134.               secondly, as code templates in the function file for GREED's 
  135.                Templates Controller, named RXALGxxx.FNC (INI format). 
  136.           where xxx is the release number, e.g. : for 1.31, xxx is 131. 
  137.  
  138.  
  139. ΓòÉΓòÉΓòÉ 5. Searching and sorting. ΓòÉΓòÉΓòÉ
  140.  
  141.  
  142.           This chapter describes several classical search and sort algorithms, 
  143.           as follows: 
  144.  
  145.               Binary search, 
  146.               Bubble sort, 
  147.               Insertion sort, 
  148.               Quick sort, 
  149.               Shell sort. 
  150.  
  151.  
  152. ΓòÉΓòÉΓòÉ 5.1. Binary search ΓòÉΓòÉΓòÉ
  153.  
  154.  
  155.           Function name: 
  156.           BiSearch 
  157.           Syntax: 
  158.           foundIndex = BiSearch( value ) 
  159.           Function: 
  160.           Binary search a stem variable for a value 
  161.           Calling parameter: 
  162.           Searched-for value 
  163.           Returns: 
  164.  
  165.               index of the found value, 
  166.               0 if nothing found. 
  167.  
  168.                     Notes:
  169.           The elements to search for must be saved in the stem named in this 
  170.           procedure (default name "STEM."). stem.0 contains the number of 
  171.           elements in stem. The stem variable must be in sorted order. 
  172.  
  173.           Sample call: 
  174.  
  175.                     foundIndex = BiSearch(value)
  176.                     If foundIndex = 0 Then
  177.                       Say 'Value' value 'not found!'
  178.                     Else
  179.                       Say stem.foundIndex
  180.           Source code: 
  181.           BiSearch 
  182.  
  183.  
  184. ΓòÉΓòÉΓòÉ 5.2. Bubble sort. ΓòÉΓòÉΓòÉ
  185.  
  186.  
  187.           Function name: 
  188.           BubSort 
  189.           Syntax: 
  190.           Call BubSort 
  191.           Function: 
  192.           Sort of a stem variable using the Bubble sort algorithm. 
  193.           Call parameter: 
  194.           No 
  195.           Returns: 
  196.           nothing (NULL string) 
  197.  
  198.                     Notes:
  199.           The elements to sort for must be saved in the stem named so as the 
  200.           stem in this procedure (in this case "STEM."). stem.0 must contain 
  201.           the number of elements in stem. 
  202.  
  203.            Source code: 
  204.           BubSort 
  205.  
  206.  
  207. ΓòÉΓòÉΓòÉ 5.3. Insertion sort. ΓòÉΓòÉΓòÉ
  208.  
  209.  
  210.           Function name: 
  211.           InsSort 
  212.           Syntax: 
  213.           Call InsSort 
  214.           Function: 
  215.           Sort of a stem variable using the Insertion sort algorithm. 
  216.           Call parameter: 
  217.           No 
  218.           Returns: 
  219.           nothing (NULL string) 
  220.  
  221.                     Notes:
  222.           The elements to sort for must be saved in the stem named in this 
  223.           procedure (in this case "STEM."). stem.0 contains the number of 
  224.           elements in stem. 
  225.  
  226.            Source code: 
  227.           InsSort 
  228.  
  229.  
  230. ΓòÉΓòÉΓòÉ 5.4. Quick sort. ΓòÉΓòÉΓòÉ
  231.  
  232.  
  233.           Function name: 
  234.           QSort 
  235.           Syntax: 
  236.           Call QSort 
  237.           Function: 
  238.           Sort of a stem variable using the Quick sort algorithm. 
  239.           Call parameter: 
  240.           No 
  241.           Returns: 
  242.           Left-Right span 
  243.  
  244.                     Notes:
  245.           The elements to sort for must be saved in the stem named in this 
  246.           procedure (in this case "STEM."). stem.0 contains the number of 
  247.           elements in stem. 
  248.  
  249.            Source code: 
  250.           QSort 
  251.  
  252.  
  253. ΓòÉΓòÉΓòÉ 5.5. Shell sort. ΓòÉΓòÉΓòÉ
  254.  
  255.  
  256.           Function name: 
  257.           ShlSort 
  258.           Syntax: 
  259.           Call ShlSort 
  260.           Function: 
  261.           Sort of a stem variable using the Shell sort algorithm. 
  262.           Call parameter: 
  263.           No 
  264.           Returns: 
  265.           nothing (NULL string) 
  266.  
  267.                     Notes:
  268.           The elements to sort for must be saved in the stem named in this 
  269.           procedure (in this case "STEM."). stem.0 contains the number of 
  270.           elements in stem. 
  271.  
  272.            Source code: 
  273.           ShlSort 
  274.  
  275.  
  276. ΓòÉΓòÉΓòÉ 6. Date and time. ΓòÉΓòÉΓòÉ
  277.  
  278.  
  279.           This chapter describes useful date algorithms: 
  280.  
  281.               translate Gregorian date to Julian date, 
  282.               translate Julian date to Gregorian date, 
  283.               get Year with century. 
  284.  
  285.  
  286. ΓòÉΓòÉΓòÉ 6.1. Translate Gregorian date to Julian date. ΓòÉΓòÉΓòÉ
  287.  
  288.  
  289.           Function name: 
  290.           G2J 
  291.           Syntax: 
  292.           julDate = G2J( yyyy.mm.dd ) 
  293.           Function: 
  294.           Translates Gregorian date to the Julian date. 
  295.           Call parameter: 
  296.           Gregorian date in format yyyy.mm.dd 
  297.           Returns: 
  298.           Julian date in format yyyy.ddd 
  299.           Source code: 
  300.           G2J 
  301.  
  302.  
  303. ΓòÉΓòÉΓòÉ 6.2. Translate Julian date to Gregorian date. ΓòÉΓòÉΓòÉ
  304.  
  305.  
  306.           Function name: 
  307.           J2G 
  308.           Syntax: 
  309.           gregDate = J2G( yyyy.ddd ) 
  310.           Function: 
  311.           Translates Julian date to the Gregorian date. 
  312.           Call parameter: 
  313.           Julian date in format yyyy.ddd 
  314.           Returns: 
  315.           Gregorian date in format yyyy.mm.dd 
  316.           Source code: 
  317.           J2G 
  318.  
  319.  
  320. ΓòÉΓòÉΓòÉ 6.3. Year with century. ΓòÉΓòÉΓòÉ
  321.  
  322.  
  323.           Function name: 
  324.           Date2000 
  325.           Syntax: 
  326.           Date = Date2000( Option ) 
  327.           Function: 
  328.           Same output as the Rexx built-in function Date() but includes the 
  329.           century with the year. Has also an additional option, J. 
  330.           Call options and Returns: 
  331.  
  332.                blank - Returns dd Mmm yyyy 
  333.                B - Returns dddddd days since 01.01.0001 
  334.                D - Returns ddd - days in the current year 
  335.                E - Returns dd/mm/yyyy 
  336.                J - Returns yyyy.ddd - Julian date 
  337.                L - Returns dd Month yyyy 
  338.                M - Returns Month 
  339.                N - Returns dd Mmm yyyy 
  340.                O - Returns yyyy/mm/dd 
  341.                S - Returns yyyymmdd 
  342.                U - Returns mm/dd/yyyy 
  343.                W - Returns Weekday 
  344.  
  345.           Source code: 
  346.           Date2000 
  347.  
  348.  
  349. ΓòÉΓòÉΓòÉ 7. String functions. ΓòÉΓòÉΓòÉ
  350.  
  351.  
  352.           This chapter details some useful algorithms to: 
  353.  
  354.               format a string recursively, 
  355.               translate umlauts to lower case, 
  356.               replace a substring by another. 
  357.               remove umlaut characters, 
  358.  
  359.  
  360. ΓòÉΓòÉΓòÉ 7.1. Format a string recursively. ΓòÉΓòÉΓòÉ
  361.  
  362.  
  363.           Function name: 
  364.           Combine 
  365.           Syntax: 
  366.           formStr = Combine( _combStr, _combLen, [_combTooth], [_combRep] ) 
  367.           Function: 
  368.           Recursive formatting of a string with a constant interval. 
  369.           Call parameter: 
  370.  
  371.                _combStr - string to be formated, 
  372.                _combLen - string's length, 
  373.                _combTooth - new format string (optinal), 
  374.                _combRep - format interval (optional) 
  375.  
  376.           Returns: 
  377.           Formated string 
  378.  
  379.                     Notes:
  380.           Default value for _combTooth is a blank, default value for _combRep 
  381.           is 1. _combTooth will be inserted into the _combStr at the position 
  382.           computed as follows: 
  383.           _combLen = _combLen - _combRep
  384.  
  385.            Sample call: 
  386.  
  387.                     formStr = Combine( '10000000000', 11, ',', 3 )
  388.                     /* Input string  = '10000000000'    */
  389.                     /* String length = 11               */
  390.                     /* Format string = ','              */
  391.                     /* Interval      = 3                */
  392.                     /* Output string = '10,000,000,000' */
  393.  
  394.           Source code: 
  395.           Combine 
  396.  
  397.  
  398. ΓòÉΓòÉΓòÉ 7.2. Translate umlauts to lower case. ΓòÉΓòÉΓòÉ
  399.  
  400.  
  401.           Function name: 
  402.           ToLower 
  403.           Syntax: 
  404.           lowString = ToLower( upperString ) 
  405.           Function: 
  406.           Translate entire string to lower case. 
  407.           Call parameter: 
  408.           String to translate 
  409.           Returns: 
  410.           Translated string 
  411.  
  412.                     Notes:
  413.           Simply change variables 'Lowers' and 'Uppers' to get the function 
  414.           ToUpper 
  415.  
  416.            Source code: 
  417.           ToLower 
  418.  
  419.  
  420. ΓòÉΓòÉΓòÉ 7.3. Replace a substring by an another. ΓòÉΓòÉΓòÉ
  421.  
  422.  
  423.           Function name: 
  424.           ReplaceString 
  425.           Syntax: 
  426.           tranStr = ReplaceString( _string, _origin, _replStr ) 
  427.           Function: 
  428.           Find all occurrences of a substring and replace it by an another 
  429.           (such as built-in functions Overlay and Insert together). 
  430.           Call parameter: 
  431.  
  432.                _string - input string, 
  433.                _origin - substring to be replaced, 
  434.                _replStr - replace substring. 
  435.  
  436.           Returns: 
  437.           Translated string 
  438.           Source code: 
  439.           ReplaceString 
  440.  
  441.  
  442. ΓòÉΓòÉΓòÉ 7.4. Remove umlaut characters. ΓòÉΓòÉΓòÉ
  443.  
  444.  
  445.           Function name: 
  446.           NoUmlaut 
  447.           Syntax: 
  448.           tranStr = NoUmlaut( uString,['U'] ) 
  449.           Function: 
  450.           Replace umlaut characters with double character strings (╨ö -> ae, ╨ñ 
  451.           -> oe, ╨æ -> ue, ╤ü -> ss) 
  452.           Call parameter: 
  453.  
  454.                _string - string with umlauts, 
  455.                _upper - ('U') upper case return string (optional) 
  456.  
  457.           Returns: 
  458.           Translated string 
  459.  
  460.                     Notes:
  461.           This function calls the function ReplaceString. 
  462.  
  463.            Source code: 
  464.           NoUmlaut 
  465.  
  466.  
  467. ΓòÉΓòÉΓòÉ 8. Mathematical functions. ΓòÉΓòÉΓòÉ
  468.  
  469.  
  470.           In this chapter you will find the following algorithms: 
  471.  
  472.               Square root evaluation. 
  473.               Cube root evaluation. 
  474.               Greatest common divisor. 
  475.  
  476.  
  477. ΓòÉΓòÉΓòÉ 8.1. Square root evaluation. ΓòÉΓòÉΓòÉ
  478.  
  479.  
  480.           Function name: 
  481.           SqrRoot 
  482.           Syntax: 
  483.           sqrt = SqrRoot( number, [precision] ) 
  484.           Function: 
  485.           Square root evaluation for the called parameter. 
  486.           Call parameter: 
  487.  
  488.                evaluation number, 
  489.                precision (optional) 
  490.  
  491.           Returns: 
  492.           Square root of the called parameter 
  493.  
  494.                     Notes:
  495.           Precision is the highest possible error for the evaluation. Default 
  496.           Value of the precision is 0.00001. You are responsible for the valid 
  497.           number values. 
  498.  
  499.            Source code: 
  500.           SqrRoot 
  501.  
  502.  
  503. ΓòÉΓòÉΓòÉ 8.2. Cube root evaluation. ΓòÉΓòÉΓòÉ
  504.  
  505.  
  506.           Function name: 
  507.           Cube root 
  508.           Syntax: 
  509.           gcd = CubeRoot( _digit, _precision ) 
  510.           Function: 
  511.           Cube root evolution. 
  512.           Call parameter: Call parameters are two digits. The first one is the 
  513.           digit for which you want to compute the cube root, the second is the 
  514.           precision of the calculation. The precision is a decimal fraction 
  515.           number e.g.: 0.00000001. 
  516.           Returns: 
  517.           cube root. 
  518.  
  519.                     Notes:
  520.           You are responsible for the valid number values 
  521.  
  522.            Source code: 
  523.           Cube root 
  524.  
  525.  
  526. ΓòÉΓòÉΓòÉ 8.3. Greatest common divisor. ΓòÉΓòÉΓòÉ
  527.  
  528.  
  529.           Function name: 
  530.           EuclidGCD 
  531.           Syntax: 
  532.           gcd = EuclidGCD( _counter, _denuminator ) 
  533.           Function: 
  534.           Euclid's algorithm to obtain the greatest common divisor. 
  535.           Call parameter: Call parameters are two digits, for which the 
  536.           function computes the greatest common divisor. 
  537.           Returns: 
  538.           greatest common divisor. 
  539.  
  540.                     Notes:
  541.           You are responsible for the valid number values 
  542.  
  543.            Source code: 
  544.           Euclid 
  545.  
  546.  
  547. ΓòÉΓòÉΓòÉ 9. File system. ΓòÉΓòÉΓòÉ
  548.  
  549.  
  550.           This chapter describes algorithms to: 
  551.  
  552.               recursively create a directory path, 
  553.               delete a directory path. 
  554.  
  555.  
  556. ΓòÉΓòÉΓòÉ 9.1. Recursively create a directory path. ΓòÉΓòÉΓòÉ
  557.  
  558.  
  559.           Function name: 
  560.           MakePath 
  561.           Syntax: 
  562.           _destPath = MakePath( _destPath ) 
  563.           Function: 
  564.           Recursive creating of the directory path 
  565.           Call parameter: 
  566.           _destPath  - directory path 
  567.           Returns: 
  568.           directory path  Source code: 
  569.           MakePath 
  570.  
  571.  
  572. ΓòÉΓòÉΓòÉ 9.2. Delete a directory path. ΓòÉΓòÉΓòÉ
  573.  
  574.  
  575.           Function name: 
  576.           ErasePath 
  577.           Syntax: 
  578.           _erasePath = ErasePath( _erasePath ) 
  579.           Function: 
  580.           Delete complete directory path 
  581.           Call parameter: 
  582.           _erasePath - directory path to be deleted 
  583.           Returns: 
  584.           _erasePath 
  585.  
  586.                     Notes:
  587.           Only empty directories will be deleted. 
  588.  
  589.            Source code: 
  590.           ErasePath 
  591.  
  592.  
  593. ΓòÉΓòÉΓòÉ 10. Multimedia. ΓòÉΓòÉΓòÉ
  594.  
  595.  
  596.           This chapter details an algorithm to: 
  597.  
  598.               Play a digital WAV/MID-audio file. 
  599.  
  600.  
  601. ΓòÉΓòÉΓòÉ 10.1. Play a digital audio file. ΓòÉΓòÉΓòÉ
  602.  
  603.  
  604.           Function name: 
  605.           PlayFile 
  606.           Syntax: 
  607.           rc = PlayFile( audio_file_name ) 
  608.           Function: 
  609.           Play digital WAV/MID file. 
  610.           Call parameter: 
  611.           Fully qualified file name to play 
  612.           Returns: 
  613.           RC from the last call of the mciRexx function 
  614.           Source code: 
  615.           PlayFile 
  616.  
  617.  
  618. ΓòÉΓòÉΓòÉ 11. Miscellaneous. ΓòÉΓòÉΓòÉ
  619.  
  620.  
  621.           In this chapter are described some useful algorithms to: 
  622.  
  623.               exclude multiple items from a stem. 
  624.  
  625.  
  626. ΓòÉΓòÉΓòÉ 11.1. Exclude multiple items from a stem. ΓòÉΓòÉΓòÉ
  627.  
  628.  
  629.           Function name: 
  630.           NoMult 
  631.           Syntax: 
  632.           Call NoMult 
  633.           Function: 
  634.           Excludes multiple items from a sorted stem variable. 
  635.           Call parameter: 
  636.           no 
  637.           Returns: 
  638.           0 
  639.  
  640.                     Notes:
  641.           The elements to exclude must be saved in the stem named in this 
  642.           Procedure (in this case "STEM."). stem.0 contains the number of 
  643.           elements in stem. The stem variable must be previously sorted 
  644.  
  645.            Source code: 
  646.           NoMult 
  647.  
  648.  
  649. ΓòÉΓòÉΓòÉ 12. Source codes. ΓòÉΓòÉΓòÉ
  650.  
  651.  
  652.           This chapter describes all the Rexx functions currently available in 
  653.           this product. Refer to the chapter Available source codes for more 
  654.           information. 
  655.  
  656.  
  657. ΓòÉΓòÉΓòÉ 12.1. Available source codes. ΓòÉΓòÉΓòÉ
  658.  
  659.  
  660.           In this chapter is the source code of the following Rexx internal 
  661.           procedures: 
  662.  
  663.               BiSearch 
  664.                     Binary search 
  665.               BubSort 
  666.                     Bubble sort 
  667.               Combine 
  668.                     Recursive string formatting 
  669.               CubeRoot 
  670.                     Cube root 
  671.               Date2000 
  672.                     Year with century 
  673.               ErasePath 
  674.                     Delete directory path 
  675.               EuclidGCD 
  676.                     Greatest common divisor 
  677.               G2J 
  678.                     Gregorian to julian date 
  679.               InsSort 
  680.                     Insertion sort 
  681.               J2G 
  682.                     Julian to gregorian date 
  683.               MakePath 
  684.                     Recursive directory path creating 
  685.               NoMult 
  686.                     Exclude multiple items 
  687.               NoUmlaut 
  688.                     Remove umlaut characters 
  689.               PlayFile 
  690.                     Digital Audio Player (mciRexx) 
  691.               QSort 
  692.                     Quick sort 
  693.               ReplaceString 
  694.                     Replace a string 
  695.               ShlSort 
  696.                     Shell sort 
  697.               SqrRoot 
  698.                     Square root 
  699.               ToLower 
  700.                     To lower case 
  701.  
  702.  
  703. ΓòÉΓòÉΓòÉ 12.2. BiSearch ΓòÉΓòÉΓòÉ
  704.  
  705.  
  706.                     /*==================(Binary search)===================*/
  707.                     /* :-D                                              1 */
  708.                     /* Name.......: BiSearch                              */
  709.                     /*                                                    */
  710.                     /* Function...: Search a stem variable for a value    */
  711.                     /* Call parm..: Search value                          */
  712.                     /* Returns....: 0 if nothing found                    */
  713.                     /*              index of the found value              */
  714.                     /* Sample call: found_index = BiSearch(value)         */
  715.                     /*              If found_index = 0 Then               */
  716.                     /*                Say 'Value' value 'not found!'      */
  717.                     /*              Else                                  */
  718.                     /*                Say stem.found_index                */
  719.                     /*                                                    */
  720.                     /* Notes......: The elements to search for must be    */
  721.                     /*              saved in the stem named in this       */
  722.                     /*              procedure (default name "STEM.").     */
  723.                     /*              stem.0 must contain the number of     */
  724.                     /*              elements in stem.                     */
  725.                     /*              The stem variable must be in sorted   */
  726.                     /*              order                                 */
  727.                     /*                                                    */
  728.                     /* Changes....: No                                    */
  729.                     /*                                                    */
  730.                     /* (C) Copyright Janosch R. Kowalczyk, 1996.          */
  731.                     /* All rights reserved.                               */
  732.                     /*====================================================*/
  733.                     BiSearch: Procedure Expose stem.
  734.  
  735.                     Parse Arg value             /* Search value            */
  736.  
  737.                     found  = 0                  /* Index of the found Item */
  738.                     bottom = 1                  /* Index of the first Item */
  739.                     top    = stem.0             /* Index of the last Item  */
  740.  
  741.                     Do While found = 0 & top >= bottom
  742.                       mean = (bottom + top) % 2
  743.                       If value = stem.mean Then
  744.                         found = mean
  745.                       Else If value < stem.mean Then
  746.                         top = mean - 1
  747.                       Else
  748.                         bottom = mean + 1
  749.                     End /* Do While */
  750.  
  751.                     Return found
  752.  
  753.  
  754. ΓòÉΓòÉΓòÉ 12.3. BubSort ΓòÉΓòÉΓòÉ
  755.  
  756.  
  757.                     /*===================(Bubble sort)===================*/
  758.                     /* :-I                                               */
  759.                     /* Name.......: BubSort                              */
  760.                     /*                                                   */
  761.                     /* Function...: Bubble Sort for a stem variable      */
  762.                     /* Call parm..: No                                   */
  763.                     /* Returns....: nothing (NULL string)                */
  764.                     /*                                                   */
  765.                     /* Sample call: Call BubSort                         */
  766.                     /*                                                   */
  767.                     /* Notes......: The elements to sort for must be     */
  768.                     /*              saved in the stem named so as the    */
  769.                     /*              stem in this Procedure (in this case */
  770.                     /*              "STEM.")                             */
  771.                     /*              stem.0 must contain the number of    */
  772.                     /*              elements in stem.                    */
  773.                     /*                                                   */
  774.                     /* Changes....: No                                   */
  775.                     /*                                                   */
  776.                     /*===================================================*/
  777.  
  778.                     BubSort: Procedure Expose stem.
  779.  
  780.                     /*------------(Bubble Sort for the Stem)-------------*/
  781.                     Do i = stem.0 To 1 By -1 Until flip_flop = 1
  782.                       flip_flop = 1
  783.                       Do j = 2 To i
  784.                         m = j - 1
  785.                         If stem.m > stem.j Then Do
  786.                           xchg   = stem.m
  787.                           stem.m = stem.j
  788.                           stem.j = xchg
  789.                           flip_flop = 0
  790.                         End /* If stem.m ... */
  791.                       End /* Do j = 2 ...    */
  792.                     End /* Do i = stem.0 ... */
  793.  
  794.                     Return ''
  795.  
  796.  
  797. ΓòÉΓòÉΓòÉ 12.4. Combine ΓòÉΓòÉΓòÉ
  798.  
  799.  
  800.                     /*==============( Recursive formatting )==============*/
  801.                     /*                                                 14 */
  802.                     /* Name.......: Combine                               */
  803.                     /*                                                    */
  804.                     /* Function...: Format recursive a string             */
  805.                     /*                                                    */
  806.                     /* Call parm..: _combStr   - string to format,        */
  807.                     /*              _combLen   - string's length,         */
  808.                     /*              _combTooth - format string (opt.),    */
  809.                     /*              _combRep   - format interval (opt.)   */
  810.                     /*                                                    */
  811.                     /* Returns....: formated string                       */
  812.                     /*                                                    */
  813.                     /* Syntax.....:                                       */
  814.                     /*    formStr = Combine( Str, Len, Tooth, Rep )       */
  815.                     /*                                                    */
  816.                     /* Notes......: Default value for _combTooth is a     */
  817.                     /*              blank                                 */
  818.                     /*              Default value for _combRep is 1       */
  819.                     /*                                                    */
  820.                     /* Method of working:                                 */
  821.                     /*              _combTooth will be inserted into the  */
  822.                     /*              _combStr at the position computed as  */
  823.                     /*              follows:                              */
  824.                     /*              _combLen = _combLen - _combRep        */
  825.                     /*                                                    */
  826.                     /* Sample.....: Input string  = '10000000000'         */
  827.                     /*              Format string = '.'                   */
  828.                     /*              Interval      = 3                     */
  829.                     /*                                                    */
  830.                     /*              Output string = '10.000.000.000'      */
  831.                     /*                                                    */
  832.                     /* Changes....: No                                    */
  833.                     /*                                                    */
  834.                     /* (C) Copyright Janosch R. Kowalczyk, 1996.          */
  835.                     /* All rights reserved.                               */
  836.                     /*====================================================*/
  837.                     Combine: Procedure
  838.                     Parse Arg _combStr, _combLen, _combTooth, _combRep
  839.  
  840.                     /*----(End processing and return formated string)-----*/
  841.                     If _combLen < 1 | DataType(_combLen, 'N') = 0 Then
  842.                       Return _combStr
  843.  
  844.                     /*---(Check call parameter and set default values)----*/
  845.                     _combLen = Trunc( _combLen )
  846.  
  847.                     If _combTooth = '' Then
  848.                       _combTooth = ' '
  849.  
  850.                     If _combRep < 1 | DataType(_combRep, 'N') = 0 Then
  851.                       _combRep = 1
  852.                     Else If _combRep >= _combLen Then
  853.                       Return _combStr
  854.  
  855.                     _combRep = Trunc( _combRep )
  856.  
  857.                     /*---------(Set new value for Insert position)---------*/
  858.                     _combLen = _combLen - _combRep
  859.  
  860.                     /*---------(Call recursive for the naxt step)----------*/
  861.                     Return Combine( Insert( _combTooth, _combStr, _combLen ),,
  862.                                     _combLen,,
  863.                                     _combTooth,,
  864.                                     _combRep )
  865.  
  866.  
  867. ΓòÉΓòÉΓòÉ 12.5. Date2000 ΓòÉΓòÉΓòÉ
  868.  
  869.  
  870.                     /*=======(Translate year to year with century)========*/
  871.                     /*                                                 13 */
  872.                     /* Name.......: Date2000                              */
  873.                     /*                                                    */
  874.                     /* Function...: Translates year to year with century  */
  875.                     /* Call option:   Returns dd Mmm yyyy                 */
  876.                     /*              B Returns dddddd days since 01.01.0001*/
  877.                     /*              D Returns ddd - days                  */
  878.                     /*              E Returns dd/mm/yyyy                  */
  879.                     /*              J Returns yyyy.ddd - julians date     */
  880.                     /*              L Returns dd Month yyyy               */
  881.                     /*              M Returns Month                       */
  882.                     /*              N Returns dd Mmm yyyy                 */
  883.                     /*              O Returns yyyy/mm/dd                  */
  884.                     /*              S Returns yyyymmdd                    */
  885.                     /*              U Returns mm/dd/yyyy                  */
  886.                     /*              W Returns Weekday                     */
  887.                     /*                                                    */
  888.                     /* Syntax.....: Date = Date2000(Option)               */
  889.                     /*                                                    */
  890.                     /* Changes....: No                                    */
  891.                     /*                                                    */
  892.                     /* (C) Copyright Janosch R. Kowalczyk, 1996.          */
  893.                     /* All rights reserved.                               */
  894.                     /*====================================================*/
  895.                     Date2000: Procedure
  896.                     Parse Value Arg(1) With Option +1 .
  897.  
  898.                     If Option = '' Then Return Date()
  899.                     If Verify('EJOU', Option, 'M') > 0 Then Do
  900.                       Parse Value Date() With . . yyyy
  901.                       If Option = 'J' Then Return yyyy || '.' || Date('D')
  902.                       Else If Option = 'O' Then Do
  903.                         Parse Value Date(Option) With . +2 Rest
  904.                         Return yyyy || Rest
  905.                       End
  906.                       Else Do
  907.                         Parse Value Date(Option) With Rest +6 .
  908.                         Return Rest || yyyy
  909.                       End
  910.                     End
  911.                     Else Return Date(Option)
  912.  
  913.  
  914. ΓòÉΓòÉΓòÉ 12.6. ErasePath ΓòÉΓòÉΓòÉ
  915.  
  916.  
  917.                     /*==============( Delete Directory Path )=============*/
  918.                     /*                                                 18 */
  919.                     /* Name.......: ErasePath                             */
  920.                     /*                                                    */
  921.                     /* Function...: delete directory path                 */
  922.                     /*                                                    */
  923.                     /* Call parm..: _erasePath - directory path to be     */
  924.                     /*              deleted                               */
  925.                     /*                                                    */
  926.                     /* Returns....: formated string                       */
  927.                     /*                                                    */
  928.                     /* Syntax.....:                                       */
  929.                     /*    _erasePath = ErasePath( _erasePath )            */
  930.                     /*                                                    */
  931.                     /* Changes....: No                                    */
  932.                     /*                                                    */
  933.                     /* (C) Copyright Janosch R. Kowalczyk, 1996.          */
  934.                     /* All rights reserved.                               */
  935.                     /*====================================================*/
  936.                     /*-------------(Delete Directory Path)------------*/
  937.                     ErasePath: Procedure
  938.                     Arg _erasePath
  939.  
  940.                     _erasePath = Strip( _erasePath, , '\' )
  941.  
  942.                     Do Until Pos('\', _erasePath) = 0
  943.                       rc = SysRmDir( _erasePath )
  944.                       If rc > 0 Then
  945.                         Say 'Directory:' _erasePath 'not deleted. RC=' rc
  946.                       Else
  947.                         Say _erasePath 'successful deleted'
  948.                       _erasePath = SubStr( _erasePath, 1, LastPos('\', _erasePath) - 1)
  949.                     End
  950.  
  951.                     Return _erasePath
  952.  
  953.  
  954. ΓòÉΓòÉΓòÉ 12.7. G2J ΓòÉΓòÉΓòÉ
  955.  
  956.  
  957.                     /*==================(Translate date)=================*/
  958.                     G2J: Procedure
  959.                     /*---------------------------------------------------*/
  960.                     /*                                                   */
  961.                     /* Procedure name: G2J                               */
  962.                     /* Function      : translates gregorian date to the  */
  963.                     /*                 julian date                       */
  964.                     /* Syntax        : julDate = G2J(yyyy.mm.dd)         */
  965.                     /* Changes       :                                   */
  966.                     /*                                                   */
  967.                     /* Author        : Janosch R. Kowalczyk              */
  968.                     /*                                                   */
  969.                     /* (C) Copyright Janosch R. Kowalczyk, 1996.         */
  970.                     /* All rights reserved.                              */
  971.                     /* Made use of GREED.  09 Jul 1996 / 13:21:56   JRK  */
  972.                     /*---------------------------------------------------*/
  973.                     Arg gregDate
  974.  
  975.                     year = SubStr(gregDate,1,4)
  976.                     mon  = SubStr(gregDate,6,2) + 0
  977.                     day  = SubStr(gregDate,9,2)
  978.  
  979.                     mon.0  = 12
  980.                     mon.1  = 0
  981.                     mon.2  = 31
  982.                     mon.3  = 59
  983.                     mon.4  = 90
  984.                     mon.5  = 120
  985.                     mon.6  = 151
  986.                     mon.7  = 181
  987.                     mon.8  = 212
  988.                     mon.9  = 243
  989.                     mon.10 = 273
  990.                     mon.11 = 304
  991.                     mon.12 = 334
  992.  
  993.                     If (year // 400 = 0 | (year // 100 > 0 & year // 4 = 0)) & mon > 2 Then
  994.                       leap = 1
  995.                     Else leap = 0
  996.  
  997.                     julDay = mon.mon + day + leap
  998.  
  999.                     Return year'.'Right(julDay,3,'0')
  1000.  
  1001.  
  1002. ΓòÉΓòÉΓòÉ 12.8. InsSort ΓòÉΓòÉΓòÉ
  1003.  
  1004.  
  1005.                     /*=================(Insertion sort)===================*/
  1006.                     /* :-!                                              3 */
  1007.                     /* Name.......: InsSort                               */
  1008.                     /*                                                    */
  1009.                     /* Function...: Insertion Sort for a stem variable    */
  1010.                     /* Call parm..: No                                    */
  1011.                     /* Returns....: nothing (NULL string)                 */
  1012.                     /*                                                    */
  1013.                     /* Sample call: Call InsSort                          */
  1014.                     /*                                                    */
  1015.                     /* Notes......: The elements to sort for must be      */
  1016.                     /*              saved in the stem named so as the     */
  1017.                     /*              stem in this Procedure (in this case  */
  1018.                     /*              "STEM.")                              */
  1019.                     /*              stem.0 must contain the number of     */
  1020.                     /*              elements in stem.                     */
  1021.                     /*                                                    */
  1022.                     /* Changes....: No                                    */
  1023.                     /*                                                    */
  1024.                     /* (C) Copyright Janosch R. Kowalczyk, 1996.          */
  1025.                     /* All rights reserved.                               */
  1026.                     /*====================================================*/
  1027.                     InsSort: Procedure Expose stem.
  1028.  
  1029.                     Do x = 2 To stem.0
  1030.                       xchg = stem.x
  1031.                       Do y = x - 1 By -1 To 1 While stem.y > xchg
  1032.                         xchg   = stem.x
  1033.                         stem.x = stem.y
  1034.                         stem.y = xchg
  1035.                         x = y
  1036.                       End /* Do y = x... */
  1037.                       stem.x = xchg
  1038.                     End /* Do x = 2 ...  */
  1039.  
  1040.                     Return ''
  1041.  
  1042.  
  1043. ΓòÉΓòÉΓòÉ 12.9. J2G ΓòÉΓòÉΓòÉ
  1044.  
  1045.  
  1046.                     /*==========(Julian Date to Gregorian Date)==========*/
  1047.                     J2G: Procedure
  1048.                     /*---------------------------------------------------*/
  1049.                     /*                                                   */
  1050.                     /* Program name: J2G                                 */
  1051.                     /* Function    : translates julian to gregorian      */
  1052.                     /*               date                                */
  1053.                     /* Syntax      : J2G yyyy.ddd                        */
  1054.                     /* Author      : Janosch R. Kowalczyk                */
  1055.                     /* Changes     :                                     */
  1056.                     /*                                                   */
  1057.                     /* (C) Copyright Janosch R. Kowalczyk, 1996.         */
  1058.                     /* All rights reserved.                              */
  1059.                     /* Made use of GREED.  09 Jul 1996 / 18:08:30   JRK  */
  1060.                     /*---------------------------------------------------*/
  1061.                     Arg julDate
  1062.  
  1063.                     Parse Var julDate year'.'jday
  1064.  
  1065.                     mon.0  = 12
  1066.                     mon.1  = 0
  1067.                     mon.2  = 31
  1068.                     mon.3  = 59
  1069.                     mon.4  = 90
  1070.                     mon.5  = 120
  1071.                     mon.6  = 151
  1072.                     mon.7  = 181
  1073.                     mon.8  = 212
  1074.                     mon.9  = 243
  1075.                     mon.10 = 273
  1076.                     mon.11 = 304
  1077.                     mon.12 = 334
  1078.  
  1079.                     If year // 400 = 0 | (year // 100 > 0 & year // 4 = 0) Then
  1080.                       leap = 1
  1081.                     Else
  1082.                       leap = 0
  1083.  
  1084.                     Do i = 1 To mon.0
  1085.                       If i > 2 Then mon.i = mon.i + leap
  1086.                       If jday > mon.i Then mon = i
  1087.                     End
  1088.  
  1089.                     day = jday - mon.mon
  1090.                     gregDate = year'.'Right(mon,2,'0')'.'Right(day,2,'0')
  1091.  
  1092.                     return gregDate
  1093.  
  1094.  
  1095. ΓòÉΓòÉΓòÉ 12.10. MakePath ΓòÉΓòÉΓòÉ
  1096.  
  1097.  
  1098.                     /*=============( Recursive Path Creating )============*/
  1099.                     /*                                                 17 */
  1100.                     /* Name.......: MakePath                              */
  1101.                     /*                                                    */
  1102.                     /* Function...: Create recursive directory path       */
  1103.                     /*                                                    */
  1104.                     /* Call parm..: _destPath  - directory path           */
  1105.                     /*                                                    */
  1106.                     /* Returns....: formated string                       */
  1107.                     /*                                                    */
  1108.                     /* Syntax.....:                                       */
  1109.                     /*    _destPath = MakePath( _destPath )               */
  1110.                     /*                                                    */
  1111.                     /* Changes....: No                                    */
  1112.                     /*                                                    */
  1113.                     /* (C) Copyright Janosch R. Kowalczyk, 1996.          */
  1114.                     /* All rights reserved.                               */
  1115.                     /*====================================================*/
  1116.                     /*---------------(Create Directory Path)--------------*/
  1117.                     MakePath: Procedure
  1118.                     Arg _destPath
  1119.  
  1120.                     _destPath = Strip(_destPath,,'\')
  1121.                     If Pos('\', _destPath) = 0 Then Return _destPath
  1122.  
  1123.                     /*--------------( Check Directory Path )--------------*/
  1124.                     rc = SysFileTree( _destPath, fileList, 'DO' )
  1125.                     If fileList.0 = 0 Then Do
  1126.                       /*------------(Directory path not exists)-----------*/
  1127.                       Call MakePath SubStr(_destPath, 1, LastPos('\', _destPath))
  1128.                       rc = SysMkDir( _destPath )
  1129.                       If rc > 0 & rc \= 5 Then
  1130.                         Say 'Destination directory:' _destPath 'not created. RC=' rc
  1131.                       Else
  1132.                         Say _destPath 'successful created'
  1133.                     End
  1134.  
  1135.                     Return _destPath
  1136.  
  1137.  
  1138. ΓòÉΓòÉΓòÉ 12.11. NoMult ΓòÉΓòÉΓòÉ
  1139.  
  1140.  
  1141.                     /*=============( Exclude multiple items )=============*/
  1142.                     /*                                                 13 */
  1143.                     /* Name.......: NoMult                                */
  1144.                     /*                                                    */
  1145.                     /* Function...: Excludes multiple lines from a sorted */
  1146.                     /*              file                                  */
  1147.                     /* Call parm..: Nothing                               */
  1148.                     /* Returns....: Nothing (0). The result will be placed*/
  1149.                     /*              on the stack!                         */
  1150.                     /*                                                    */
  1151.                     /* Syntax.....: Call NoMult / y = NoMult()            */
  1152.                     /*                                                    */
  1153.                     /* Notes......: The elements to exclude must be       */
  1154.                     /*              saved in the stem named so as the     */
  1155.                     /*              stem in this Procedure (in this case  */
  1156.                     /*              "STEM.")                              */
  1157.                     /*              stem.0 must contain the number of     */
  1158.                     /*              elements in stem.                     */
  1159.                     /*              The stem variable must be previously  */
  1160.                     /*              sorted                                */
  1161.                     /*              The result will be placed on the      */
  1162.                     /*              stack!                                */
  1163.                     /*                                                    */
  1164.                     /* Changes....: No                                    */
  1165.                     /*                                                    */
  1166.                     /* (C) Copyright Janosch R. Kowalczyk, 1996.          */
  1167.                     /* All rights reserved.                               */
  1168.                     /*====================================================*/
  1169.                     NoMult: Procedure Expose stem.
  1170.  
  1171.                     Do i = 1 To stem.0
  1172.                       Queue stem.i
  1173.                       Do j = i + 1 while stem.i = stem.j
  1174.                       End
  1175.                       i = j - 1
  1176.                     End
  1177.  
  1178.                     Return 0
  1179.  
  1180.  
  1181. ΓòÉΓòÉΓòÉ 12.12. NoUmlaut ΓòÉΓòÉΓòÉ
  1182.  
  1183.  
  1184.                     /*============( Remove umlaut characters )============*/
  1185.                     /*                                                 15 */
  1186.                     /* Name.......: NoUmlaut                              */
  1187.                     /*                                                    */
  1188.                     /* Function...: Replace umlaut characters with double */
  1189.                     /*              character strings (╨ö -> ae, ╨ñ -> oe,  */
  1190.                     /*              ╨æ -> ue, ╤ü -> ss)                     */
  1191.                     /*                                                    */
  1192.                     /* Call parm..: _string - string with umlauts,        */
  1193.                     /*              _upper  - upper case return string    */
  1194.                     /*                        (optional)                  */
  1195.                     /*                                                    */
  1196.                     /* Returns....: translated string                     */
  1197.                     /*                                                    */
  1198.                     /* Syntax.....:                                       */
  1199.                     /*    tranStr = NoUmlaut( uString,['U'] )             */
  1200.                     /*                                                    */
  1201.                     /* Changes....: No                                    */
  1202.                     /*                                                    */
  1203.                     /* Note.......: This function calls the function      */
  1204.                     /*              ReplaceUmlaut                         */
  1205.                     /*                                                    */
  1206.                     /* Author.....: Janosch R. Kowalczyk, 1996.           */
  1207.                     /*====================================================*/
  1208.                     NoUmlaut: Procedure
  1209.                     Parse Arg _string, _upper
  1210.  
  1211.                     /*---------(Replace '╨ö' '╨₧' by 'ae' 'Ae')-----------*/
  1212.                     _string = ReplaceUmlaut( _string, '╨ö', 'ae' )
  1213.                     _string = ReplaceUmlaut( _string, '╨₧', 'Ae' )
  1214.  
  1215.                     /*---------(Replace '╨ñ' '╨⌐' by 'oe' 'Oe')-----------*/
  1216.                     _string = ReplaceUmlaut( _string, '╨ñ', 'oe' )
  1217.                     _string = ReplaceUmlaut( _string, '╨⌐', 'Oe' )
  1218.  
  1219.                     /*---------(Replace '╨æ' '╨¬' by 'ue' 'Ue')-----------*/
  1220.                     _string = ReplaceUmlaut( _string, '╨æ', 'ue' )
  1221.                     _string = ReplaceUmlaut( _string, '╨¬', 'Ue' )
  1222.  
  1223.                     /*-------------(Replace '╤ü' by 'ss')----------------*/
  1224.                     _string = ReplaceUmlaut( _string, '╤ü', 'ss' )
  1225.  
  1226.                     If Abbrev('UPPER', _upper, 1) = 1 Then
  1227.                       Return Translate( _string )
  1228.  
  1229.                     Return _string
  1230.  
  1231.                     /*========( Replace a string with an another )========*/
  1232.                     /*                                                14a */
  1233.                     /* Name.......: ReplaceUmlaut                         */
  1234.                     /*                                                    */
  1235.                     /* Function...: Find all occurences of a substring    */
  1236.                     /*              and replace it by an another          */
  1237.                     /*                                                    */
  1238.                     /* Call parm..: _string  - input string,              */
  1239.                     /*              _origin  - substring to be replaced   */
  1240.                     /*              _replStr - replace substring          */
  1241.                     /*                                                    */
  1242.                     /* Returns....: translated string                     */
  1243.                     /*                                                    */
  1244.                     /* Syntax.....:                                       */
  1245.                     /*    tranStr = ReplaceUmlaut( String, origin, repl ) */
  1246.                     /*                                                    */
  1247.                     /* Changes....: No                                    */
  1248.                     /*                                                    */
  1249.                     /* Note.......: This function is called from NoUmlaut */
  1250.                     /*              and was developed for this purpose    */
  1251.                     /*              only. It isn't able to replace sub-   */
  1252.                     /*              strings that have same characters in  */
  1253.                     /*              both - origin and replace string!     */
  1254.                     /*                                                    */
  1255.                     /* Author.....: Janosch R. Kowalczyk, 1996.           */
  1256.                     /*====================================================*/
  1257.                     ReplaceUmlaut: Procedure
  1258.                     Parse Arg _string, _origin, _replStr
  1259.  
  1260.                     /*---( Same characters in the input and output strings )---*/
  1261.                     If Verify( _origin, _replStr, 'M' ) > 0 Then Return _string
  1262.  
  1263.                     /*-----(Replace umlaut by combined characters)-----*/
  1264.                     Do While Pos( _origin, _string ) > 0
  1265.                       Parse Var _string _prefix_ (_origin) _suffix_
  1266.                       _string = _prefix_ || _replStr || _suffix_
  1267.                     End
  1268.  
  1269.                     Return _string
  1270.  
  1271.  
  1272. ΓòÉΓòÉΓòÉ 12.13. PlayFile ΓòÉΓòÉΓòÉ
  1273.  
  1274.  
  1275.                     /*================(Play digital file)================*/
  1276.                     /* :-)                                OS/2 Only!!! 8 */
  1277.                     /* Name.......: PlayFile                             */
  1278.                     /*                                                   */
  1279.                     /* Function...: Play digital WAV/MID file            */
  1280.                     /*                                                   */
  1281.                     /* Call parms.: File name to play                    */
  1282.                     /* Returns....: RC from the last mciRexx function    */
  1283.                     /*                                                   */
  1284.                     /* Sample call: rc = PlayFile('bach.mid')            */
  1285.                     /*                                                   */
  1286.                     /* Changes....: No                                   */
  1287.                     /*                                                   */
  1288.                     /* (C) Copyright Janosch R. Kowalczyk, 1996.         */
  1289.                     /* All rights reserved.                              */
  1290.                     /*===================================================*/
  1291.                     PlayFile: Procedure
  1292.  
  1293.                     Arg CmdObject
  1294.                     If CmdObject = '' Then Return -1
  1295.  
  1296.                     loudness = 70 /* % */
  1297.                     /*--------------(Prepare MCI-commands)---------------*/
  1298.                     CmdStr.1 = 'OPEN' CmdObject 'ALIAS W WAIT'
  1299.                     CmdStr.2 = 'SET W TIME FORMAT MS WAIT'
  1300.                     CmdStr.3 = 'SET W AUDIO VOLUME' loudness 'WAIT'
  1301.                     CmdStr.4 = 'PLAY W WAIT'
  1302.                     /*------------(Play digital WAV/MID file)------------*/
  1303.                     Do i = 1 To 4
  1304.                       /*-----------(Send MCI command strings)------------*/
  1305.                       rc = mciRxSendString(CmdStr.i, 'retstrvar', '0','0')
  1306.                       If rc > 0 Then Leave
  1307.                     End
  1308.  
  1309.                     CmdStr = 'CLOSE W WAIT'
  1310.                     /*--------------(Send MCI command string)--------------*/
  1311.                     rc = mciRxSendString(CmdStr, 'retstrvar', '0','0')
  1312.  
  1313.                     Return rc
  1314.  
  1315.  
  1316. ΓòÉΓòÉΓòÉ 12.14. QSort ΓòÉΓòÉΓòÉ
  1317.  
  1318.  
  1319.                     /*====================(Quick sort)====================*/
  1320.                     /* :-D                                              4 */
  1321.                     /* Name.......: QSort                                 */
  1322.                     /*                                                    */
  1323.                     /* Function...: Quick Sort for a stem variable        */
  1324.                     /* Call parm..: No                                    */
  1325.                     /* Returns....: Left-Right span                       */
  1326.                     /*                                                    */
  1327.                     /* Sample call: Call QSort                            */
  1328.                     /*                                                    */
  1329.                     /* Notes......: The elements to sort for must be      */
  1330.                     /*              saved in the stem named so as the     */
  1331.                     /*              stem in this Procedure (in this case  */
  1332.                     /*              "STEM.")                              */
  1333.                     /*              stem.0 must contain the number of     */
  1334.                     /*              elements in stem.                     */
  1335.                     /*                                                    */
  1336.                     /* Changes....: No                                    */
  1337.                     /*                                                    */
  1338.                     /* (C) Copyright Janosch R. Kowalczyk, 1996.          */
  1339.                     /* All rights reserved.                               */
  1340.                     /*====================================================*/
  1341.                     QSort: Procedure Expose stem.
  1342.  
  1343.                     Arg left, right
  1344.  
  1345.                     If left  = '' Then left  = 1
  1346.                     If right = '' Then right = stem.0
  1347.                     If right > left Then Do
  1348.                       i = left
  1349.                       j = right
  1350.                       k = (left+right)%2
  1351.                       x = stem.k
  1352.                       Do Until i > j
  1353.                         Do While stem.i < x; i = i + 1; End
  1354.                         Do While stem.j > x; j = j - 1; End
  1355.                         If i <= j Then Do
  1356.                           xchg = stem.i
  1357.                           stem.i = stem.j
  1358.                           stem.j = xchg
  1359.                           i = i + 1
  1360.                           j = j - 1
  1361.                         End
  1362.                       End
  1363.                       y = QSort(left,j)
  1364.                       y = QSort(i,right)
  1365.                     End
  1366.  
  1367.                     Return right - left
  1368.  
  1369.  
  1370. ΓòÉΓòÉΓòÉ 12.15. ReplaceString ΓòÉΓòÉΓòÉ
  1371.  
  1372.  
  1373.                     /*========( Replace a string with an another )========*/
  1374.                     /*                                                 16 */
  1375.                     /* Name.......: StrRepl                               */
  1376.                     /*                                                    */
  1377.                     /* Function...: Find all occurences of a substring    */
  1378.                     /*              and replace it by an another          */
  1379.                     /*                                                    */
  1380.                     /* Call parm..: _string  - input string,              */
  1381.                     /*              _origin  - substring to be replaced   */
  1382.                     /*              _replStr - replace substring          */
  1383.                     /*                                                    */
  1384.                     /* Returns....: translated string                     */
  1385.                     /*                                                    */
  1386.                     /* Syntax.....:                                       */
  1387.                     /*  tranStr = ReplaceString(_string,_origin,_replStr) */
  1388.                     /*                                                    */
  1389.                     /* Changes....: No                                    */
  1390.                     /*                                                    */
  1391.                     /* Author.....: Janosch R. Kowalczyk, 1996.           */
  1392.                     /*====================================================*/
  1393.                     StrRepl: Procedure
  1394.                     Parse Arg _string, _origin, _replStr
  1395.  
  1396.                     /*---( Find a substring to replace? )---*/
  1397.                     _lastPos = LastPos( _origin, _string )
  1398.  
  1399.                     If _lastPos > 0 Then Do
  1400.  
  1401.                       /*---( Get prefix to the substring )---*/
  1402.                       If _lastPos = 1 Then _prefix = ''
  1403.                       Else _prefix = SubStr( _string, 1, _lastPos - 1 )
  1404.  
  1405.                       /*---( Get suffix of the substring )---*/
  1406.                       _suffix = SubStr( _string, _lastPos + Length( _origin ))
  1407.  
  1408.                       /*---( Find next substring to replace )---*/
  1409.                       Return StrRepl( _prefix, _origin, _replStr ) || _replStr || _suffix
  1410.  
  1411.                     End
  1412.                     Else
  1413.                       Return _string
  1414.  
  1415.  
  1416. ΓòÉΓòÉΓòÉ 12.16. ShlSort ΓòÉΓòÉΓòÉ
  1417.  
  1418.  
  1419.                     /*====================(Shell sort)=====================*/
  1420.                     /* :-)                                               5 */
  1421.                     /* Name.......: ShlSort                                */
  1422.                     /*                                                     */
  1423.                     /* Function...: Shell Sort for a stem variable         */
  1424.                     /* Call parm..: No                                     */
  1425.                     /* Returns....: nothing (NULL string)                  */
  1426.                     /*                                                     */
  1427.                     /* Sample call: Call ShlSort                           */
  1428.                     /*                                                     */
  1429.                     /* Notes......: The elements to sort for must be       */
  1430.                     /*              saved in the stem named so as the      */
  1431.                     /*              stem in this Procedure (in this case   */
  1432.                     /*              "STEM.")                               */
  1433.                     /*              stem.0 must contain the number of      */
  1434.                     /*              elements in stem.                      */
  1435.                     /*                                                     */
  1436.                     /* Changes....: No                                     */
  1437.                     /*                                                     */
  1438.                     /* (C) Copyright Janosch R. Kowalczyk, 1996.           */
  1439.                     /* All rights reserved.                                */
  1440.                     /*=====================================================*/
  1441.                     ShlSort: Procedure Expose stem.
  1442.  
  1443.                     parts = 3        /* adjust to your necessities ( >1 ) */
  1444.                     Do n = 1 To parts
  1445.                       incr = 2**n - 1
  1446.                       Do j = incr + 1 To stem.0
  1447.                         i = j - incr
  1448.                         xchg = stem.j
  1449.                         Do While xchg < stem.i & i > 0
  1450.                           m = i + incr
  1451.                           stem.m = stem.i
  1452.                           i = i - incr
  1453.                         End /* Do While xchg ... */
  1454.                         m = i + incr
  1455.                         stem.m = xchg
  1456.                       End /* Do j = incr ... */
  1457.                     End /* Do n = 1 ... */
  1458.  
  1459.                     Return ''
  1460.  
  1461.  
  1462. ΓòÉΓòÉΓòÉ 12.17. ToLower ΓòÉΓòÉΓòÉ
  1463.  
  1464.  
  1465.                     /*=============(Translate To Lower Case)===============*/
  1466.                     /* :-)                                               9 */
  1467.                     /* Name.......: ToLower                                */
  1468.                     /*                                                     */
  1469.                     /* Function...: Translate entired string to lower      */
  1470.                     /*              case                                   */
  1471.                     /* Call parms.: String to translate                    */
  1472.                     /* Returns....: Translated string                      */
  1473.                     /*                                                     */
  1474.                     /* Syntax.....: lowString = ToLower(upperString)       */
  1475.                     /*                                                     */
  1476.                     /* Changes....: 27.12.1996 - XRange used               */
  1477.                     /*                                                     */
  1478.                     /* (C) Copyright Janosch R. Kowalczyk, 1996.           */
  1479.                     /* All rights reserved.                                */
  1480.                     /*=====================================================*/
  1481.                     ToLower: Procedure
  1482.  
  1483.                     /*------------(Lower Case entired string)--------------*/
  1484.                     Parse Arg Upper_String
  1485.  
  1486.                     Lowers = XRange('a', 'z') || '╨ö╨ñ╨æ'
  1487.                     Uppers = XRange('A', 'Z') || '╨₧╨⌐╨¬'
  1488.  
  1489.                     Return Translate(Upper_String, Lowers, Uppers)
  1490.  
  1491.  
  1492. ΓòÉΓòÉΓòÉ 12.18. SqrRoot ΓòÉΓòÉΓòÉ
  1493.  
  1494.  
  1495.                     /*====================(Square root)====================*/
  1496.                     /* :-)                                               6 */
  1497.                     /* Name.......: SqrRoot                                */
  1498.                     /*                                                     */
  1499.                     /* Function...: Square root evolution for the call     */
  1500.                     /*              parameter                              */
  1501.                     /* Call parms.: Evolution number, precision            */
  1502.                     /* Returns....: Square root                            */
  1503.                     /*                                                     */
  1504.                     /* Syntax.....: sqrt = SqrRoot(number, [precision])    */
  1505.                     /*                                                     */
  1506.                     /* Notes......: precision is the highest possible      */
  1507.                     /*              error for the evaluation.              */
  1508.                     /*              Default Value is 0.00001               */
  1509.                     /*              You are responsible for the valid      */
  1510.                     /*              number value                           */
  1511.                     /*                                                     */
  1512.                     /* Changes....: No                                     */
  1513.                     /*                                                     */
  1514.                     /* (C) Copyright Janosch R. Kowalczyk, 1996.           */
  1515.                     /* All rights reserved.                                */
  1516.                     /*=====================================================*/
  1517.                     SqrRoot: Procedure
  1518.  
  1519.                     Arg number, precision
  1520.  
  1521.                     If Datatype(number) \= 'NUM' Then Return -1
  1522.                     If precision <= 0 | precision > 1 Then precision = 0.000001
  1523.  
  1524.                     sqrt = 1
  1525.  
  1526.                     Do Until Abs(sqrt_old - sqrt) < precision
  1527.                       sqrt_old = sqrt
  1528.                       sqrt = (sqrt_old * sqrt_old + number) / (2 * sqrt_old)
  1529.                     End /* Do Until ... */
  1530.  
  1531.                     Return sqrt
  1532.  
  1533.  
  1534. ΓòÉΓòÉΓòÉ 12.19. CubeRoot ΓòÉΓòÉΓòÉ
  1535.  
  1536.  
  1537.                     /*====================( Cube root )====================*/
  1538.                     /* :-)                                               7 */
  1539.                     /* Name.......: CubeRoot                               */
  1540.                     /*                                                     */
  1541.                     /* Function...: Cube root evolution for the calling    */
  1542.                     /*              parameter                              */
  1543.                     /* Call parms.: Evolution number, precision (optional) */
  1544.                     /* Returns....: Cube root                              */
  1545.                     /*                                                     */
  1546.                     /* Syntax.....: cbrt = CubeRoot(_digit, [precision])   */
  1547.                     /*                                                     */
  1548.                     /* Notes......: precision is the highest possible      */
  1549.                     /*              error for the evaluation.              */
  1550.                     /*              Default Value is 0.00001               */
  1551.                     /*              You are responsible for the valid      */
  1552.                     /*              number value                           */
  1553.                     /*                                                     */
  1554.                     /* Changes....: No                                     */
  1555.                     /*                                                     */
  1556.                     /* (C) Copyright Janosch R. Kowalczyk, 1997.           */
  1557.                     /* All rights reserved.                                */
  1558.                     /*=====================================================*/
  1559.                     CubeRoot: Procedure
  1560.  
  1561.                     Arg _digit, precision
  1562.  
  1563.                     If Datatype(_digit) \= 'NUM' Then Return -1
  1564.                     If precision <= 0 | precision > 1 Then precision = 0.000001
  1565.  
  1566.                     cbrt = 1
  1567.  
  1568.                     Do Until Abs(cbrt_old - cbrt) < precision
  1569.                       cbrt_old = cbrt
  1570.                       cbrt = ( 2 * cbrt_old ** 3 + _digit ) / ( 3 * cbrt_old ** 2 )
  1571.                     End /* Do Until ... */
  1572.  
  1573.                     Return cbrt
  1574.  
  1575.  
  1576. ΓòÉΓòÉΓòÉ 12.20. Euclid ΓòÉΓòÉΓòÉ
  1577.  
  1578.  
  1579.                     /*=============( Greatest common divisor )============*/
  1580.                     /*                                                 19 */
  1581.                     /* Name.......: EuclidGCD                             */
  1582.                     /*                                                    */
  1583.                     /* Function...: Get greatest common divisor (Euclids  */
  1584.                     /*              algorithm)                            */
  1585.                     /* Call parm..: _counter                              */
  1586.                     /*              _denuminator                          */
  1587.                     /* Returns....: gcd                                   */
  1588.                     /*                                                    */
  1589.                     /* Syntax.....:                                       */
  1590.                     /*    gcd = EuclidGCD( _counter, _denuminator )       */
  1591.                     /*                                                    */
  1592.                     /* Changes....: No                                    */
  1593.                     /*                                                    */
  1594.                     /* (C) Copyright Janosch R. Kowalczyk, 1997.          */
  1595.                     /* All rights reserved.                               */
  1596.                     /*====================================================*/
  1597.                     /*--------------(Greatest common divisor)-------------*/
  1598.                     EuclidGCD: Procedure
  1599.                     Arg _counter, _denuminator
  1600.  
  1601.                     Do Until _counter = 0
  1602.                       If _counter < _denuminator Then Do
  1603.                         _Xchange     = _counter
  1604.                         _counter     = _denuminator
  1605.                         _denuminator = _Xchange
  1606.                       End
  1607.                       _counter = _counter - _denuminator
  1608.                     End
  1609.  
  1610.                     Return _denuminator
  1611.  
  1612.  
  1613. ΓòÉΓòÉΓòÉ 13. Using and testing. ΓòÉΓòÉΓòÉ
  1614.  
  1615.  
  1616.           All here described routines are written either as internal REXX 
  1617.           subroutins (return no value) or as internal REXX functions (return a 
  1618.           value). 
  1619.           You can simply copy a required code template at end of your REXX 
  1620.           program (after exit statement) to use it. To do it use either Cut and 
  1621.           Paste options of your text edtitor or use the code template from the 
  1622.           Greed's Templates Controller. 
  1623.           To work with the option Cut of a text editor you should use templates 
  1624.           contained in the file RXALGxxx.CMD. 
  1625.           To work with the Templates Controller use templates from the file 
  1626.           RXALGxxx.FNC. 
  1627.           They are test command files for all these routines. You can find them 
  1628.           in the subdirectory named TESTALGO. It is one test command file for 
  1629.           each soubroutine from this package. Click twice the command files 
  1630.           icon to start the test. 
  1631.           To keep the code templates simply, I've not (in most cases) 
  1632.           implemented error checking. That is why you are responsible for all 
  1633.           call parameters and resources used from these routines. 
  1634.  
  1635.  
  1636. ΓòÉΓòÉΓòÉ 14. Tips. ΓòÉΓòÉΓòÉ
  1637.  
  1638.  
  1639.           There are many diverse publications about programming language REXX, 
  1640.           but my personal preference stands for two publications: 
  1641.  
  1642.                Rexx Tips & Trics of Bernd Schemmer. 
  1643.                Rexx Sourcebook of Dirk Terrell. 
  1644.  
  1645.           These books are the collections of REXX informations gotten from 
  1646.           various places on the Internet and from various Authors. 
  1647.  
  1648.  
  1649. ΓòÉΓòÉΓòÉ 14.1. REXX Tips & Tricks ΓòÉΓòÉΓòÉ
  1650.  
  1651.  
  1652.           REXX Tips & Tricks (INF file) 
  1653.  
  1654.                     Bernd Schemmer
  1655.                     Team OS/2, Certfied LAN Server Engineer, Certfied OS/2 Engineer
  1656.                     Baeckerweg 48
  1657.                     D-60316 Frankfurt
  1658.                     Germany
  1659.  
  1660.                     CompuServe: 100104,613
  1661.                     Internet: 100104.613@compuserve.com
  1662.  
  1663.           Source of supply: CIS, Forum OS2DF1, Library REXX/Other Languages. 
  1664.           File name RXTTxxx.* (where xxx stands for the version number, i.e.: 
  1665.           250) 
  1666.  
  1667.  
  1668. ΓòÉΓòÉΓòÉ 14.2. REXX Sourcebook ΓòÉΓòÉΓòÉ
  1669.  
  1670.  
  1671.           REXX Sourcebook (INF file) 
  1672.  
  1673.                     Dirk Terrell
  1674.  
  1675.                     terrell@astro.ufl.edu
  1676.  
  1677.           Source of supply: BBS. 
  1678.           File name RS960115.* 
  1679.  
  1680.  
  1681. ΓòÉΓòÉΓòÉ 15. Greed. ΓòÉΓòÉΓòÉ
  1682.  
  1683.  
  1684.           Greed - General Rexx Extended Editor - is a small PM developing 
  1685.           environment to write, store and control of code templates. It can be 
  1686.           used to control the code sections for all programming languages. You 
  1687.           can find it in the CompuServe forum OS2USER (library: Open forum) 
  1688.           under the name GREED.ZIP. 
  1689.           Greed is a universal source code generator to work with user defined 
  1690.           code templates. 
  1691.           Greed has a modular structure and consists of four independent 
  1692.           modules: 
  1693.  
  1694.               Greed Editor, the small Rexx editor. 
  1695.               Templates Controller, the universal code controller. 
  1696.               Template Editor to edit the templates for Greed and Greed 
  1697.                Templates Controller. 
  1698.               Browser  - the small file viewer with both text and hexadecimal 
  1699.                mode. 
  1700.