uses Containers, GraphABC, Events;

const H = 1;

var
  a : StringArray;
  f : Text;
  s : string;
  i, x, y, xc, yc, cnt, xl, yl, nums, num, fst, last : integer;
  was, button, move, shift : boolean;

function min(a, b : integer) : integer;
begin
  if (a > b) then
    result := b
  else
    result := a;
end;

function max(a, b : integer) : integer;
begin
  if (a > b) then
    result := a
  else
    result := b;
end;

procedure Clear;
begin
  SetBrushColor(clWhite);
  FillRect(0, 0, WindowWidth, WindowHeight);
end;

procedure TOut(s : string; w, id : integer);
begin
  SetBrushColor(clWhite);
  SetFontColor(clBlack);
  TextOut(w, (TextHeight(s) + H) * (id - fst), s);
end;

procedure Blue;
var
  sbeg, send, idbeg, idend : integer;
  s1, s2 : string;
begin
  sbeg := xl;
  idbeg := yl;
  send := nums;
  idend := num;
  if (sbeg > send) then
  begin
    sbeg := nums;
    send := xl;
    idbeg := num;
    idend := yl;
  end;
  if ((sbeg = send) and (idbeg > idend)) then
  begin
    idbeg := num;
    idend := yl;
  end;

  SetBrushColor(clBlue);
  SetFontColor(clWhite);
  for i := sbeg to send do
  begin
    if (Length(a[i]) = 0) then
      TextOut(0, (textHeight(a[1]) + H) * (i - fst), ' ')
    else
     TextOut(0, (textHeight(a[1]) + H) * (i - fst), a[i]);
  end;
  s1 := ''; s2 := '';
  for i := 1 to idbeg - 1 do
    s1 := s1 + a[sbeg][i];
  for i := num + 1 to length(a[send]) do
    s2 := s2 + a[send][i];
  TOut(s1, 0, sbeg);
  Tout(s2, TextWidth(a[send]) - TextWidth(s2), send);

end;

procedure Cursor(s : string; w, id : integer);
begin
  SetFontColor(clWhite);
  SetBrushColor(clBlack);
  TextOut(w, (TextHeight(s) + H) * (id - fst), s);
end;

procedure CD;
var
  t, t1 : string;
begin
  if (nums < a.count) then
  begin
    TOut(' ', 0, nums);
    TOut(a[nums], 0, nums);

    inc(nums);
    if (shift) then
      Blue;
    if (length(a[nums]) < 1) then
    begin
      Cursor(' ', 0, nums);
      num := 1;
    end
    else
    begin
      if (num > length(a[nums])) then
        num := length(a[nums]);

      t1 := '';
      t1 := t1 + a[nums][num];

      t := '';
      for i := 1 to num - 1 do
        t := t + a[nums][i];
      Cursor(t1, TextWidth(t), nums);
    end;
  end;
end;

procedure CU;
var
  t, t1 : string;
begin
  if (nums > 1) then
  begin
    TOut(' ', 0, nums);
    TOut(a[nums], 0, nums);
    dec(nums);

    if (shift) then
      Blue;
    if (length(a[nums]) < 1) then
    begin
      Cursor(' ', 0, nums);
      num := 1;
    end
    else
    begin
      if (num > length(a[nums])) then
        num := length(a[nums]);

      t := ''; t1 := '';
      t1 := t1 + a[nums][num];
      for i := 1 to num - 1 do
        t := t + a[nums][i];
      Cursor(t1, TextWidth(t), nums);
     end;
  end;
end;

procedure CR;
var
  t, t1 : string;
begin
  if (length(a[nums]) - 1 >= num) then
  begin
    TOut(' ', 0, nums);
    TOut(a[nums], 0, nums);
    t := '';
    t1 := '';
    for i := 1 to num do
      t := t + a[nums][i];
    t1 := t1 + a[nums][num + 1];
    inc(num);
    if (shift) then
      Blue;

    Cursor(t1, TextWidth(t), nums);
  end
  else
    if (nums < a.count) then
    begin
      TOut(' ', 0, nums);
      TOut(a[nums], 0, nums);
      num := 1;
      CD;
    end;
end;

procedure CL;
var
  t, t1 : string;
begin
  if (num - 1 > 0) then
  begin
    TOut(' ', 0, nums);
    TOut(a[nums], 0, nums);
    t := '';
    t1 := '';
    for i := 1 to num - 1 do
      t := t + a[nums][i];
    t1 := t1 + a[nums][num - 1];

    dec(num);
    if (shift) then
      Blue;
    Cursor(t1, TextWidth(t) - TextWidth(t1), nums);
  end
  else
    if (nums > 1) then
    begin
      TOut(' ', 0, nums);
      TOut(a[nums], 0, nums);
      num := length(a[nums - 1]);
      CU;
    end;
end;

procedure KU(key :integer);
begin
  if (key = vk_Shift) then
    shift := false;
end;

procedure KD(key : integer);
begin
  if (not(shift)) then
  begin
    xl := nums;
    yl := num;
  end;

  if (key = vk_shift) then
    shift := true;

  if ((key = vk_Down) and (nums >= last ) and (nums < a.count)) then
  begin
    Clear;
    inc(fst); inc(last);
    for i := fst to a.count do
      TOut(a[i], 0, i);
  end;
  if ((key = vk_Up) and (nums > 1) and (nums <= fst)) then
  begin
    Clear;
    dec(fst); dec(last);
    for i := fst to a.count do
      TOut(a[i], 0, i);
  end;
  if ((key = vk_Right) and (num >= length(a[nums])) and (nums >= last) and (nums < a.count)) then
  begin
    Clear;
    inc(fst); inc(last);
    for i := fst to a.count do
      TOut(a[i], 0, i);
  end;
  if ((key = vk_Left) and (num <= 1) and (nums <= fst) and (nums > 1)) then
  begin
    Clear;
    dec(fst); dec(last);
    for i := fst to a.count do
      TOut(a[i], 0, i);
  end;

  if (key = vk_Right) then
    CR;
  if (key = vk_Left) then
    CL;
  if (key = vk_Down) then
    CD;
  if (key = vk_Up) then
    CU;


end;

begin
  cls;
  OnKeyDown := KD;
  OnKeyUp := KU;
  Assign(f, 'sample.txt');
  Reset(f);
  SetFontName('Tahoma');
  SetFontSize(14);
  nums := 1;
  fst := 1;

  a := StringArray.create;
  while (not eof(f)) do
  begin
    readln(f, s);
    a.add(s);
  end;
  for i := 1 to a.count do
    TOut(a[i], 0, i);

  y := 0;
  cnt := 0;
  while ((y < WindowHeight) and (cnt < a.count)) do
  begin
    y := y + TextHeight(a[1]) + 5;
    inc(last);
    inc(cnt);
  end;
  //dec(last);

  nums := 1;
  num := 1;
  s := '';
  s := s + a[1][1];
  Cursor(s, 0, 1);

  Close(f);
end.