{} 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;