Subversion Repositories Kolibri OS

Compare Revisions

Regard whitespace Rev 666 → Rev 643

/programs/develop/fp/examples/ray.bat
File deleted
/programs/develop/fp/examples/ray.pp
File deleted
/programs/develop/fp/examples/_build.bat
2,7 → 2,7
 
set NAME=%1
set NAMEEXE=%NAME%.exe
set NAMEKEX=%NAME%.kex
set NAMEKOS=%NAME%
 
set BUILD=-FUbuild
set UNTS=-Fu..\units
10,9 → 10,8
fpc %NAME%.pp -n -Twin32 -Se5 -XXs -Sg -O3pPENTIUM3 -CfSSE -WB0 %BUILD% %UNTS%
if errorlevel 1 goto error
 
..\exe2kos\exe2kos.exe %NAMEEXE% %NAMEKEX%
..\exe2kos\exe2kos.exe %NAMEEXE% %NAMEKOS%.kex
del %NAMEEXE%
move %NAMEKEX% bin
goto end
 
:error
/programs/develop/fp/examples/readme-ru.txt
1,0 → 0,0
Codepage: cp866
 
„«ï ­ ç «  ­¥®¡å®¦¨¬® ᮡà âì RTL ¨ ã⨫¨âã exe2kos.
/programs/develop/fp/readme-ru.txt
1,3 → 1,4
Codepage: cp866
 
’¥ªã騩 ª®¤  ¤ ¯â¨à®¢ ­ ¨ ¯à®¢¥àï«áï ⮫쪮 ­  FreePascal 2.2.0 ¯à¨ ª®¬¯¨«ï樨
¨§ Windows.
/programs/develop/fp/rtl/_defines.inc
1,5 → 1,6
{$undef mswindows}
{$undef windows}
{$undef Windows}
{$undef win32}
{$undef os2}
{$undef linux}
/programs/develop/fp/rtl/kos.inc
388,17 → 388,6
popl %eax
end;
 
{ Work with system - Get system parameters }
 
function kos_timecounter(): DWord; assembler; register;
asm
pushl %ebx
movl $26, %eax
movl $9, %ebx
int $0x40
popl %ebx
end;
 
{ Work with system - Internal system services }
 
procedure kos_switchthread(); assembler; register;
/programs/develop/fp/rtl/kos_stdio.inc
2,7 → 2,6
 
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;
21,7 → 20,7
procedure OpenStdout(var f: TextRec);
begin
TextRec(f).InOutFunc := @WriteStdout;
TextRec(f).FlushFunc := @FlushStdout;
TextRec(f).FlushFunc := @WriteStdout;
TextRec(f).CloseFunc := @CloseStdout;
end;
 
35,12 → 34,6
Konsole.Write(msg);
end;
 
procedure FlushStdout(var f: TextRec);
begin
WriteStdout(f);
Konsole.Flush;
end;
 
procedure CloseStdout(var f: TextRec);
begin
end;
121,7 → 114,6
while not Console^.FTerminate do
begin
Event := kos_getevent();
Console^.FOnAir := True;
if not Console^.FTerminate then
case Event of
SE_PAINT: Console^.Paint();
128,7 → 120,6
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;
152,7 → 143,6
FMaxLines := 150;
FTerminate := False;
FOpened := False;
FOnAir := False;
FIPCBufferSize := SizeOf(TKosIPC) + IPC_SIZE;
FIPCBuffer := GetMem(FIPCBufferSize);
FIPCBuffer^.Lock := False;
161,6 → 151,7
FThreadID := BeginThread(TThreadFunc(@KonsoleThreadMain), @Self);
if FThreadID <> 0 then
{XXX: ¬®¦¥â § ¢¨á­ãâì}
{‚®, â ª ¨ ¥áâì ¢ 2.2.0.}
while not FOpened do ThreadSwitch;
end;
 
