Programmer 7500/MAX_PROGRAMMERS.iso/INFO/PASCAL/PT03.ZIP/UTILITY.AR

Text File | 1983-09-06 | 6.8 KB | 383 lines

-h- addstr.ut 362
{$debug-}
MODULE MADDSTR;

{$include:'globcons.inc'}
{$include:'globtyps.inc'}

{ addstr -- put c in outset[j] if it fits, increment j }
function addstr (c : character; var outset : sstring;
  var j : integer; maxset : integer) : boolean;
begin
 if (j > maxset) then
  addstr := false
 else begin
  outset[j] := c;
  j := j + 1;
  addstr := true
 end
end;

END.
-h- ctoi.ut 540
{$debug-}
MODULE MCTOI;

{$include:'globcons.inc'}
{$include:'globtyps.inc'}
{$include:'isdigit.dcl'}

{ ctoi -- convert string at s[i] to integer, increment i }
function ctoi (var s : sstring; var i : integer) : integer;
var
 n, sign : integer;
begin
 while (s[i] = BLANK) or (s[i] = TAB) do
  i := i + 1;
 if (s[i] = MINUS) then
  sign := -1
 else
  sign := 1;
 if (s[i] = PLUS) or (s[i] = MINUS) then
  i := i + 1;
 n := 0;
 while (isdigit(s[i])) do begin
  n := 10 * n + s[i] - ord('0');
  i := i + 1
 end;
 ctoi := sign * n
end;

END.
-h- equal.ut 317
{$debug-}
MODULE MEQUAL;

{$include:'globcons.inc'}
{$include:'globtyps.inc'}

{ equal -- test two strings for equality }
function equal (var str1, str2 : sstring) : boolean;
var
 i : integer;
begin
 i := 1;
 while (str1[i] = str2[i]) and (str1[i] <> ENDSTR) do
  i := i + 1;
 equal := (str1[i] = str2[i])
end;

END.
-h- esc.ut 471
{$debug-}
MODULE MESC;

{$include:'globcons.inc'}
{$include:'globtyps.inc'}

{ esc -- map s[i] into escaped character, increment i }
function esc (var s : sstring; var i : integer) : character;
begin
 if (s[i] <> ESCAPE) then
  esc := s[i]
 else if (s[i+1] = ENDSTR) then  { @ not special at end }
  esc := ESCAPE
 else begin
  i := i + 1;
  if (s[i] = ord('n')) then
   esc := NEWLINE
  else if (s[i] = ord('t')) then
   esc := TAB
  else
   esc := s[i]
 end
end;

END.
-h- fcopy.ut 296
{$debug-}
MODULE MFCOPY;

{$include:'globcons.inc'}
{$include:'globtyps.inc'}
{$include:'getcf.dcl'}
{$include:'putcf.dcl'}

{ fcopy -- copy file fin to file fout }
procedure fcopy (fin, fout : filedesc);
var
 c : character;
begin
 while (getcf(c, fin) <> ENDFILE) do
  putcf(c, fout)
end;

END.
-h- imax.ut 228
{$debug-}
MODULE MIMAX;

{$include:'globcons.inc'}
{$include:'globtyps.inc'}

{ imax -- compute maximum of two integers }
function imax (x, y : integer) : integer;
begin
 if (x > y) then
  imax := x
 else
  imax := y
end;

END.
-h- imin.ut 228
{$debug-}
MODULE MIMIN;

{$include:'globcons.inc'}
{$include:'globtyps.inc'}

{ imin -- compute minimum of two integers }
function imin (x, y : integer) : integer;
begin
 if (x < y) then
  imin := x
 else
  imin := y
end;

END.
-h- index.ut 350
{$debug-}
MODULE MINDEX;

{$include:'globcons.inc'}
{$include:'globtyps.inc'}

{ index -- find position of character c in string s }
function index (var s : sstring; c : character) : integer;
var
 i : integer;
begin
 i := 1;
 while (s[i] <> c) and (s[i] <> ENDSTR) do
  i := i + 1;
 if (s[i] = ENDSTR) then
  index := 0
 else
  index := i
end;

END.
-h- isalphan.ut 284
{$debug-}
MODULE MISALPHANUM;

{$include:'globcons.inc'}
{$include:'globtyps.inc'}

{ isalphanum -- true if c is letter or digit }
function isalphanum (c : character) : boolean;
begin
 isalphanum := c in
  [ord('a')..ord('z'),
   ord('A')..ord('Z'),
   ord('0')..ord('9')]
end;

