forked from KolibriOS/kolibrios
[FP] changes in RTL, gfx example
git-svn-id: svn://kolibrios.org@666 a494cfbc-eb01-0410-851d-a64ba20cac60
This commit is contained in:
parent
c1f806239d
commit
bafb2d78f4
@ -2,7 +2,7 @@
|
||||
|
||||
set NAME=%1
|
||||
set NAMEEXE=%NAME%.exe
|
||||
set NAMEKOS=%NAME%
|
||||
set NAMEKEX=%NAME%.kex
|
||||
|
||||
set BUILD=-FUbuild
|
||||
set UNTS=-Fu..\units
|
||||
@ -10,8 +10,9 @@ set UNTS=-Fu..\units
|
||||
fpc %NAME%.pp -n -Twin32 -Se5 -XXs -Sg -O3pPENTIUM3 -CfSSE -WB0 %BUILD% %UNTS%
|
||||
if errorlevel 1 goto error
|
||||
|
||||
..\exe2kos\exe2kos.exe %NAMEEXE% %NAMEKOS%.kex
|
||||
..\exe2kos\exe2kos.exe %NAMEEXE% %NAMEKEX%
|
||||
del %NAMEEXE%
|
||||
move %NAMEKEX% bin
|
||||
goto end
|
||||
|
||||
:error
|
||||
|
1
programs/develop/fp/examples/ray.bat
Normal file
1
programs/develop/fp/examples/ray.bat
Normal file
@ -0,0 +1 @@
|
||||
@call _build.bat ray
|
256
programs/develop/fp/examples/ray.pp
Normal file
256
programs/develop/fp/examples/ray.pp
Normal file
@ -0,0 +1,256 @@
|
||||
|
||||
{ ‚ FreePascal 2.2.0 ª®¤¨à®¢ª cp866 ¥ ॠ«¨§®¢ . }
|
||||
{-$codepage cp866}
|
||||
|
||||
{$mode objfpc}
|
||||
{$apptype gui}
|
||||
{$r-}
|
||||
|
||||
program Ray;
|
||||
|
||||
const
|
||||
MSG_PRESSKEY = '<27> ¦¬¨ ª®¯ªã...';
|
||||
MSG_USAGE = '„«ï ¯¥à¥¬¥è¥¨ï ¨ ¢à è¥¨ï ¨á¯®«ì§ã© áâ५ª¨';
|
||||
|
||||
WIDTH = 320;
|
||||
HEIGHT = 200;
|
||||
COLORS = 128;
|
||||
|
||||
FlatPalette: array[1..COLORS * 3] of Byte = (
|
||||
0,10,20,48,48,48,1,0,43,1,3,43,2,5,44,2,7,44,3,9,45,4,11,46,5,13,47,6,15,48,
|
||||
7,17,49,8,19,50,9,21,51,10,22,52,11,24,52,12,26,54,13,28,54,14,30,56,15,32,
|
||||
56,16,34,58,17,34,58,17,36,58,18,38,60,19,40,60,20,42,62,21,44,62,10,31,0,
|
||||
11,31,0,11,31,1,11,32,1,12,32,1,12,32,2,12,33,2,13,33,2,14,33,3,15,33,3,15,
|
||||
34,3,15,34,4,15,35,4,16,35,4,16,35,5,16,36,5,17,36,5,17,36,6,18,37,6,18,38,
|
||||
7,19,38,8,20,39,8,20,40,9,21,40,10,22,41,10,22,42,11,23,42,12,24,43,12,24,
|
||||
44,13,25,44,14,25,45,14,26,46,15,27,46,16,27,47,17,28,47,18,28,48,19,29,49,
|
||||
19,30,49,20,30,50,21,31,51,21,32,51,22,32,52,23,33,53,23,34,53,24,34,54,25,
|
||||
35,55,25,36,55,26,36,56,27,37,57,27,38,57,27,39,57,27,41,57,27,42,57,27,43,
|
||||
57,27,44,57,27,45,57,27,46,57,27,47,57,27,49,57,27,50,57,27,51,57,27,52,57,
|
||||
27,53,57,27,55,57,27,56,57,27,57,57,27,58,57,27,58,57,26,58,57,25,58,57,24,
|
||||
58,56,23,58,55,22,58,54,20,58,53,19,58,51,18,58,50,17,58,50,16,58,49,15,58,
|
||||
48,14,58,47,13,58,46,12,58,45,11,58,44,11,58,44,10,58,43,10,58,42,9,57,41,
|
||||
8,57,40,8,56,39,7,56,38,6,55,37,5,55,35,4,54,33,4,54,31,2,32,32,32,63,63,63,
|
||||
63,63,63,63,63,63,63,63,63,48,48,48,63,63,63,63,63,63);
|
||||
|
||||
type
|
||||
TRGBColor = packed record
|
||||
R, G, B: Byte;
|
||||
end;
|
||||
|
||||
PRGBPalette = ^TRGBPalette;
|
||||
TRGBPalette = array[0..COLORS - 1] of TRGBColor;
|
||||
|
||||
PRGBBuffer = ^TRGBBuffer;
|
||||
TRGBBuffer = array[0..HEIGHT - 1, 0..WIDTH - 1] of TRGBColor;
|
||||
|
||||
lrgarr = array[Word] of Byte;
|
||||
sq = array[0..254, 0..255] of Byte;
|
||||
|
||||
|
||||
var
|
||||
mp: ^lrgarr;
|
||||
rng: array[0..320] of Byte;
|
||||
fcos, fsin: array[0..359] of Integer;
|
||||
|
||||
RGBBuffer : PRGBBuffer;
|
||||
RGBPalette: TRGBPalette absolute FlatPalette;
|
||||
|
||||
Message: String = '';
|
||||
|
||||
|
||||
function NCol(mc, n, dvd: Longint): Byte;
|
||||
var
|
||||
loc: Byte;
|
||||
begin
|
||||
loc := Byte((mc + n - Random(2 * n)) div dvd);
|
||||
if loc > 100 then Result := 100 else
|
||||
if loc < 5 then Result := 5 else
|
||||
Result := loc;
|
||||
end;
|
||||
|
||||
|
||||
procedure Plasma(x1, y1, x2, y2: Word);
|
||||
var
|
||||
xn, yn, dxy : Word;
|
||||
p1, p2, p3, p4: Word;
|
||||
begin
|
||||
if (x2 - x1 > 1) or (y2 - y1 > 1) then
|
||||
begin
|
||||
p1 := mp^[Word(y1 shl 8 + x1)];
|
||||
p2 := mp^[Word(y2 shl 8 + x1)];
|
||||
p3 := mp^[Word(y1 shl 8 + x2)];
|
||||
p4 := mp^[Word(y2 shl 8 + x2)];
|
||||
xn := (x2 + x1) shr 1;
|
||||
yn := (y2 + y1) shr 1;
|
||||
dxy:= 5 * (x2 - x1 + y2 - y1) div 3;
|
||||
|
||||
if mp^[y1 shl 8 + xn] = 0 then mp^[Word(y1 shl 8 + xn)] := NCol(p1 + p3, dxy, 2);
|
||||
if mp^[yn shl 8 + x1] = 0 then mp^[Word(yn shl 8 + x1)] := NCol(p1 + p2, dxy, 2);
|
||||
if mp^[yn shl 8 + x2] = 0 then mp^[Word(yn shl 8 + x2)] := NCol(p3 + p4, dxy, 2);
|
||||
if mp^[y2 shl 8 + xn] = 0 then mp^[Word(y2 shl 8 + xn)] := NCol(p2 + p4, dxy, 2);
|
||||
mp^[Word(yn shl 8 + xn)] := NCol(p1 + p2 + p3 + p4, dxy, 4);
|
||||
|
||||
Plasma(x1, y1, xn, yn);
|
||||
Plasma(xn, y1, x2, yn);
|
||||
Plasma(x1, yn, xn, y2);
|
||||
Plasma(xn, yn, x2, y2);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure Draw(xp, yp, dir: Integer);
|
||||
var
|
||||
z, zobs : Integer;
|
||||
ix, iy, iy1, iyp, ixp : Integer;
|
||||
x, y : Integer;
|
||||
s, csf, snf, mpc, i, j: Integer;
|
||||
begin
|
||||
while dir < 0 do Inc(dir, SizeOf(fcos));
|
||||
while dir >= SizeOf(fcos) do Dec(dir, SizeOf(fcos));
|
||||
|
||||
FillChar(rng, SizeOf(rng), 200);
|
||||
FillChar(RGBBuffer^, SizeOf(RGBBuffer^), 0);
|
||||
|
||||
zobs := 300 + mp^[Word(yp shl 8 + xp)];
|
||||
|
||||
csf := fcos[dir];
|
||||
snf := fsin[dir];
|
||||
|
||||
for iy := yp to yp+150 do
|
||||
begin
|
||||
iy1 := 1 + 2 * (iy - yp);
|
||||
s := 4 + 300 div iy1;
|
||||
|
||||
for ix := xp + yp - iy to xp - yp + iy do
|
||||
begin
|
||||
ixp := xp + ((ix - xp) * csf + (iy - yp) * snf) shr 8;
|
||||
iyp := yp + ((iy - yp) * csf - (ix - xp) * snf) shr 8;
|
||||
x := 160 + 360 * (ix - xp) div iy1;
|
||||
|
||||
if (x >= 0) and (x + s < 319) then
|
||||
begin
|
||||
z := mp^[Word(iyp shl 8 + ixp)];
|
||||
mpc := z shr 1;
|
||||
|
||||
if z < 40 then z := 40;
|
||||
y := 100 + (zobs - z) * 30 div iy1;
|
||||
|
||||
if (y < 200) and (y >= 0) then
|
||||
for j := x to x + s do
|
||||
if y < rng[j] then
|
||||
begin
|
||||
for i := y to rng[j] do
|
||||
RGBBuffer^[i - 1, j] := RGBPalette[mpc];
|
||||
rng[j] := y;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure Paint;
|
||||
begin
|
||||
kos_begindraw();
|
||||
kos_definewindow(100, 100, WIDTH - 1, HEIGHT - 1, $01000000);
|
||||
kos_drawimage24(0, 0, WIDTH, HEIGHT, RGBBuffer);
|
||||
if Message <> '' then
|
||||
kos_drawtext(12, HEIGHT - 12 - 9, Message, $00FF00, $FF000000);
|
||||
kos_enddraw();
|
||||
end;
|
||||
|
||||
|
||||
function ReadKey: Char;
|
||||
var
|
||||
Event: Word;
|
||||
begin
|
||||
kos_maskevents(ME_PAINT or ME_KEYBOARD);
|
||||
repeat
|
||||
Event := kos_getevent();
|
||||
if Event = SE_PAINT then Paint;
|
||||
until Event = SE_KEYBOARD;
|
||||
Result := Chr(kos_getkey() shr 8);
|
||||
end;
|
||||
|
||||
|
||||
procedure Pause;
|
||||
begin
|
||||
kos_maskevents(ME_PAINT or ME_KEYBOARD);
|
||||
Message := MSG_PRESSKEY;
|
||||
Paint;
|
||||
ReadKey;
|
||||
end;
|
||||
|
||||
|
||||
var
|
||||
dir, i, j, x, y: Longint;
|
||||
C: Char;
|
||||
B: Byte;
|
||||
Terminate: Boolean;
|
||||
|
||||
begin
|
||||
{ â ¡«¨æë § 票© á¨ãá ¨ ª®á¨ãá }
|
||||
for i := 0 to 359 do
|
||||
begin
|
||||
fcos[i] := Trunc(256 * Cos(i / 180 * Pi));
|
||||
fsin[i] := Trunc(256 * Sin(i / 180 * Pi));
|
||||
end;
|
||||
|
||||
{ ᮧ¤ ¥¬ ¡ãä¥à á íä䥪⮬ "¯« §¬ " }
|
||||
New(mp);
|
||||
FillChar(mp^, SizeOf(mp^), 0);
|
||||
mp^[$0000] := 128;
|
||||
Plasma(0, 0, 256, 256);
|
||||
|
||||
{ ᮧ¤ ¥¬ "¯ãá⮩" ¡ãä¥à ª ¤à }
|
||||
New(RGBBuffer);
|
||||
FillChar(RGBBuffer^, SizeOf(RGBBuffer^), 0);
|
||||
|
||||
{ ¯à¥®¡à §®¢ ¨¥ ¯ «¨âàë ¨§ 63 ¢ 255 }
|
||||
|
||||
for i := 0 to COLORS - 1 do
|
||||
begin
|
||||
B := Round(RGBPalette[i].R / 63 * 255);
|
||||
RGBPalette[i].R := Round(RGBPalette[i].B / 63 * 255);
|
||||
RGBPalette[i].G := Round(RGBPalette[i].G / 63 * 255);
|
||||
RGBPalette[i].B := B;
|
||||
end;
|
||||
|
||||
for j := 0 to 199 do
|
||||
for i := 0 to 255 do
|
||||
RGBBuffer^[j, i + (WIDTH - 256) shr 1] := RGBPalette[sq(Pointer(mp)^)[j, i]];
|
||||
|
||||
Pause;
|
||||
|
||||
x := 0;
|
||||
y := 0;
|
||||
dir := 0;
|
||||
|
||||
Message := MSG_USAGE;
|
||||
|
||||
Terminate := False;
|
||||
while not Terminate do
|
||||
begin
|
||||
dir := dir mod 360;
|
||||
if dir < 0 then dir := 360 + dir;
|
||||
|
||||
Draw(x, y, dir);
|
||||
Paint;
|
||||
|
||||
C := ReadKey;
|
||||
if C = #$B0 then Dec(dir, 13) else
|
||||
if C = #$B3 then Inc(dir, 13) else
|
||||
if C = #$B2 then
|
||||
begin
|
||||
y := y + fcos[dir] shr 6;
|
||||
x := x + fsin[dir] shr 6;
|
||||
end else
|
||||
if C = #$B1 then
|
||||
begin
|
||||
y := y - fcos[dir] shr 6;
|
||||
x := x - fsin[dir] shr 6;
|
||||
end;
|
||||
if C = #27 then Terminate := True;
|
||||
end;
|
||||
end.
|
@ -1,3 +1 @@
|
||||
Codepage: cp866
|
||||
|
||||
„«ï ç « ¥®¡å®¦¨¬® ᮡà âì RTL ¨ ã⨫¨âã exe2kos.
|
||||
|
@ -1,4 +1,3 @@
|
||||
Codepage: cp866
|
||||
|
||||
’¥ªã騩 ª®¤ ¤ ¯â¨à®¢ ¨ ¯à®¢¥àï«áï ⮫쪮 FreePascal 2.2.0 ¯à¨ ª®¬¯¨«ï樨
|
||||
¨§ Windows.
|
||||
|
@ -1,6 +1,5 @@
|
||||
{$undef mswindows}
|
||||
{$undef windows}
|
||||
{$undef Windows}
|
||||
{$undef win32}
|
||||
{$undef os2}
|
||||
{$undef linux}
|
||||
|
@ -3,7 +3,8 @@
|
||||
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 FPCARGS=-Twin32 -Se5 -Sg -n -O3pPENTIUM3 -CfSSE -di386 -FU..\units %INCS% %UNTS%
|
||||
set BUILDPATH=..\units
|
||||
set FPCARGS=-n -Twin32 -Sge5 -O3pPENTIUM3 -CfSSE -di386 -FU%BUILDPATH% %INCS% %UNTS%
|
||||
|
||||
fpc system.pp -Us %FPCARGS%
|
||||
if errorlevel 1 goto error
|
||||
|
@ -388,6 +388,17 @@ asm
|
||||
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;
|
||||
|
@ -2,6 +2,7 @@
|
||||
|
||||
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;
|
||||
@ -20,7 +21,7 @@ end;
|
||||
procedure OpenStdout(var f: TextRec);
|
||||
begin
|
||||
TextRec(f).InOutFunc := @WriteStdout;
|
||||
TextRec(f).FlushFunc := @WriteStdout;
|
||||
TextRec(f).FlushFunc := @FlushStdout;
|
||||
TextRec(f).CloseFunc := @CloseStdout;
|
||||
end;
|
||||
|
||||
@ -34,6 +35,12 @@ begin
|
||||
Konsole.Write(msg);
|
||||
end;
|
||||
|
||||
procedure FlushStdout(var f: TextRec);
|
||||
begin
|
||||
WriteStdout(f);
|
||||
Konsole.Flush;
|
||||
end;
|
||||
|
||||
procedure CloseStdout(var f: TextRec);
|
||||
begin
|
||||
end;
|
||||
@ -114,12 +121,14 @@ begin
|
||||
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;
|
||||
@ -137,12 +146,13 @@ begin
|
||||
FCaption := StrPas(ThreadInfo.AppName);
|
||||
end;
|
||||
SetLength(FLines, 1);
|
||||
FLines[0] := ' ';
|
||||
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;
|
||||
@ -151,7 +161,6 @@ begin
|
||||
FThreadID := BeginThread(TThreadFunc(@KonsoleThreadMain), @Self);
|
||||
if FThreadID <> 0 then
|
||||
{XXX: ¬®¦¥â § ¢¨áãâì}
|
||||
{‚®, â ª ¨ ¥áâì ¢ 2.2.0.}
|
||||
while not FOpened do ThreadSwitch;
|
||||
end;
|
||||
|
||||
@ -164,10 +173,11 @@ begin
|
||||
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;
|
||||
@ -176,9 +186,10 @@ var
|
||||
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;
|
||||
@ -208,40 +219,27 @@ begin
|
||||
end;
|
||||
|
||||
procedure TKonsole.ProcessMessage(Message: ShortString);
|
||||
{‚뢥á⨠ᮮ¡é¥¨¥ ª®á®«ì}
|
||||
{ ‚뢥á⨠ᮮ¡é¥¨¥ ª®á®«ì }
|
||||
var
|
||||
S: String;
|
||||
LinesCount: Word;
|
||||
CR, LF, W: Word;
|
||||
BottomRow: Boolean = True;
|
||||
begin
|
||||
if Length(Message) < 1 then Exit;
|
||||
OnlyBottomLine: Boolean = True;
|
||||
|
||||
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
|
||||
procedure PutChar(C: Char);
|
||||
var
|
||||
LinesCount: Longint;
|
||||
PLine: PShortString;
|
||||
I: Longint;
|
||||
begin
|
||||
if W > 1 then
|
||||
{ ¯¥à¥¢®¤ ª®à¥âª¨ ¯®§¨æ¨î ¢«¥¢® }
|
||||
if C = #8 then
|
||||
begin
|
||||
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
|
||||
if FCursor.X > 1 then
|
||||
Dec(FCursor.X);
|
||||
end else
|
||||
|
||||
{ ¯¥à¥¢®¤ ª®à¥âª¨ á«¥¤ãîéãî áâபã }
|
||||
if C = #10 then
|
||||
begin
|
||||
{¯¥à¥¢®¤ ª®à¥âª¨ á«¥¤ãîéãî áâபã}
|
||||
BottomRow := False;
|
||||
OnlyBottomLine := False;
|
||||
Inc(FCursor.Y);
|
||||
LinesCount := Length(FLines);
|
||||
while FCursor.Y >= FMaxLines do Dec(FCursor.Y, FMaxLines);
|
||||
@ -252,11 +250,46 @@ begin
|
||||
FLines[LinesCount] := '';
|
||||
Inc(LinesCount);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
until Length(Message) <= 0;
|
||||
end else
|
||||
|
||||
Paint(BottomRow);
|
||||
{ ¯¥à¥¢®¤ ª®à¥âª¨ ¢ ç «® áâப¨ }
|
||||
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);
|
||||
@ -351,3 +384,8 @@ begin
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TKonsole.Flush();
|
||||
begin
|
||||
while FOnAir do ThreadSwitch;
|
||||
end;
|
||||
|
@ -1,4 +1,4 @@
|
||||
{}
|
||||
{-$codepage cp866}
|
||||
|
||||
type
|
||||
TKosPoint = packed record
|
||||
@ -46,6 +46,9 @@ function kos_getthreadslot(tid: TThreadID): TThreadSlot;
|
||||
{ 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;
|
||||
@ -67,7 +70,9 @@ type
|
||||
MemoryUsage: DWord;
|
||||
ThreadID: TThreadID;
|
||||
WindowRect: TKosRect;
|
||||
Unknown0: array[1..1066] of Byte;
|
||||
Reserved3: DWord;
|
||||
ClientRect: TKosRect;
|
||||
Reserved4: array[1..1046] of Byte;
|
||||
end;
|
||||
|
||||
{<EFBFBD>ãä¥à IPC}
|
||||
@ -179,7 +184,7 @@ type
|
||||
TKonsole = object
|
||||
private
|
||||
FCaption: String;
|
||||
FLines: array of String;
|
||||
FLines: array of ShortString;
|
||||
FCursor: TKosPoint;
|
||||
FMaxLines: Word;
|
||||
FThreadID: TThreadID;
|
||||
@ -188,6 +193,7 @@ type
|
||||
FIPCBufferSize: DWord;
|
||||
FTerminate: Boolean;
|
||||
FOpened: Boolean;
|
||||
FOnAir : Boolean;
|
||||
FKeyPressed: Word;
|
||||
function ReceiveMessage(var Message: ShortString): Boolean;
|
||||
procedure ProcessMessage(Message: ShortString);
|
||||
@ -195,6 +201,7 @@ type
|
||||
function GetRect(): TKosRect;
|
||||
function GetKeyPressed(): Word;
|
||||
procedure Paint(BottomRow: Boolean = False);
|
||||
procedure Flush();
|
||||
public
|
||||
constructor Init(ACaption: String = '');
|
||||
destructor Done();
|
||||
@ -205,7 +212,59 @@ type
|
||||
property ThreadSlot: TThreadSlot read FThreadSlot; {JustForFun, must be hidden, do not use}
|
||||
end;
|
||||
|
||||
IStreamIO = interface
|
||||
function Read(Size: DWord = 0): AnsiString;
|
||||
procedure Write(Str: AnsiString; Error: Boolean = False);
|
||||
(*<EFBFBD> §à ¡®âª â¥à¬¨ « ¢ à ¬ª å 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;
|
||||
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;*)
|
||||
|
@ -136,6 +136,7 @@ begin
|
||||
end;
|
||||
|
||||
{$i kos_stdio.inc}
|
||||
{-$i kos_term.inc}
|
||||
|
||||
procedure SysInitStdIO;
|
||||
begin
|
||||
@ -186,12 +187,13 @@ begin
|
||||
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;
|
||||
|
Loading…
Reference in New Issue
Block a user