{}

procedure OpenStdout(var f: TextRec); forward;
procedure WriteStdout(var f: TextRec); forward;
procedure FlushStdout(var f: TextRec); forward;
procedure CloseStdout(var f: TextRec); forward;

procedure OpenStdin(var f: TextRec); forward;
procedure ReadStdin(var f: TextRec); forward;
procedure CloseStdin(var f: TextRec); forward;



procedure AssignStdout(var f: Text);
begin
  Assign(f, '');
  TextRec(f).OpenFunc := @OpenStdout;
  Rewrite(f);
end;

procedure OpenStdout(var f: TextRec);
begin
  TextRec(f).InOutFunc := @WriteStdout;
  TextRec(f).FlushFunc := @FlushStdout;
  TextRec(f).CloseFunc := @CloseStdout;
end;

procedure WriteStdout(var f: TextRec);
var
  msg: String;
begin
  msg := StrPas(PChar(f.bufptr));
  SetLength(msg, f.bufpos);
  f.bufpos := 0;
  Konsole.Write(msg);
end;

procedure FlushStdout(var f: TextRec);
begin
  WriteStdout(f);
  Konsole.Flush;
end;

procedure CloseStdout(var f: TextRec);
begin
end;



procedure AssignStdin(var f: Text);
begin
  Assign(f, '');
  TextRec(f).OpenFunc := @OpenStdin;
  Reset(f);
end;

procedure OpenStdin(var f: TextRec);
begin
  TextRec(f).InOutFunc := @ReadStdin;
  TextRec(f).FlushFunc := nil;
  TextRec(f).CloseFunc := @CloseStdin;
end;

procedure ReadStdin(var f: TextRec);
var
  max, curpos: Longint;
  c: Longint;
begin
  max := f.bufsize - Length(LineEnding);
  curpos := 0;
  repeat
    c := 13{l4_getc()};
    case c of
      13:
      begin
        {f.bufptr^[curpos] := LineEnding;}
        Inc(curpos);
        f.bufpos := 0;
        f.bufend := curpos;
        {l4_putc(Longint(LineEnding));}
        break;
      end;
      32..126: if curpos < max then
      begin
        f.bufptr^[curpos] := Char(c);
        Inc(curpos);
        {l4_putc(c);}
      end;
    end;
  until False;
end;

procedure CloseStdin(var f: TextRec);
begin
end;


{ TKonsole }

procedure KonsoleThreadMain(Console: PKonsole);
{Рабочий цикл консоли}
var
  ThreadInfo: TKosThreadInfo;
  Message: ShortString;
  Event: DWord;
begin
  kos_maskevents(ME_PAINT or ME_KEYBOARD or ME_IPC);
  kos_threadinfo(@ThreadInfo);
  Console^.FThreadSlot := kos_getthreadslot(ThreadInfo.ThreadID);

  kos_initipc(Console^.FIPCBuffer, Console^.FIPCBufferSize);

  {сразу отобразить и активировать окно}
  Console^.Paint();
  {$ifndef EMULATOR}
  kos_setactivewindow(Console^.FThreadSlot);
  {$endif}

  {готов к обработке событий}
  Console^.FOpened := True;
  while not Console^.FTerminate do
  begin
    Event := kos_getevent();
    Console^.FOnAir := True;
    if not Console^.FTerminate then
    case Event of
      SE_PAINT: Console^.Paint();
      SE_KEYBOARD: Console^.ProcessKeyboard(kos_getkey());
      SE_IPC: while Console^.ReceiveMessage(Message) do Console^.ProcessMessage(Message);
    end;
    Console^.FOnAir := False;
  end;
  Console^.FOpened := False;
end;

constructor TKonsole.Init(ACaption: String);
const
  IPC_SIZE = 4096;
var
  ThreadInfo: TKosThreadInfo;
