Subversion Repositories Kolibri OS

{}

procedure OpenStdout(var f: TextRec); forward;

procedure WriteStdout(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 := @WriteStdout;

  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 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();

    if Console^.FTerminate then

      {Console^.ProcessMessage('[CONSOLE] Terminate...'#13#10)} else

    case Event of

      SE_PAINT: Console^.Paint();

      SE_KEYBOARD: Console^.ProcessKeyboard(kos_getkey());

      SE_IPC: while Console^.ReceiveMessage(Message) do Console^.ProcessMessage(Message);

    end;

  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;

  FIPCBufferSize := SizeOf(TKosIPC) + IPC_SIZE;

  FIPCBuffer := GetMem(FIPCBufferSize);

  {FIPCBufferSize := SizeOf(KonsoleIPCBuffer);

  FIPCBuffer := @KonsoleIPCBuffer;}

  FIPCBuffer^.Lock := False;

  FIPCBuffer^.Size := 0;

  FThreadSlot := -1;

  FThreadID := BeginThread(TThreadFunc(@KonsoleThreadMain), @Self);

  if FThreadID <> 0 then

    while not FOpened do kos_delay(1);

end;

destructor TKonsole.Done();

begin

  FTerminate := True;

  Self.Write(#0);

  if FOpened then kos_delay(1);

  if FOpened then kos_delay(10);

  if FOpened then kos_delay(20);

  if FOpened then

  begin

    FOpened := False;

    KillThread(FThreadID);

  end;

  FreeMem(FIPCBuffer);

  SetLength(FLines, 0);

end;

function TKonsole.ReceiveMessage(var Message: ShortString): Boolean;

{������� ��ࢮ� ᮮ�饭�� �� ����}

var

  PMsg: PKosMessage;

  Size: Longword;

begin

  if FIPCBuffer^.Size > 0 then

  begin

    FIPCBuffer^.Lock := True;

    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

  S: String;

  LinesCount: Word;

  CR, LF, W: Word;

  BottomRow: Boolean = True;

begin

  if Length(Message) < 1 then Exit;

  repeat

    CR := Pos(#13, Message);

    LF := Pos(#10, Message);

    if (CR > 0) and ((CR < LF) or (LF <= 0)) then

      W := CR else

    if LF > 0 then

      W := LF else

      W := Length(Message) + 1;

    if W > 0 then

    begin

      if W > 1 then

      begin

        S := Copy(Message, 1, W - 1);

        Delete(FLines[FCursor.Y], FCursor.X, Length(FLines[FCursor.Y]) - FCursor.X);

        Insert(S, FLines[FCursor.Y], FCursor.X);

        Inc(FCursor.X, Length(S));

      end;

      Delete(Message, 1, W);

      if W = CR then

        {��ॢ�� ���⪨ � ��砫� ��ப�}

        FCursor.X := 1 else

      if W = LF then

      begin

        {��ॢ�� ���⪨ �� ᫥������ ��ப�}

        BottomRow := 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;

    end;

  until Length(Message) <= 0;

  Paint(BottomRow);

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 := 20;

    while (kos_sendmsg(FThreadID, @Message[1], Length(Message)) = 2) and (I > 0) do

    begin

      Dec(I);

      ThreadSwitch;

    end;

  end;

end;