home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Jason Aller Floppy Collection
/
270.img
/
FORUM25C.ZIP
/
IOSTRING.SUB
< prev
next >
Wrap
Text File
|
1988-12-27
|
5KB
|
236 lines
Procedure getstr;
VAR marker,cnt:integer;
p:byte absolute input;
k:char;
oldinput:anystr;
done,wrapped:boolean;
wordtowrap:lstr;
Procedure bkspace;
Procedure bkwrite (q:sstr);
begin
write (q);
if splitmode and dots then write (usr,q)
end;
begin
if p<>0
then
begin
if input[p]=^Q
then bkwrite (' ')
else bkwrite (k+' '+k);
p:=p-1
end
else if wordwrap
then
begin
input:=k;
done:=true
end
end;
Procedure sendit (k:char; n:integer);
VAR temp:anystr;
begin
temp[0]:=chr(n);
fillchar (temp[1],n,k);
nobreak:=true;
write (temp)
end;
Procedure superbackspace (r1:integer);
VAR cnt,n:integer;
begin
n:=0;
for cnt:=r1 to p do
if input[cnt]=^Q
then n:=n-1
else n:=n+1;
if n<0 then sendit (' ',-n) else begin
sendit (^H,n);
sendit (' ',n);
sendit (^H,n)
end;
p:=r1-1
end;
Procedure cancelent;
begin
superbackspace (1)
end;
Function findspace:integer;
VAR s:integer;
begin
s:=p;
while (input[s]<>' ') and (s>0) do s:=s-1;
findspace:=s
end;
Procedure wrapaword (q:char);
VAR s:integer;
begin
done:=true;
if q=' ' then exit;
s:=findspace;
if s=0 then exit;
wrapped:=true;
wordtowrap:=copy(input,s+1,255)+q;
superbackspace (s)
end;
Procedure deleteword;
VAR s,n:integer;
begin
if p=0 then exit;
s:=findspace;
if s<>0 then s:=s-1;
n:=p-s;
p:=s;
sendit (^H,n);
sendit (' ',n);
sendit (^H,n)
end;
Procedure addchar (k:char);
begin
if p<buflen
then if (k<>' ') or (p>0) or wordwrap or beginwithspacesok
then
begin
p:=p+1;
input[p]:=k;
if dots
then
begin
writechar (dotchar);
if splitmode then write (usr,k)
end
else writechar (k)
end
else
else if wordwrap then wrapaword (k)
end;
Procedure repeatent;
VAR cnt:integer;
begin
for cnt:=1 to length(oldinput) do addchar (oldinput[cnt])
end;
Procedure tab;
VAR n,c:integer;
begin
n:=(p+8) and 248;
if n>buflen then n:=buflen;
for c:=1 to n-p do addchar (' ')
end;
Procedure getinput;
begin
oldinput:=input;
ingetstr:=true;
done:=false;
bottomline;
if splitmode and dots then top;
p:=0;
repeat
clearbreak;
nobreak:=true;
k:=getinputchar;
if hungupon then begin
input:='';
k:=#13;
done:=true
end;
case k of
^I:tab;
^H:bkspace;
^M:done:=true;
^R:repeatent;
^X,#27:cancelent;
^W:deleteword;
' '..'~':addchar (k);
^Q:if wordwrap and bkspinmsgs then addchar (k)
end;
{ if requestchat then begin
p:=0;
writeln (^B^N^M^M^B);
chat (requestcom);
requestchat:=false
end }
until done;
writeln;
if splitmode and dots then begin
writeln (usr);
bottom
end;
ingetstr:=false;
ansireset
end;
Procedure divideinput;
VAR p:integer;
begin
p:=pos(',',input);
if p=0 then exit;
addtochain (copy(input,p+1,255)+#13);
input[0]:=chr(p-1)
end;
begin
che;
clearbreak;
linecount:=1;
wrapped:=false;
nochain:=nochain or wordwrap;
ansicolor (urec.inputcolor);
getinput;
if not nochain then divideinput;
while input[length(input)]=' ' do input[0]:=pred(input[0]);
if not wordwrap then
while (length(input)>0) and (input[1]=' ') do delete (input,1,1);
if wrapped then chainstr:=wordtowrap;
wordwrap:=false;
nochain:=false;
beginwithspacesok:=false;
dots:=false;
buflen:=80;
linecount:=1
end;
Procedure writestr (s:anystr);
VAR k:char;
ex:boolean;
begin
che;
clearbreak;
ansireset;
uselinefeeds:=linefeeds in urec.config;
usecapsonly:=not (lowercase in urec.config);
k:=s[length(s)];
s:=copy(s,1,length(s)-1);
case k of
':':begin
write (^P,s,': ');
lastprompt:=s+': ';
getstr
end;
';':write (s);
'*':begin
write (^P,s);
lastprompt:=s;
getstr
end;
'&':begin
nochain:=true;
write (^P,s);
lastprompt:=s;
getstr
end
else writeln (s,k)
end;
clearbreak
end;