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

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

Subversion Repositories Kolibri OS

(root)/programs/develop/fp/rtl/kos_stdio.inc – Rev 616