(*	Permission is hereby granted to republish,
 *	but not for profit, any or all of this program,
 *	provided that this copyright notice is included.
 *
 *	Copyright 1979, Oregon Minicomputer Software, Inc.
 *			2340 SW Canyon Road
 *			Portland, Oregon 97201
 *			(503) 226-7760
 *)

const	stringmax=100;
type	string=record
	   len: 0..stringmax;
	   ch: packed array[1..stringmax] of char
	   end;

function len(VAR s:string):integer;
begin	len:= s.len
end;

procedure clear(var s:string);
var	i: integer;
begin	s.len:=0;
	for i:=1 to stringmax do s.ch[i]:=' '
end;

procedure concatenate(var s:string; VAR t:string);
var	i,j: integer;
begin
	if s.len+t.len>stringmax
	   then j:=stringmax-s.len { overflow }
	   else j:=t.len;
	for i:=1 to j do s.ch[s.len+i]:=t.ch[i];
	s.len:=s.len+j;
end;

function search(VAR s,t:string; start:integer):integer;
var	i,j: 0..stringmax;
	uneq: boolean;
begin
	if start<1 then start:=1;
	if (start+t.len>s.len+1) or (t.len=0)
	   then search:=0
	   else begin
	      i:=start-1;
	      repeat
		 i:=i+1; j:=0;
		 repeat
		    j:=j+1;
		    uneq:=t.ch[j]<>s.ch[i+j-1];
		 until uneq or (j=t.len);
	      until (not uneq) or (i=s.len-t.len+1);
	      if uneq
		 then search:=0
		 else search:=i;
	      end;
end;

procedure readstring(var f:text; var s:string);
begin
	clear(s);
	with s do
	   while (not eoln(f)) and (len<stringmax) do begin
	      len:=len+1;
	      read(f,ch[len]);
	      end;
	readln(f);
end;

procedure writestring(var f:text; VAR s:string);
begin	write(f,s.ch:s.len)
end;

procedure substring(var t:string; VAR s:string; start,span:integer);
var	i: integer;
begin
	if span<0 then begin span:= -span; start:=start-span end;
	if start<1 then begin span:=span+start-1; start:=1 end;
	if start+span>s.len+1 then span:=s.len-start+1;
	if span<=0
	   then clear(t)
	   else begin
	      for i:=1 to span do t.ch[i]:=s.ch[start+i-1];
	      for i:=span+1 to stringmax do t.ch[i]:=' ';
	      t.len:=span;
	      end;
end;

procedure delete(var s:string; start,span:integer);
var	i,limit: integer;
begin
	if span<0 then begin span:=-span; start:=start-span end;
	limit:=start+span;
	if start<1 then start:=1;
	if limit>s.len+1 then limit:=s.len+1;
	span:=limit-start;
	if span>0 then begin
	   for i:=0 to s.len-limit do s.ch[start+i]:=s.ch[limit+i];
	   for i:=s.len-span+1 to s.len do s.ch[i]:=' ';
	   s.len:=s.len-span;
	   end;
end;

procedure insert(var s:string;VAR t:string; p:integer);
var	i,j: integer;
begin
	if t.len>0 then
	   if (p>0) and (p<=s.len+1)
	      then begin
		 if s.len+t.len<=stringmax
		    then s.len:=s.len+t.len
		    else s.len:=stringmax { overflow } ;
		 for i:=s.len downto p+t.len do s.ch[i]:=s.ch[i-t.len];
		 if s.len<p+t.len
		    then j:=s.len
		    else j:=p+t.len-1;
		 for i:=p to j do s.ch[i]:=t.ch[i-p+1];
		 end
	      else { error: non-contiguous string }
end;
                                                                                               