392 lines
8.8 KiB
PHP
392 lines
8.8 KiB
PHP
{}
|
||
|
||
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);
|
||
{<EFBFBD> ¡®ç¨© 横« ª®á®«¨}
|
||
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;
|