/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; |