home *** CD-ROM | disk | FTP | other *** search
/ Frostbyte's 1980s DOS Shareware Collection / floppyshareware.zip / floppyshareware / USCX / PASTOOL3.ZIP / UTILITY.AR < prev    next >
Text File  |  1983-09-06  |  7KB  |  383 lines
  1. -h- addstr.ut 362
  2. {$debug-}
  3. MODULE MADDSTR;
  4.  
  5. {$include:'globcons.inc'}
  6. {$include:'globtyps.inc'}
  7.  
  8. { addstr -- put c in outset[j] if it fits, increment j }
  9. function addstr (c : character; var outset : sstring;
  10.   var j : integer; maxset : integer) : boolean;
  11. begin
  12.  if (j > maxset) then
  13.   addstr := false
  14.  else begin
  15.   outset[j] := c;
  16.   j := j + 1;
  17.   addstr := true
  18.  end
  19. end;
  20.  
  21. END.
  22. -h- ctoi.ut 540
  23. {$debug-}
  24. MODULE MCTOI;
  25.  
  26. {$include:'globcons.inc'}
  27. {$include:'globtyps.inc'}
  28. {$include:'isdigit.dcl'}
  29.  
  30. { ctoi -- convert string at s[i] to integer, increment i }
  31. function ctoi (var s : sstring; var i : integer) : integer;
  32. var
  33.  n, sign : integer;
  34. begin
  35.  while (s[i] = BLANK) or (s[i] = TAB) do
  36.   i := i + 1;
  37.  if (s[i] = MINUS) then
  38.   sign := -1
  39.  else
  40.   sign := 1;
  41.  if (s[i] = PLUS) or (s[i] = MINUS) then
  42.   i := i + 1;
  43.  n := 0;
  44.  while (isdigit(s[i])) do begin
  45.   n := 10 * n + s[i] - ord('0');
  46.   i := i + 1
  47.  end;
  48.  ctoi := sign * n
  49. end;
  50.  
  51. END.
  52. -h- equal.ut 317
  53. {$debug-}
  54. MODULE MEQUAL;
  55.  
  56. {$include:'globcons.inc'}
  57. {$include:'globtyps.inc'}
  58.  
  59. { equal -- test two strings for equality }
  60. function equal (var str1, str2 : sstring) : boolean;
  61. var
  62.  i : integer;
  63. begin
  64.  i := 1;
  65.  while (str1[i] = str2[i]) and (str1[i] <> ENDSTR) do
  66.   i := i + 1;
  67.  equal := (str1[i] = str2[i])
  68. end;
  69.  
  70. END.
  71. -h- esc.ut 471
  72. {$debug-}
  73. MODULE MESC;
  74.  
  75. {$include:'globcons.inc'}
  76. {$include:'globtyps.inc'}
  77.  
  78. { esc -- map s[i] into escaped character, increment i }
  79. function esc (var s : sstring; var i : integer) : character;
  80. begin
  81.  if (s[i] <> ESCAPE) then
  82.   esc := s[i]
  83.  else if (s[i+1] = ENDSTR) then  { @ not special at end }
  84.   esc := ESCAPE
  85.  else begin
  86.   i := i + 1;
  87.   if (s[i] = ord('n')) then
  88.    esc := NEWLINE
  89.   else if (s[i] = ord('t')) then
  90.    esc := TAB
  91.   else
  92.    esc := s[i]
  93.  end
  94. end;
  95.  
  96. END.
  97. -h- fcopy.ut 296
  98. {$debug-}
  99. MODULE MFCOPY;
  100.  
  101. {$include:'globcons.inc'}
  102. {$include:'globtyps.inc'}
  103. {$include:'getcf.dcl'}
  104. {$include:'putcf.dcl'}
  105.  
  106. { fcopy -- copy file fin to file fout }
  107. procedure fcopy (fin, fout : filedesc);
  108. var
  109.  c : character;
  110. begin
  111.  while (getcf(c, fin) <> ENDFILE) do
  112.   putcf(c, fout)
  113. end;
  114.  
  115. END.
  116. -h- imax.ut 228
  117. {$debug-}
  118. MODULE MIMAX;
  119.  
  120. {$include:'globcons.inc'}
  121. {$include:'globtyps.inc'}
  122.  
  123. { imax -- compute maximum of two integers }
  124. function imax (x, y : integer) : integer;
  125. begin
  126.  if (x > y) then
  127.   imax := x
  128.  else
  129.   imax := y
  130. end;
  131.  
  132. END.
  133. -h- imin.ut 228
  134. {$debug-}
  135. MODULE MIMIN;
  136.  
  137. {$include:'globcons.inc'}
  138. {$include:'globtyps.inc'}
  139.  
  140. { imin -- compute minimum of two integers }
  141. function imin (x, y : integer) : integer;
  142. begin
  143.  if (x < y) then
  144.   imin := x
  145.  else
  146.   imin := y
  147. end;
  148.  
  149. END.
  150. -h- index.ut 350
  151. {$debug-}
  152. MODULE MINDEX;
  153.  
  154. {$include:'globcons.inc'}
  155. {$include:'globtyps.inc'}
  156.  
  157. { index -- find position of character c in string s }
  158. function index (var s : sstring; c : character) : integer;
  159. var
  160.  i : integer;
  161. begin
  162.  i := 1;
  163.  while (s[i] <> c) and (s[i] <> ENDSTR) do
  164.   i := i + 1;
  165.  if (s[i] = ENDSTR) then
  166.   index := 0
  167.  else
  168.   index := i
  169. end;
  170.  
  171. END.
  172. -h- isalphan.ut 284
  173. {$debug-}
  174. MODULE MISALPHANUM;
  175.  
  176. {$include:'globcons.inc'}
  177. {$include:'globtyps.inc'}
  178.  
  179. { isalphanum -- true if c is letter or digit }
  180. function isalphanum (c : character) : boolean;
  181. begin
  182.  isalphanum := c in
  183.   [ord('a')..ord('z'),
  184.    ord('A')..ord('Z'),
  185.    ord('0')..ord('9')]
  186. end;
  187.  
  188. END.
  189. -h- isdigit.ut 216
  190. {$debug-}
  191. MODULE MISDIGIT;
  192.  
  193. {$include:'globcons.inc'}
  194. {$include:'globtyps.inc'}
  195.  
  196. { isdigit -- true if c is a digit }
  197. function isdigit (c : character) : boolean;
  198. begin
  199.  isdigit := c in [ord('0')..ord('9')]
  200. end;
  201.  
  202. END.
  203. -h- isletter.ut 261
  204. {$debug-}
  205. MODULE MISLETTER;
  206.  
  207. {$include:'globcons.inc'}
  208. {$include:'globtyps.inc'}
  209.  
  210. { isletter -- true if c is a letter of either case }
  211. function isletter (c : character) : boolean;
  212. begin
  213.  isletter :=
  214.   c in [ord('a')..ord('z')] + [ord('A')..ord('Z')]
  215. end;
  216.  
  217. END.
  218. -h- islower.ut 226
  219. {$debug-}
  220. MODULE MISLOWER;
  221.  
  222. {$include:'globcons.inc'}
  223. {$include:'globtyps.inc'}
  224.  
  225. { islower -- true if c is lower case letter }
  226. function islower (c : character) : boolean;
  227. begin
  228.  islower := c in [ord('a')..ord('z')]
  229. end;
  230.  
  231. END.
  232. -h- isupper.ut 226
  233. {$debug-}
  234. MODULE MISUPPER;
  235.  
  236. {$include:'globcons.inc'}
  237. {$include:'globtyps.inc'}
  238.  
  239. { isupper -- true if c is upper case letter }
  240. function isupper (c : character) : boolean;
  241. begin
  242.  isupper := c in [ord('A')..ord('Z')]
  243. end;
  244.  
  245. END.
  246. -h- itoc.ut 451
  247. {$debug-}
  248. MODULE MITOC;
  249.  
  250. {$include:'globcons.inc'}
  251. {$include:'globtyps.inc'}
  252.  
  253. { itoc - convert integer n to char string in s[i]... }
  254. function itoc (n : integer; var s : sstring; i : integer)
  255.   : integer; { returns end of s }
  256. begin
  257.  if (n < 0) then begin
  258.   s[i] := ord('-');
  259.   itoc := itoc(-n, s, i+1)
  260.  end
  261.  else begin
  262.   if (n >= 10) then
  263.    i := itoc(n div 10, s, i);
  264.   s[i] := n mod 10 + ord('0');
  265.   s[i+1] := ENDSTR;
  266.   itoc := i + 1
  267.  end
  268. end;
  269.  
  270. END.
  271. -h- length.ut 266
  272. {$debug-}
  273. MODULE MLENGTH;
  274.  
  275. {$include:'globcons.inc'}
  276. {$include:'globtyps.inc'}
  277.  
  278. { length -- compute length of string }
  279. function length (var s : sstring) : integer;
  280. var
  281.  n : integer;
  282. begin
  283.  n := 1;
  284.  while (s[n] <> ENDSTR) do
  285.   n := n + 1;
  286.  length := n - 1
  287. end;
  288.  
  289. END.
  290. -h- mustcrea.ut 438
  291. {$debug-}
  292. MODULE MMUSTCREATE;
  293.  
  294. {$include:'globcons.inc'}
  295. {$include:'globtyps.inc'}
  296. {$include:'create.dcl'}
  297. {$include:'putstr.dcl'}
  298. {$include:'error.dcl' }
  299.  
  300. { mustcreate -- create file or die }
  301. function mustcreate (var name : sstring; mode : integer)
  302.   : filedesc;
  303. var
  304.  fd : filedesc;
  305. begin
  306.  fd := create(name, mode);
  307.  if (fd = IOERROR) then begin
  308.   putstr(name, STDERR);
  309.   error(': cannot create file')
  310.  end;
  311.  mustcreate := fd
  312. end;
  313.  
  314. END.
  315. -h- mustopen.ut 424
  316. {$debug-}
  317. MODULE MMUSTOPEN;
  318.  
  319. {$include:'globcons.inc'}
  320. {$include:'globtyps.inc'}
  321. {$include:'open.dcl'  }
  322. {$include:'putstr.dcl'}
  323. {$include:'error.dcl' }
  324.  
  325. { mustopen -- open file or die }
  326. function mustopen (var name : sstring; mode : integer)
  327.   : filedesc;
  328. var
  329.  fd : filedesc;
  330. begin
  331.  fd := open(name, mode);
  332.  if (fd = IOERROR) then begin
  333.   putstr(name, STDERR);
  334.   error(': cannot open file')
  335.  end;
  336.  mustopen := fd
  337. end;
  338.  
  339. END.
  340. -h- putdec.ut 361
  341. {$debug-}
  342. MODULE MPUTDEC;
  343.  
  344. {$include:'globcons.inc'}
  345. {$include:'globtyps.inc'}
  346. {$include:'itoc.dcl'}
  347. {$include:'putc.dcl'}
  348.  
  349. { putdec -- put decimal integer n in field width >= w }
  350. procedure putdec (n, w : integer);
  351. var
  352.  i, nd : integer;
  353.  s : string;
  354. begin
  355.  nd := itoc(n, s, 1);
  356.  for i := nd to w do
  357.   putc(BLANK);
  358.  for i := 1 to nd-1 do
  359.   putc(s[i])
  360. end;
  361.  
  362. END.
  363. -h- scopy.ut 335
  364. {$debug-}
  365. MODULE MSCOPY;
  366.  
  367. {$include:'globcons.inc'}
  368. {$include:'globtyps.inc'}
  369.  
  370. { scopy -- copy string at src[i] to dest[j] }
  371. procedure scopy (var src : sstring; i : integer;
  372.   var dest : sstring; j : integer);
  373. begin
  374.  while (src[i] <> ENDSTR) do begin
  375.   dest[j] := src[i];
  376.   i := i + 1;
  377.   j := j + 1
  378.  end;
  379.  dest[j] := ENDSTR
  380. end;
  381.  
  382. END.
  383.