home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / ENTERPRS / CPM / UTILS / A / BYTETURB.ARC / INTEGERS.LIB < prev    next >
Text File  |  1989-09-27  |  4KB  |  157 lines
  1. {
  2.                  procedure and functions in this library
  3.  
  4.   Sign               returns sign (-1,0,+1) of integer value
  5.   Min                returns minimum of two integers
  6.   Max                returns maximum of two integers
  7.   ISwap              trade two integer values
  8.   ISqrt              returns integer square root of integer value
  9.   Condition          forces integer into the range Min..Max
  10.   AMin               returns minimum integer in array
  11.   AMax               returns maximum integer in array
  12.  
  13. }
  14.  
  15. function sign(val : integer) : integer;
  16. {
  17.        purpose       returns sign (-1,0,1) of Val
  18.        last update   23 Jun 85
  19. }
  20. begin
  21.   if val > 0
  22.     then sign := 1
  23.   else if val < 0
  24.     then sign := -1
  25.     else sign :=  0
  26. end; { of func Sign }
  27.  
  28. function min(val1,val2 : integer) : integer;
  29. {
  30.        purpose       returns minimum of two integers
  31.        last update   08 Jul 85
  32. }
  33. begin
  34.   if val1 < val2
  35.     then min := val1
  36.     else min := val2
  37. end; { of func Min }
  38.  
  39. function max(val1,val2 : integer) : integer;
  40. {
  41.        purpose       returns maximum of two integers
  42.        last update   08 Jul 85
  43. }
  44. begin
  45.   if val1 > val2
  46.     then max := val1
  47.     else max := val2
  48. end; { of func Max }
  49.  
  50. procedure iswap(var val1,val2 : integer);
  51. {
  52.        purpose       swaps values of Val1 and Val2
  53.        last update   08 Jul 85
  54. }
  55. var
  56.   temp               : integer;
  57. begin
  58.   temp := val1;
  59.   val1 := val2;
  60.   val2 := temp
  61. end; { of proc ISwap }
  62.  
  63. function isqrt(val : integer) : integer;
  64. {
  65.        purpose       returns integer square root of Val
  66.        note well:    this routine rounds to the nearest square root
  67.        last update   23 Jan 85
  68. }
  69. var
  70.   oddseq,square,root : integer;
  71. begin
  72.   oddseq := -1;
  73.   square :=  0;
  74.   repeat
  75.     oddseq := oddseq + 2;
  76.     square := square + oddseq
  77.   until val < square;
  78.   root := succ(oddseq shr 1);
  79.   if val <= square - root
  80.     then root := pred(root);
  81.   isqrt := root
  82. end; { of func ISqrt }
  83.  
  84. procedure condition(min : integer; var val : integer; max : integer);
  85. {
  86.        purpose       forces Min <= Val <= Max
  87.        last update   08 Jul 85
  88. }
  89. begin
  90.   if max < min
  91.     then iswap(min,max);
  92.   if val < min
  93.     then val := min
  94.   else if max < val
  95.     then val := max
  96. end; { of proc Condition }
  97.  
  98. function amin(var iaddr; size : integer; var mndx : integer) : integer;
  99. {
  100.        purpose       finds minimum value in integer array
  101.  
  102.        note          Size should be the size in *words*; if the
  103.                      the function SizeOf is used, then you need
  104.                      to divide the result by 2 before passing it on:
  105.                      MVal := AMin(IArray,(SizeOf(IArray) shr 1),Indx);
  106.  
  107.        last update   09 Jul 85
  108. }
  109. const
  110.   halfmax            = 16383; { MaxInt div 2 }
  111. type
  112.   dummyarray         = array[1..halfmax] of integer;
  113. var
  114.   a1                 : dummyarray absolute iaddr;
  115.   indx,temp          : integer;
  116. begin
  117.   temp := maxint;
  118.   mndx := 0;
  119.   for indx := 1 to size do
  120.     if a1[indx] < temp then begin
  121.       mndx := indx;
  122.       temp := a1[indx]
  123.     end;
  124.   amin := temp
  125. end; { of func AMin }
  126.  
  127. function amax(var iaddr; size : integer; var mndx : integer) : integer;
  128. {
  129.        purpose       finds maximum value in integer array
  130.  
  131.        note          Size should be the size in *words*; if the
  132.                      the function SizeOf is used, then you need
  133.                      to divide the result by 2 before passing it on:
  134.                      MVal := AMax(IArray,(SizeOf(IArray) shr 1),Indx);
  135.  
  136.        last update   09 Jul 85
  137. }
  138. const
  139.   halfmax            = 16383; { MaxInt div 2 }
  140. type
  141.   dummyarray         = array[1..halfmax] of integer;
  142. var
  143.   a1                 : dummyarray absolute iaddr;
  144.   indx,temp          : integer;
  145. begin
  146.   temp := - maxint - 1; { lowest possible integer value }
  147.   mndx := 0;
  148.   for indx := 1 to size do
  149.     if a1[indx] > temp then begin
  150.       mndx := indx;
  151.       temp := a1[indx]
  152.     end;
  153.   amax := temp
  154. end; { of func AMax }
  155.  
  156. if a1[indx] > temp then begin
  157.       m