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

 {}
 procedure OpenStdout(var f: TextRec); forward;
+procedure WriteStdout(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;
 end;
 procedure OpenStdout(var f: TextRec);
 begin
   TextRec(f).InOutFunc := @WriteStdout;
-  TextRec(f).FlushFunc := @WriteStdout;
+  TextRec(f).FlushFunc := @FlushStdout;
   TextRec(f).CloseFunc := @CloseStdout;
 end;
   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
   {£®â®¢ ª ®¡à ¡®âª¥ á®¡ëâ¨©}
   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;
   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: ¬®¦¥â § ¢¨áãâì}
-    {®, â ª ¨ ¥áâì ¢ 2.2.0.}
     while not FOpened do ThreadSwitch;
 end;
 destructor TKonsole.Done();
   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);
+  {FreeMem(FIPCBuffer);
-  SetLength(FLines, 0);
+  SetLength(FLines, 0);}
 end;
 function TKonsole.ReceiveMessage(var Message: ShortString): Boolean;
 {§¢«¥çì ¯¥à¢®¥ á®®¡é¥¨¥ ¨§ ¡ãä¥à }
 var
   PMsg: PKosMessage;
   Size: Longword;
+begin
+  FIPCBuffer^.Lock := True;
 begin
   if FIPCBuffer^.Size > 0 then
-  begin
-    FIPCBuffer^.Lock := True;
+  begin
     PMsg := Pointer(Longword(FIPCBuffer) + SizeOf(TKosIPC));
     {TODO: ¯à®¢¥àª  PMsg^.SenderID}
     {Size := PMsg^.Size;
     Dec(FIPCBuffer^.Size, Size + SizeOf(TKosMessage));
 end;
 procedure TKonsole.ProcessMessage(Message: ShortString);
-{ë¢¥áâ¨ á®®¡é¥¨¥   ª®á®«ì}
+{ ë¢¥áâ¨ á®®¡é¥¨¥   ª®á®«ì }
-var
-  S: String;
-  LinesCount: Word;
-  CR, LF, W: Word;
+var
-  BottomRow: Boolean = True;
-begin
-  if Length(Message) < 1 then Exit;
-  repeat
+  OnlyBottomLine: Boolean = True;
-    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
+  procedure PutChar(C: Char);
-    begin
-      if W > 1 then
-      begin
-        S := Copy(Message, 1, W - 1);
-        Delete(FLines[FCursor.Y], FCursor.X, Length(FLines[FCursor.Y]) - FCursor.X);
+  var
-        Insert(S, FLines[FCursor.Y], FCursor.X);
+    LinesCount: Longint;
-        Inc(FCursor.X, Length(S));
-      end;
-      Delete(Message, 1, W);
-      if W = CR then
-        {¯¥à¥¢®¤ ª®à¥âª¨ ¢  ç «® áâà®ª¨}
-        FCursor.X := 1 else
+    PLine: PShortString;
+    I: Longint;
+  begin
+    { ¯¥à¥¢®¤ ª®à¥âª¨   ¯®§¨æ¨î ¢«¥¢® }
+    if C = #8 then
+    begin
+      if FCursor.X > 1 then
+        Dec(FCursor.X);
-      if W = LF then
+    end else
+    { ¯¥à¥¢®¤ ª®à¥âª¨   á«¥¤ãîéãî áâà®ªã }
-      begin
+    if C = #10 then
-        {¯¥à¥¢®¤ ª®à¥âª¨   á«¥¤ãîéãî áâà®ªã}
+    begin
-        BottomRow := False;
+      OnlyBottomLine := False;
-        Inc(FCursor.Y);
+      Inc(FCursor.Y);
-        LinesCount := Length(FLines);
+      LinesCount := Length(FLines);
-        while FCursor.Y >= FMaxLines do Dec(FCursor.Y, FMaxLines);
+      while FCursor.Y >= FMaxLines do Dec(FCursor.Y, FMaxLines);
-        if FCursor.Y < LinesCount then FLines[FCursor.Y] := '';
+      if FCursor.Y < LinesCount then FLines[FCursor.Y] := '';
-        while FCursor.Y >= LinesCount do
+      while FCursor.Y >= LinesCount do
-        begin
+      begin
-          SetLength(FLines, LinesCount + 1);
+        SetLength(FLines, LinesCount + 1);
-          FLines[LinesCount] := '';
+        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
-          Inc(LinesCount);
+          PLine^[I] := ' ';
-        end;
+          Inc(I);
-      end;
+        end;
+      end;
+      FLines[FCursor.Y][FCursor.X] := C;
+      Inc(FCursor.X);
+    end;
+  end;
+var
+  I: Longint;
-    end;
+begin
-  until Length(Message) <= 0;
+  for I := 1 to Length(Message) do
     PutChar(Message[I]);
-  Paint(BottomRow);
+  Paint(OnlyBottomLine);
 end;
       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 – Rev 643 → 666