
unit strl;
interface
uses crt;
function edstr(var instring;x,y,viewport,FORE,BACK,limit:byte):boolean;
implementation
const     ksins = 128; {insert mode on}
var       kbshift :    byte absolute $40:$17; {shift key status}
Function Getkey:word;
assembler; asm
 xor ah,ah
 int $16
end;
Procedure Beep(Hz,Ms:word);
begin
 sound(hz);
 delay(ms);
 nosound;
end;

function edstr(var instring;x,y,viewport,FORE,BACK,limit:byte):boolean;
var
 wmax,wmin:word;
 showpos,xmax,ymax,editpos,viewpos,oldx,oldy,oldcolor:byte;
 update,insmode:boolean;
 editstr:string absolute instring;
 key:record
  ch,scan:byte;
 end;
begin
  wmax:=windmax; {store window}
  wmin:=windmin; {store window}
  oldcolor:=textattr; {store color}
  oldx:=wherex; {store cursor}
  oldy:=wherey; {store cursor}
  window(1,1,80,25);
  window(1,1,80,50);
  xmax:=windmax and 255 + 1;
  ymax:=windmax shr 8 + 1;
  {verify viewport dimensions}
  if (y<=ymax) and (x+viewport-1<=xmax) and (viewport<>0) then begin
  edstr:=true;
  window(x,y,x+viewport-1,y); {set window}
  TEXTCOLOR(FORE);
  TEXTBACKGROUND(BACK);
  viewpos:=1; {init view pos}
  editpos:=1; {init edit pos}
  clrscr; {clear window}
  kbshift:=kbshift or ksins; {force insert}
  update:=true;
  if editstr[0]>char(limit) then editstr[0]:=char(limit);
  repeat {loop until Enter pressed}
   {update display}
   if update then begin
    gotoxy(1,1);
    inc(windmax); {prevents CRT scrolling}
    showpos:=viewpos;
    while (showpos<=length(editstr)) and (showpos<=viewpos+viewport-1) do
    begin
     write(editstr[showpos]);
     inc(showpos);
    end;
    dec(windmax); {restore window after temporary anti-scroll}
    clreol;
   end;
   update:=true;
   gotoxy((editpos-1) mod viewport+1,1); {proper cursor edit pos}
   word(key):=getkey; {get key}
   insmode:=kbshift and ksins<>0; {check insert mode}
   {if insert then flat cursor else block cursor}
   case key.ch of {check key char}
    0:case key.scan of {check key scan code}
     $47:editpos:=1; {home}
     $4B:if editpos<>1 then dec(editpos); {left}
     $4D:if (editpos<>limit) and (editpos<>length(editstr)+1) then
         inc(editpos); {right}
     $4F:if length(editstr)=limit then editpos:=limit
         else editpos:=length(editstr)+1; {end}
     $53:delete(editstr,editpos,1); {del}
     $77:{^Home, del till start of line}
         begin
          delete(editstr,1,editpos-1);
          editpos:=1;
         end;
     $75:delete(editstr,editpos,255); {^End, del till end of line}
     $73:{^Left, seek word left}
         if editpos=1 then update:=false
         else repeat
          dec(editpos);
         until (editpos=1) or (editstr[editpos-1]=' ');
     $74:{^Right, seek word right}
         if (editpos=limit) or (editpos=length(editstr)+1) then
          update:=false
         else repeat
          inc(editpos);
         until (editstr[editpos-1]=' ') or (editpos=limit)
          or (editpos=length(editstr)+1);
     else update:=false; {do not waste time updating screen}
    end; {check key scan code}
    8:if editpos>1 then begin {backspace}
     dec(editpos);
     delete(editstr,editpos,1);
    end
    else update:=false;
    32..255:begin {valid chars}
     if insmode or (length(editstr)+1=editpos) then
      {inserted if using insert mode OR if overstrike AND at string end}
      if (length(editstr)<>limit) then insert(char(key.ch),editstr,editpos)
      else beep(5000,10) {error: string full}
     else editstr[editpos]:=char(key.ch); {overstrike char}
     if editpos<>limit then inc(editpos); {inc pos within limit}
    end; {valid chars}
    else update:=false; {do not waste time updating screen}
   end; {check key char}

   {update scroll window}
   while editpos<viewpos do dec(viewpos,viewport); {left}
   while editpos>=viewpos+viewport do inc(viewpos,viewport); {right}
  until key.ch=13; {enter ends loop/input}
  textattr:=oldcolor; {minimal screen clean up}
  clrscr;
 end {valid viewport}
 else edstr:=false; {invalid viewport}
 windmin:=wmin; {restore window}
 windmax:=wmax; {restore window}
 textattr:=oldcolor; {restore color}
 gotoxy(oldx,oldy); {restore cursor}
end; {edstr}

VAR
     aStr : STRING;

BEGIN
END.

