WebSVN – Kolibri OS – /programs/develop/fp/rtl/kos_stdio.inc

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

Subversion Repositories Kolibri OS

(root)/programs/develop/fp/rtl/kos_stdio.inc @ 780 – Rev 666