END.
-h- isdigit.ut 216
{$debug-}
MODULE MISDIGIT;

{$include:'globcons.inc'}
{$include:'globtyps.inc'}

{ isdigit -- true if c is a digit }
function isdigit (c : character) : boolean;
begin
 isdigit := c in [ord('0')..ord('9')]
end;

END.
-h- isletter.ut 261
{$debug-}
MODULE MISLETTER;

{$include:'globcons.inc'}
{$include:'globtyps.inc'}

{ isletter -- true if c is a letter of either case }
function isletter (c : character) : boolean;
begin
 isletter :=
  c in [ord('a')..ord('z')] + [ord('A')..ord('Z')]
end;

END.
-h- islower.ut 226
{$debug-}
MODULE MISLOWER;

{$include:'globcons.inc'}
{$include:'globtyps.inc'}

{ islower -- true if c is lower case letter }
function islower (c : character) : boolean;
begin
 islower := c in [ord('a')..ord('z')]
end;

END.
-h- isupper.ut 226
{$debug-}
MODULE MISUPPER;

{$include:'globcons.inc'}
{$include:'globtyps.inc'}

{ isupper -- true if c is upper case letter }
function isupper (c : character) : boolean;
begin
 isupper := c in [ord('A')..ord('Z')]
end;

END.
-h- itoc.ut 451
{$debug-}
MODULE MITOC;

{$include:'globcons.inc'}
{$include:'globtyps.inc'}

{ itoc - convert integer n to char string in s[i]... }
function itoc (n : integer; var s : sstring; i : integer)
  : integer; { returns end of s }
begin
 if (n < 0) then begin
  s[i] := ord('-');
  itoc := itoc(-n, s, i+1)
 end
 else begin
  if (n >= 10) then
   i := itoc(n div 10, s, i);
  s[i] := n mod 10 + ord('0');
  s[i+1] := ENDSTR;
  itoc := i + 1
 end
end;

END.
-h- length.ut 266
{$debug-}
MODULE MLENGTH;

{$include:'globcons.inc'}
{$include:'globtyps.inc'}

{ length -- compute length of string }
function length (var s : sstring) : integer;
var
 n : integer;
begin
 n := 1;
 while (s[n] <> ENDSTR) do
  n := n + 1;
 length := n - 1
end;

END.
-h- mustcrea.ut 438
{$debug-}
MODULE MMUSTCREATE;

{$include:'globcons.inc'}
{$include:'globtyps.inc'}
{$include:'create.dcl'}
{$include:'putstr.dcl'}
{$include:'error.dcl' }

{ mustcreate -- create file or die }
function mustcreate (var name : sstring; mode : integer)
  : filedesc;
var
 fd : filedesc;
begin
 fd := create(name, mode);
 if (fd = IOERROR) then begin
  putstr(name, STDERR);
  error(': cannot create file')
 end;
 mustcreate := fd
end;

END.
-h- mustopen.ut 424
{$debug-}
MODULE MMUSTOPEN;

{$include:'globcons.inc'}
{$include:'globtyps.inc'}
{$include:'open.dcl'  }
{$include:'putstr.dcl'}
{$include:'error.dcl' }

{ mustopen -- open file or die }
function mustopen (var name : sstring; mode : integer)
  : filedesc;
var
 fd : filedesc;
begin
 fd := open(name, mode);
 if (fd = IOERROR) then begin
  putstr(name, STDERR);
  error(': cannot open file')
 end;
 mustopen := fd
end;

END.
-h- putdec.ut 361
{$debug-}
MODULE MPUTDEC;

{$include:'globcons.inc'}
{$include:'globtyps.inc'}
{$include:'itoc.dcl'}
{$include:'putc.dcl'}

{ putdec -- put decimal integer n in field width >= w }
procedure putdec (n, w : integer);
var
 i, nd : integer;
 s : string;
begin
 nd := itoc(n, s, 1);
 for i := nd to w do
  putc(BLANK);
 for i := 1 to nd-1 do
  putc(s[i])
end;

END.
-h- scopy.ut 335
{$debug-}
MODULE MSCOPY;

{$include:'globcons.inc'}
{$include:'globtyps.inc'}

{ scopy -- copy string at src[i] to dest[j] }
procedure scopy (var src : sstring; i : integer;
  var dest : sstring; j : integer);
begin
 while (src[i] <> ENDSTR) do begin
  dest[j] := src[i];
  i := i + 1;
  j := j + 1
 end;
 dest[j] := ENDSTR
end;

END.