begin
  if ACaption <> '' then
    FCaption := ACaption else
  begin
    kos_threadinfo(@ThreadInfo);
    FCaption := StrPas(ThreadInfo.AppName);
  end;
  SetLength(FLines, 1);
  FLines[0] := '';
  FCursor.X := 1;
  FCursor.Y := 0;
  FMaxLines := 150;
  FTerminate := False;
  FOpened := False;
  FOnAir  := False;
  FIPCBufferSize := SizeOf(TKosIPC) + IPC_SIZE;
  FIPCBuffer := GetMem(FIPCBufferSize);
  FIPCBuffer^.Lock := False;
  FIPCBuffer^.Size := 0;
  FThreadSlot := -1;
  FThreadID := BeginThread(TThreadFunc(@KonsoleThreadMain), @Self);
  if FThreadID <> 0 then
    {XXX: может зависнуть}
    while not FOpened do ThreadSwitch;
end;

destructor TKonsole.Done();
begin
  FTerminate := True;
  if FOpened then begin Self.Write(#0); kos_delay(01); end;
  if FOpened then begin Self.Write(#0); kos_delay(10); end;
  if FOpened then begin Self.Write(#0); kos_delay(20); end;
  if FOpened then
  begin
    FOpened := False;
    FOnAir  := False;
    KillThread(FThreadID);
  end;
  {FreeMem(FIPCBuffer);
  SetLength(FLines, 0);}
end;

function TKonsole.ReceiveMessage(var Message: ShortString): Boolean;
{Извлечь первое сообщение из буфера}
var
  PMsg: PKosMessage;
  Size: Longword;
begin
  FIPCBuffer^.Lock := True;

  if FIPCBuffer^.Size > 0 then
  begin
    PMsg := Pointer(Longword(FIPCBuffer) + SizeOf(TKosIPC));
    {TODO: проверка PMsg^.SenderID}
    {Size := PMsg^.Size;
    Dec(FIPCBuffer^.Size, Size + SizeOf(TKosMessage));
    if Size > 255 then Size := 255;
    SetLength(Message, Size);
    Move(Pointer(Longword(PMsg) + SizeOf(TKosMessage))^, Message[1], Size);
    if FIPCBuffer^.Size > 0 then
      Move(Pointer(Longword(PMsg) + SizeOf(TKosMessage) + PMsg^.Size)^, PMsg^, FIPCBuffer^.Size);}

    {XXX}
    Size := FIPCBuffer^.Size;
    Dec(FIPCBuffer^.Size, Size);
    if Size > 255 then Size := 255;
    SetLength(Message, Size);
    Move(PMsg^, Message[1], Size);

    Result := True;
  end else
  begin
    Message := '';
    Result := False;
  end;

  {FIXME: если FIPCBuffer^.Size = 0, то FIPCBuffer^.Lock все равно > 0}
  FIPCBuffer^.Lock := False;
end;

procedure TKonsole.ProcessMessage(Message: ShortString);
{ Вывести сообщение на консоль }
var
  OnlyBottomLine: Boolean = True;

  procedure PutChar(C: Char);
  var
    LinesCount: Longint;
    PLine: PShortString;
    I: Longint;
  begin
    { перевод коретки на позицию влево }
    if C = #8 then
    begin
      if FCursor.X > 1 then
        Dec(FCursor.X);
    end else

    { перевод коретки на следующую строку }
    if C = #10 then
    begin
      OnlyBottomLine := False;
      Inc(FCursor.Y);
      LinesCount := Length(FLines);
      while FCursor.Y >= FMaxLines do Dec(FCursor.Y, FMaxLines);
      if FCursor.Y < LinesCount then FLines[FCursor.Y] := '';
      while FCursor.Y >= LinesCount do
      begin
        SetLength(FLines, LinesCount + 1);
        FLines[LinesCount] := '';
        Inc(LinesCount);
      end;
    end else

    { перевод коретки в начало строки }
    if C = #13 then
      FCursor.X := 1 else

    { помещение символа в строку }
    begin
      if FCursor.X > 200 then
      begin
        PutChar(#13);
        PutChar(#10);
      end;

      { FIXME: Если в PascalMain только один Write/Ln, то зависон.
        см. FPC_DO_EXIT, InternalExit }
      PLine := @FLines[FCursor.Y];
      I := Length(PLine^);
      if FCursor.X > I then
      begin
        SetLength(PLine^, FCursor.X);
        Inc(I);
        while I < FCursor.X do
        begin
          PLine^[I] := ' ';
          Inc(I);
        end;
      end;
      FLines[FCursor.Y][FCursor.X] := C;

      Inc(FCursor.X);
    end;
  end;

var
  I: Longint;
begin
  for I := 1 to Length(Message) do
    PutChar(Message[I]);
  Paint(OnlyBottomLine);
end;

procedure TKonsole.ProcessKeyboard(Key: Word);
begin
  FKeyPressed := Key;
end;

function TKonsole.GetRect(): TKosRect;
var
  ThreadInfo: TKosThreadInfo;
begin
  kos_threadinfo(@ThreadInfo, FThreadSlot);
  Result := ThreadInfo.WindowRect;
end;

function TKonsole.GetKeyPressed(): Word;
begin
  Result := FKeyPressed;
  FKeyPressed := 0;
end;

procedure TKonsole.Paint(BottomRow: Boolean);
var
  Buffer: array[Byte] of Char;
  Rect: TKosRect;
  J: Longint;
  Width, Height, Row: Longint;
  CaptionHeight, BorderWidth, FontWidth, FontHeight: Longint;
begin
  CaptionHeight := 16;
  BorderWidth := 5;
  FontWidth := 6;
  FontHeight := 9;

  kos_begindraw();

  if not BottomRow then
  begin
    {отрисовка окна}
    kos_definewindow(60, 60, 400, 400, $63000000);
    {вывод заголовка}
    Move(FCaption[1], Buffer, Length(FCaption));
    Buffer[Length(FCaption)] := #0;
    kos_setcaption(Buffer);
  end;

  {подготовка к выводу строк}
  Rect := GetRect();
  Dec(Rect.Width, BorderWidth * 2);
  Dec(Rect.Height, CaptionHeight + BorderWidth * 2);
  Width  := Rect.Width div FontWidth;
  Height := Rect.Height - FontHeight;
  Row := FCursor.Y;

  while Height > 0 do
  begin
    {вывод одной строки}
    J := Length(FLines[Row]);
    if J > Width then J := Width;
    kos_drawtext(0, Height, Copy(FLines[Row], 1, J), $00DD00, $FF000000);
    {заливка оставшегося пространства в строке}
    J := J * FontWidth;
    kos_drawrect(J, Height, Rect.Width - J + 1, FontHeight, $000000);
    {подготовка к выводу следующей строки}
    Dec(Height, FontHeight);
    Dec(Row);
    if BottomRow or ((Row < 0) and (Length(FLines) < FMaxLines)) then Break;
    while Row < 0 do Inc(Row, FMaxLines);
  end;
  if FCursor.X <= Width then
    {отрисовка курсора}
    kos_drawrect((FCursor.X - 1) * FontWidth, Rect.Height - 2, FontWidth, 2, $FFFFFF);
  if not BottomRow then
    {заливка оставшейся части окна}
    kos_drawrect(0, 0, Rect.Width + 1, Height + FontHeight, $000000);

  kos_enddraw();
end;

procedure TKonsole.Write(Message: ShortString);
var
  I: Integer;
begin
  {XXX: возможна ситуация при которой сообщение не будет отправлено}
  if FOpened then
  begin
    I := 100;
    while (kos_sendmsg(FThreadID, @Message[1], Length(Message)) = 2) and (I > 0) do
    begin
      Dec(I);
      ThreadSwitch;
    end;
  end;
end;

procedure TKonsole.Flush();
begin
  while FOnAir do ThreadSwitch;
end;