Subversion Repositories Kolibri OS

Rev

Rev 619 | Go to most recent revision | Blame | Compare with Previous | Last modification | View Log | Download | RSS feed

  1. {}
  2.  
  3. procedure OpenStdout(var f: TextRec); forward;
  4. procedure WriteStdout(var f: TextRec); forward;
  5. procedure CloseStdout(var f: TextRec); forward;
  6.  
  7. procedure OpenStdin(var f: TextRec); forward;
  8. procedure ReadStdin(var f: TextRec); forward;
  9. procedure CloseStdin(var f: TextRec); forward;
  10.  
  11.  
  12.  
  13. procedure AssignStdout(var f: Text);
  14. begin
  15.   Assign(f, '');
  16.   TextRec(f).OpenFunc := @OpenStdout;
  17.   Rewrite(f);
  18. end;
  19.  
  20. procedure OpenStdout(var f: TextRec);
  21. begin
  22.   TextRec(f).InOutFunc := @WriteStdout;
  23.   TextRec(f).FlushFunc := @WriteStdout;
  24.   TextRec(f).CloseFunc := @CloseStdout;
  25. end;
  26.  
  27. procedure WriteStdout(var f: TextRec);
  28. var
  29.   msg: String;
  30. begin
  31.   msg := StrPas(PChar(f.bufptr));
  32.   SetLength(msg, f.bufpos);
  33.   f.bufpos := 0;
  34.   Konsole.Write(msg);
  35. end;
  36.  
  37. procedure CloseStdout(var f: TextRec);
  38. begin
  39. end;
  40.  
  41.  
  42.  
  43. procedure AssignStdin(var f: Text);
  44. begin
  45.   Assign(f, '');
  46.   TextRec(f).OpenFunc := @OpenStdin;
  47.   Reset(f);
  48. end;
  49.  
  50. procedure OpenStdin(var f: TextRec);
  51. begin
  52.   TextRec(f).InOutFunc := @ReadStdin;
  53.   TextRec(f).FlushFunc := nil;
  54.   TextRec(f).CloseFunc := @CloseStdin;
  55. end;
  56.  
  57. procedure ReadStdin(var f: TextRec);
  58. var
  59.   max, curpos: Longint;
  60.   c: Longint;
  61. begin
  62.   max := f.bufsize - Length(LineEnding);
  63.   curpos := 0;
  64.   repeat
  65.     c := 13{l4_getc()};
  66.     case c of
  67.       13:
  68.       begin
  69.         {f.bufptr^[curpos] := LineEnding;}
  70.         Inc(curpos);
  71.         f.bufpos := 0;
  72.         f.bufend := curpos;
  73.         {l4_putc(Longint(LineEnding));}
  74.         break;
  75.       end;
  76.       32..126: if curpos < max then
  77.       begin
  78.         f.bufptr^[curpos] := Char(c);
  79.         Inc(curpos);
  80.         {l4_putc(c);}
  81.       end;
  82.     end;
  83.   until False;
  84. end;
  85.  
  86. procedure CloseStdin(var f: TextRec);
  87. begin
  88. end;
  89.  
  90.  
  91. { TKonsole }
  92.  
  93. procedure KonsoleThreadMain(Console: PKonsole);
  94. { ¡®ç¨© 横« ª®­á®«¨}
  95. var
  96.   ThreadInfo: TKosThreadInfo;
  97.   Message: ShortString;
  98.   Event: DWord;
  99. begin
  100.   kos_maskevents(ME_PAINT or ME_KEYBOARD or ME_IPC);
  101.   kos_threadinfo(@ThreadInfo);
  102.   Console^.FThreadSlot := kos_getthreadslot(ThreadInfo.ThreadID);
  103.  
  104.   kos_initipc(Console^.FIPCBuffer, Console^.FIPCBufferSize);
  105.  
  106.   {áࠧ㠮⮡ࠧ¨âì ¨  ªâ¨¢¨à®¢ âì ®ª­®}
  107.   Console^.Paint();
  108.   {$ifndef EMULATOR}
  109.   kos_setactivewindow(Console^.FThreadSlot);
  110.   {$endif}
  111.  
  112.   {£®â®¢ ª ®¡à ¡®âª¥ ᮡë⨩}
  113.   Console^.FOpened := True;
  114.   while not Console^.FTerminate do
  115.   begin
  116.     Event := kos_getevent();
  117.     if not Console^.FTerminate then
  118.     case Event of
  119.       SE_PAINT: Console^.Paint();
  120.       SE_KEYBOARD: Console^.ProcessKeyboard(kos_getkey());
  121.       SE_IPC: while Console^.ReceiveMessage(Message) do Console^.ProcessMessage(Message);
  122.     end;
  123.   end;
  124.   Console^.FOpened := False;
  125. end;
  126.  
  127. constructor TKonsole.Init(ACaption: String);
  128. const
  129.   IPC_SIZE = 4096;
  130. var
  131.   ThreadInfo: TKosThreadInfo;
  132. begin
  133.   if ACaption <> '' then
  134.     FCaption := ACaption else
  135.   begin
  136.     kos_threadinfo(@ThreadInfo);
  137.     FCaption := StrPas(ThreadInfo.AppName);
  138.   end;
  139.   SetLength(FLines, 1);
  140.   FLines[0] := ' ';
  141.   FCursor.X := 1;
  142.   FCursor.Y := 0;
  143.   FMaxLines := 150;
  144.   FTerminate := False;
  145.   FOpened := False;
  146.   FIPCBufferSize := SizeOf(TKosIPC) + IPC_SIZE;
  147.   FIPCBuffer := GetMem(FIPCBufferSize);
  148.   FIPCBuffer^.Lock := False;
  149.   FIPCBuffer^.Size := 0;
  150.   FThreadSlot := -1;
  151.   FThreadID := BeginThread(TThreadFunc(@KonsoleThreadMain), @Self);
  152.   if FThreadID <> 0 then
  153.     {XXX: ¬®¦¥â § ¢¨á­ãâì}
  154.     {‚®, â ª ¨ ¥áâì ¢ 2.2.0.}
  155.     while not FOpened do ThreadSwitch;
  156. end;
  157.  
  158. destructor TKonsole.Done();
  159. begin
  160.   FTerminate := True;
  161.   if FOpened then begin Self.Write(#0); kos_delay(01); end;
  162.   if FOpened then begin Self.Write(#0); kos_delay(10); end;
  163.   if FOpened then begin Self.Write(#0); kos_delay(20); end;
  164.   if FOpened then
  165.   begin
  166.     FOpened := False;
  167.     KillThread(FThreadID);
  168.   end;
  169.   FreeMem(FIPCBuffer);
  170.   SetLength(FLines, 0);
  171. end;
  172.  
  173. function TKonsole.ReceiveMessage(var Message: ShortString): Boolean;
  174. {ˆ§¢«¥çì ¯¥à¢®¥ á®®¡é¥­¨¥ ¨§ ¡ãä¥à }
  175. var
  176.   PMsg: PKosMessage;
  177.   Size: Longword;
  178. begin
  179.   if FIPCBuffer^.Size > 0 then
  180.   begin
  181.     FIPCBuffer^.Lock := True;
  182.     PMsg := Pointer(Longword(FIPCBuffer) + SizeOf(TKosIPC));
  183.     {TODO: ¯à®¢¥àª  PMsg^.SenderID}
  184.     {Size := PMsg^.Size;
  185.     Dec(FIPCBuffer^.Size, Size + SizeOf(TKosMessage));
  186.     if Size > 255 then Size := 255;
  187.     SetLength(Message, Size);
  188.     Move(Pointer(Longword(PMsg) + SizeOf(TKosMessage))^, Message[1], Size);
  189.     if FIPCBuffer^.Size > 0 then
  190.       Move(Pointer(Longword(PMsg) + SizeOf(TKosMessage) + PMsg^.Size)^, PMsg^, FIPCBuffer^.Size);}
  191.  
  192.     {XXX}
  193.     Size := FIPCBuffer^.Size;
  194.     Dec(FIPCBuffer^.Size, Size);
  195.     if Size > 255 then Size := 255;
  196.     SetLength(Message, Size);
  197.     Move(PMsg^, Message[1], Size);
  198.  
  199.     Result := True;
  200.   end else
  201.   begin
  202.     Message := '';
  203.     Result := False;
  204.   end;
  205.  
  206.   {FIXME: ¥á«¨ FIPCBuffer^.Size = 0, â® FIPCBuffer^.Lock ¢á¥ à ¢­® > 0}
  207.   FIPCBuffer^.Lock := False;
  208. end;
  209.  
  210. procedure TKonsole.ProcessMessage(Message: ShortString);
  211. {‚뢥á⨠ᮮ¡é¥­¨¥ ­  ª®­á®«ì}
  212. var
  213.   S: String;
  214.   LinesCount: Word;
  215.   CR, LF, W: Word;
  216.   BottomRow: Boolean = True;
  217. begin
  218.   if Length(Message) < 1 then Exit;
  219.  
  220.   repeat
  221.     CR := Pos(#13, Message);
  222.     LF := Pos(#10, Message);
  223.     if (CR > 0) and ((CR < LF) or (LF <= 0)) then
  224.       W := CR else
  225.     if LF > 0 then
  226.       W := LF else
  227.       W := Length(Message) + 1;
  228.     if W > 0 then
  229.     begin
  230.       if W > 1 then
  231.       begin
  232.         S := Copy(Message, 1, W - 1);
  233.         Delete(FLines[FCursor.Y], FCursor.X, Length(FLines[FCursor.Y]) - FCursor.X);
  234.         Insert(S, FLines[FCursor.Y], FCursor.X);
  235.         Inc(FCursor.X, Length(S));
  236.       end;
  237.       Delete(Message, 1, W);
  238.       if W = CR then
  239.         {¯¥à¥¢®¤ ª®à¥âª¨ ¢ ­ ç «® áâப¨}
  240.         FCursor.X := 1 else
  241.       if W = LF then
  242.       begin
  243.         {¯¥à¥¢®¤ ª®à¥âª¨ ­  á«¥¤ãîéãî áâபã}
  244.         BottomRow := False;
  245.         Inc(FCursor.Y);
  246.         LinesCount := Length(FLines);
  247.         while FCursor.Y >= FMaxLines do Dec(FCursor.Y, FMaxLines);
  248.         if FCursor.Y < LinesCount then FLines[FCursor.Y] := '';
  249.         while FCursor.Y >= LinesCount do
  250.         begin
  251.           SetLength(FLines, LinesCount + 1);
  252.           FLines[LinesCount] := '';
  253.           Inc(LinesCount);
  254.         end;
  255.       end;
  256.     end;
  257.   until Length(Message) <= 0;
  258.  
  259.   Paint(BottomRow);
  260. end;
  261.  
  262. procedure TKonsole.ProcessKeyboard(Key: Word);
  263. begin
  264.   FKeyPressed := Key;
  265. end;
  266.  
  267. function TKonsole.GetRect(): TKosRect;
  268. var
  269.   ThreadInfo: TKosThreadInfo;
  270. begin
  271.   kos_threadinfo(@ThreadInfo, FThreadSlot);
  272.   Result := ThreadInfo.WindowRect;
  273. end;
  274.  
  275. function TKonsole.GetKeyPressed(): Word;
  276. begin
  277.   Result := FKeyPressed;
  278.   FKeyPressed := 0;
  279. end;
  280.  
  281. procedure TKonsole.Paint(BottomRow: Boolean);
  282. var
  283.   Buffer: array[Byte] of Char;
  284.   Rect: TKosRect;
  285.   J: Longint;
  286.   Width, Height, Row: Longint;
  287.   CaptionHeight, BorderWidth, FontWidth, FontHeight: Longint;
  288. begin
  289.   CaptionHeight := 16;
  290.   BorderWidth := 5;
  291.   FontWidth := 6;
  292.   FontHeight := 9;
  293.  
  294.   kos_begindraw();
  295.  
  296.   if not BottomRow then
  297.   begin
  298.     {®âà¨á®¢ª  ®ª­ }
  299.     kos_definewindow(60, 60, 400, 400, $63000000);
  300.     {¢ë¢®¤ § £®«®¢ª }
  301.     Move(FCaption[1], Buffer, Length(FCaption));
  302.     Buffer[Length(FCaption)] := #0;
  303.     kos_setcaption(Buffer);
  304.   end;
  305.  
  306.   {¯®¤£®â®¢ª  ª ¢ë¢®¤ã áâப}
  307.   Rect := GetRect();
  308.   Dec(Rect.Width, BorderWidth * 2);
  309.   Dec(Rect.Height, CaptionHeight + BorderWidth * 2);
  310.   Width  := Rect.Width div FontWidth;
  311.   Height := Rect.Height - FontHeight;
  312.   Row := FCursor.Y;
  313.  
  314.   while Height > 0 do
  315.   begin
  316.     {¢ë¢®¤ ®¤­®© áâப¨}
  317.     J := Length(FLines[Row]);
  318.     if J > Width then J := Width;
  319.     kos_drawtext(0, Height, Copy(FLines[Row], 1, J), $00DD00, $FF000000);
  320.     {§ «¨¢ª  ®á⠢襣®áï ¯à®áâà ­á⢠ ¢ áâப¥}
  321.     J := J * FontWidth;
  322.     kos_drawrect(J, Height, Rect.Width - J + 1, FontHeight, $000000);
  323.     {¯®¤£®â®¢ª  ª ¢ë¢®¤ã á«¥¤ãî饩 áâப¨}
  324.     Dec(Height, FontHeight);
  325.     Dec(Row);
  326.     if BottomRow or ((Row < 0) and (Length(FLines) < FMaxLines)) then Break;
  327.     while Row < 0 do Inc(Row, FMaxLines);
  328.   end;
  329.   if FCursor.X <= Width then
  330.     {®âà¨á®¢ª  ªãàá®à }
  331.     kos_drawrect((FCursor.X - 1) * FontWidth, Rect.Height - 2, FontWidth, 2, $FFFFFF);
  332.   if not BottomRow then
  333.     {§ «¨¢ª  ®á⠢襩áï ç á⨠®ª­ }
  334.     kos_drawrect(0, 0, Rect.Width + 1, Height + FontHeight, $000000);
  335.  
  336.   kos_enddraw();
  337. end;
  338.  
  339. procedure TKonsole.Write(Message: ShortString);
  340. var
  341.   I: Integer;
  342. begin
  343.   {XXX: ¢®§¬®¦­  á¨âã æ¨ï ¯à¨ ª®â®à®© á®®¡é¥­¨¥ ­¥ ¡ã¤¥â ®â¯à ¢«¥­®}
  344.   if FOpened then
  345.   begin
  346.     I := 100;
  347.     while (kos_sendmsg(FThreadID, @Message[1], Length(Message)) = 2) and (I > 0) do
  348.     begin
  349.       Dec(I);
  350.       ThreadSwitch;
  351.     end;
  352.   end;
  353. end;
  354.