home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols200 / vol270 / sed3.inc < prev    next >
Text File  |  1986-05-22  |  2KB  |  70 lines
  1. procedure dispinsert;
  2. begin
  3.   gotoxy(70,1);
  4.   if insert then write('insert   ') else write('overwrite')
  5. end;
  6.  
  7. procedure readline(prompt:linetype; var line:linetype);
  8. begin
  9.   sline(0); gotoxy(1,1);
  10.   write(prompt,' ? '); readln(line); sline(0)
  11. end;
  12.  
  13. procedure putmem(var i:byte; var k:integer; c:char);
  14. begin
  15.   if (pbotm-k)>255 then
  16.     begin
  17.       if (c=newline) or (i>=width) then
  18.         begin mem[k]:=$D; mem[k+1]:=$A; k:=k+2; i:=0 end;
  19.       if (c>=#$20) then
  20.         begin mem[k]:=ord(c); k:=k+1; i:=i+1 end
  21.     end
  22.   else begin mem[k-2]:=$D; mem[k-1]:=$A end
  23. end;
  24.  
  25. procedure settext;
  26. var c:char; j:byte; i:integer; infil:text;
  27. begin
  28.   startaddress:=addr(textbuf[0]);
  29.   endaddress:=addr(textbuf[maxtext]);
  30.   textbuf[0]:=#0; textbuf[maxtext]:=#$1A;
  31.   i:=startaddress+1; j:=0; pbotm:=endaddress;
  32.   write('file name ? '); readln(filename);
  33.   assign(infil,filename); {$I-} reset(infil); {$I+}
  34.   if ioresult<>0 then
  35.     begin  writeln('*** new file ***'); delay(500) end
  36.   else
  37.     while not eof(infil) do begin read(infil,c); putmem(j,i,c) end;
  38.   close(infil); putmem(j,i,newline); ptop:=i-1;
  39.   poptop; texttop; clrscr; x:=1; y:=1; insert:=true
  40. end;
  41.  
  42. procedure outtext;
  43. var c:char; i:integer; infil:text;
  44. begin
  45.   repeat
  46.     sline(0); gotoxy(1,1);
  47.     write('> Save Write Return New Quit ? '); read(trm,c);
  48.     if c in ['Q','q'] then begin clrscr; halt end;
  49.     if c in ['W','w']  then readline('file name',filename);
  50.     if (c in ['S','s','W','w']) and (filename<>'') then
  51.       begin
  52.         texttop; textbottom; pushtop; mem[ptop+1]:=$1A;
  53.         assign(infil,filename); rewrite(infil); i:=1;
  54.         while textbuf[i]<>#$1A do
  55.           begin write(infil,textbuf[i]); i:=i+1 end;
  56.         close(infil); poptop; x:=numbuf
  57.       end;
  58.   until c in ['N','n','R','r'];
  59.   sline(0);
  60.   if c in ['N','n'] then begin gotoxy(1,1); settext end
  61. end;
  62.  
  63. procedure checkbuf;
  64. begin
  65.   if (pbotm-ptop)<255 then
  66.     begin
  67.       gotoxy(1,1); write('Text buffer full !'); delay(1000); outtext;
  68.     end;
  69. end;
  70.