173,11 → 164,10
if FOpened then
begin
FOpened := False;
FOnAir := False;
KillThread(FThreadID);
end;
{FreeMem(FIPCBuffer);
SetLength(FLines, 0);}
FreeMem(FIPCBuffer);
SetLength(FLines, 0);
end;
 
function TKonsole.ReceiveMessage(var Message: ShortString): Boolean;
186,10 → 176,9
PMsg: PKosMessage;
Size: Longword;
begin
FIPCBuffer^.Lock := True;
 
if FIPCBuffer^.Size > 0 then
begin
FIPCBuffer^.Lock := True;
PMsg := Pointer(Longword(FIPCBuffer) + SizeOf(TKosIPC));
{TODO: ¯à®¢¥àª  PMsg^.SenderID}
{Size := PMsg^.Size;
221,25 → 210,38
procedure TKonsole.ProcessMessage(Message: ShortString);
{ ‚뢥á⨠ᮮ¡é¥­¨¥ ­  ª®­á®«ì }
var
OnlyBottomLine: Boolean = True;
S: String;
LinesCount: Word;
CR, LF, W: Word;
BottomRow: Boolean = True;
begin
if Length(Message) < 1 then Exit;
 
procedure PutChar(C: Char);
var
LinesCount: Longint;
PLine: PShortString;
I: Longint;
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 C = #8 then
if W > 1 then
begin
if FCursor.X > 1 then
Dec(FCursor.X);
end else
 
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
{ ¯¥à¥¢®¤ ª®à¥âª¨ ­  á«¥¤ãîéãî áâபã }
if C = #10 then
begin
OnlyBottomLine := False;
BottomRow := False;
Inc(FCursor.Y);
LinesCount := Length(FLines);
while FCursor.Y >= FMaxLines do Dec(FCursor.Y, FMaxLines);
250,48 → 252,13
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;
until Length(Message) <= 0;
 
Inc(FCursor.X);
Paint(BottomRow);
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;
384,8 → 351,3
end;
end;
end;
 
procedure TKonsole.Flush();
begin
while FOnAir do ThreadSwitch;
end;
/programs/develop/fp/rtl/kosh.inc
1,4 → 1,4
{-$codepage cp866}
{}
 
type
TKosPoint = packed record
46,9 → 46,6
{ Work with system - Set system parameters }
procedure kos_enablepci();
 
{ Work with system - Get system parameters }
function kos_timecounter(): DWord;
 
{ Work with system - Internal system services }
procedure kos_switchthread();
function kos_initheap(): DWord;
70,9 → 67,7
MemoryUsage: DWord;
ThreadID: TThreadID;
WindowRect: TKosRect;
Reserved3: DWord;
ClientRect: TKosRect;
Reserved4: array[1..1046] of Byte;
Unknown0: array[1..1066] of Byte;
end;
 
{ãä¥à IPC}
184,7 → 179,7
TKonsole = object
private
FCaption: String;
FLines: array of ShortString;
FLines: array of String;
FCursor: TKosPoint;
FMaxLines: Word;
FThreadID: TThreadID;
193,7 → 188,6
FIPCBufferSize: DWord;
FTerminate: Boolean;
FOpened: Boolean;
FOnAir : Boolean;
FKeyPressed: Word;
function ReceiveMessage(var Message: ShortString): Boolean;
procedure ProcessMessage(Message: ShortString);
201,7 → 195,6
function GetRect(): TKosRect;
function GetKeyPressed(): Word;
procedure Paint(BottomRow: Boolean = False);
procedure Flush();
public
constructor Init(ACaption: String = '');
destructor Done();
212,59 → 205,7
property ThreadSlot: TThreadSlot read FThreadSlot; {JustForFun, must be hidden, do not use}
end;
 
(* §à ¡®âª  â¥à¬¨­ «  ¢ à ¬ª å RTL ¯à¥ªà é¥­ . ’¥à¬¨­ « ¡ã¤¥â ¢ë¤¥«¥­ ¨§ ª®¤ 
ª®­á®«ì­®£® ¯à¨«®¦¥­¨ï ¨ ¤®«¦¥­ ¡ëâì ॠ«¨§®¢ ­ ª ª ®â¤¥«ì­ë© á¥à¢¨á á
¤¨­ ¬¨ç¥áª¨¬ ¯®¤ª«î祭¨¥¬, «¨¡® ª ª ®â¤¥«ì­ë© ¬®¤ã«ì FreePascal á® áâ â¨ç¥áª¨¬
¨«¨ ¤¨­ ¬¨ç¥áª¨¬ ¯®¤ª«î祭¨¥¬ â¥à¬¨­ «ì­®£® ä㭪樮­ « .
 
PTermKursor = ^TTermKursor;
TTermKursor = object
private
FVisible: Boolean;
procedure SetVisbile(Value: Boolean);
public
constructor Init;
procedure Repaint;
property Visible: Boolean read FVisible write SetVisbile;
IStreamIO = interface
function Read(Size: DWord = 0): AnsiString;
procedure Write(Str: AnsiString; Error: Boolean = False);
end;
 
PTermKIO = ^TTermKIO;
TTermKIO = object
private
FBuffer: Pointer;
FBufferScreen: Pointer;
FBufferSize : Longword;
FBufferWidth: Longword;
FBufferLines: Longword;
FIPCBuffer: PKosIPC;
FIPCBufferSize: Longword;
FCursor: TTermKursor;
FCaption: String;
FThreadID: TThreadID;
FThreadSlot: TThreadSlot;
FTerminate: Boolean;
FOpened: Boolean;
FWindowBounds: TKosRect;
FWindowStyle : Longword;
FClientBounds: TKosRect;
FMaxWidth : Longword;
FFirstLine: Longword;
FDefaultChar: Word;
FPalette: array[0..15] of Longword;
procedure MainLoop;
procedure ReallocBuffer(Size: Longword);
procedure ResizeBuffer(NewWidth, NewLines: Longword);
procedure FillDefaultChar(var X; Count: Longword);
function GetLine(Index: Longint): Pointer;
function PrevLine(Line: Pointer): Pointer;
{function ReceiveMessage(var Message: ShortString): Boolean;
procedure ProcessMessage(Message: ShortString);}
procedure ProcessKeyboard(Key: Word);
procedure DoPaint(const Bounds: TKosRect);
procedure DoResize;
public
constructor Init(ACaption: String = '');
destructor Done;
procedure Write(Message: ShortString);
property Cursor: TTermKursor read FCursor;
end;*)
/programs/develop/fp/rtl/build.bat
3,8 → 3,7
set FPRTL={FreePascal RTL source code, example c:\fp\src\rtl}
set INCS=-Fi%FPRTL%\inc;%FPRTL%\i386;%FPRTL%\objpas;%FPRTL%\objpas\sysutils;%FPRTL%\objpas\classes
set UNTS=-Fu%FPRTL%\inc;%FPRTL%\i386;%FPRTL%\objpas
set BUILDPATH=..\units
set FPCARGS=-n -Twin32 -Sge5 -O3pPENTIUM3 -CfSSE -di386 -FU%BUILDPATH% %INCS% %UNTS%
set FPCARGS=-Twin32 -Se5 -Sg -n -O3pPENTIUM3 -CfSSE -di386 -FU..\units %INCS% %UNTS%
 
fpc system.pp -Us %FPCARGS%
if errorlevel 1 goto error
/programs/develop/fp/rtl/system.pp
136,7 → 136,6
end;
 
{$i kos_stdio.inc}
{-$i kos_term.inc}
 
procedure SysInitStdIO;
begin
187,13 → 186,12
SysResetFPU;
StackLength := CheckInitialStkLen(InitialStkLen);
StackBottom := Pointer(StackTop - StackLength);
InitHeap;
kos_initheap();
InitHeap;
SysInitExceptions;
FPC_CpuCodeInit();
InOutRes := 0;
InitSystemThreads;
if IsConsole then
Konsole.Init();
SysInitStdIO;
SetupCmdLine;