program scroll;

{$U+}

type
       zeile  = string[80];
       buffer = string[255];

var
       ch  : char;
       buf : zeile;


function min(a,b : integer) : integer;

begin
       if a < b then
          min := a
       else
          min := b;
end;


procedure CURON;

begin
       write(^[,'.3');
end;


procedure CUROFF;

begin
       write(^[,'.0');
end;


procedure SPACES(n : integer);

begin
       while (n > 0) do begin
          write(' ');
          n := n - 1;
       end;
end;


{ the input fuction getstr is written for TURBO-Pascal and allows
  the user to define a window (maximal one line) in which text can
  be edited WORDSTAR like }

type
       menge  = set of char;


function getstr(VAR buffer; x,y,wl,len : integer; bereich : menge;
                exact : boolean; endset : menge) : char;

{ - buffer is the string, which is edited
  - x,y are the coordinates, where the window starts
  - len is the maximal length of the window
  - bereich is the amount of characters, which are allowed for input
  - if the exact flag is set the user must enter exactly len characters }

const
       BS       = ^H;     { cursor left/delete }
       DEL      = #127;   { cursor left/delete }
       FIELDL   = ^A;     { cursor to the beginning of the left word }
       FIELDR   = ^F;     { cursor to the beginning of the right word }
       CHARD    = ^G;     { delete character }
       WORDD    = ^T;     { delete word }
       LINED    = ^Y;     { delete line }
       CULEFT   = ^S;     { cursor left }
       CURIGHT  = ^D;     { cursor right }
       CTRL_L   = ^L;     { ctrl - L }
       CTRL_Q   = ^Q;     { ctrl - Q }
       CTRL_V   = ^V;     { ctrl - V }
       CTRL_Y   = ^Y;     { ctrl - Y }

var
       exit      : boolean;
       insert_on : boolean;
       i,j,max,anf,cur   : integer;
       c,signleft,signright : char;
       default   : zeile;
       bptr      : zeile absolute buffer;


procedure underscore(anzahl : integer);

begin
       while (anzahl > 0) do begin
          write('_');
          anzahl := anzahl - 1;
       end;
end;


procedure delete_to_eoln;

{ deletes from the cursor position to the end of line }

begin
       gotoxy(x+cur-1,y);
       underscore(wl-cur+1);
       gotoxy(x+cur-1,y);
end;


procedure inccur;

begin
       if i < len then begin
          i := i + 1;
          if cur < wl then
             cur := cur + 1
          else
             anf := anf + 1;
          if (i > wl) AND (i > max) then
             underscore(1);
       end;
       if i = max then
          write(^G);
end;


procedure deccur;

begin
       if i > 1 then begin
          i := i - 1;
          if cur > 1 then
             cur := cur - 1
          else
             anf := anf - 1;
        end;
end;


procedure show;

begin
       CUROFF;
       if anf > 1 then
          signleft := '<'
       else
          signleft := ' ';
       if anf + wl - 1 < max then
          signright := '>'
       else
          signright := ' ';
       gotoxy(x-1,y+1); write(signleft);
       gotoxy(x+wl,y+1); write(signright);
       gotoxy(x,y); write(copy(bptr,anf,wl)); gotoxy(x+cur-1,y);
       CURON;
end;


procedure char_delete(anzahl : integer);

{ deletes the character at the actual cursor position
  and shifts the following characters to the left      }

var
       j,k : integer;

begin
       if i <= max then begin
          delete(bptr,i,anzahl);
          max := max - anzahl;
          show;
          k := i;
          for j := cur to wl do
              if k <= max then begin
                 write(bptr[k]);
                 k := k + 1;
              end
              else
                 write('_');
          gotoxy(x+cur-1,y);
       end;
end;


procedure init;

{ initialize start configuration }

begin
       insert_on := false;
       bptr      := default;
       i := 1;
       anf := 1;
       cur := 1;
       gotoxy(x,y); write(default);
       delete_to_eoln;
       gotoxy(x,y);
end;


begin
       exit    := false;
       default := bptr;
       init;
       while not exit do begin
         read(kbd,c);
          max := length(bptr);
          if c in bereich then begin
             if (max < len) OR ((not insert_on) AND (i <= len)) then begin
                if (not insert_on) AND (i <= max) then
                   bptr[i] := c
                else
                   insert(c,bptr,i);
             inccur; show;
             end
             else
                write(#7);
          end
          else case c of
             CULEFT  : begin
                          deccur; show;
                       end;
             CURIGHT : begin
                          if i <= max then begin
                             inccur; show;
                          end;
                       end;
             FIELDL  : begin
                          repeat
                             deccur;
                          until (i=1) or ((bptr[i]<>' ') AND (bptr[i-1]=' '));
                          show;
                       end;
             FIELDR  : begin
                          repeat
                             if i <= max then inccur;
                          until (i>=max) or ((bptr[i]<>' ') AND (bptr[i-1]=' '));
                          show;
                       end;
             BS,DEL  : begin
                          deccur;
                          char_delete(1);
                       end;
             CHARD   : char_delete(1);
             WORDD   : begin
                          j := i;
                          repeat
                             if j <= max then j := j + 1;
                          until (j>max) or ((bptr[j]<>' ') AND (bptr[j-1]=' '));
                          char_delete(j-i);
                       end;
             LINED   : begin
                          i   := 1;
                          cur := 1;
                          anf := 1;
                          bptr := '';
                          delete_to_eoln;
                       end;
             CTRL_Q  : begin
                          read(kbd,c);
                          case c of
                             CTRL_Y  : char_delete(max-i+1);
                             { deletes from cursor to end of line }

                             CTRL_L  : init;
                             { removes all changes and restarts the input }

                          else
                                       write(#7);
                          end;
                       end;
             CTRL_V  : insert_on := not insert_on;
             else
                       if c in endset then
                          exit := ((exact = false) OR
                                   ((exact = true) AND (len = max-1)))
                       else
                          write(#7);
          end;
       end;
       gotoxy(x+max,y);
       spaces(wl-max);
       getstr  := c;
end;

begin
       clrscr;
       buf := '';
       write('   |','':20,'|');
       ch := getstr(buf,5,1,20,30,[' '..'~'],false,[^M,^I]);
       writeln; writeln; writeln(':',buf,':');
end.