From 3c8b01128f0d273f2f09a08ec3bd7bcd1e04b9cf Mon Sep 17 00:00:00 2001
From: Pavel <68122101+red-prig@users.noreply.github.com>
Date: Thu, 22 Feb 2024 15:47:53 +0300
Subject: [PATCH] +
---
fpPS4.lpi | 4 ++
gui/game_run.pas | 13 ++--
gui/main.pas | 65 +++++++++++++++--
sys/dev/dev_dce.pas | 66 ++++++++---------
sys/dev/display_interface.pas | 87 +++++++++++++++++-----
sys/dev/display_soft.pas | 132 ++++++++++++++++++++++++++++++++++
sys/host_ipc.pas | 11 ++-
sys/md/md_host_ipc.pas | 6 ++
8 files changed, 318 insertions(+), 66 deletions(-)
create mode 100644 sys/dev/display_soft.pas
diff --git a/fpPS4.lpi b/fpPS4.lpi
index 8ef5fd66..ee5e75be 100644
--- a/fpPS4.lpi
+++ b/fpPS4.lpi
@@ -858,6 +858,10 @@
+
+
+
+
diff --git a/gui/game_run.pas b/gui/game_run.pas
index 5ebb6c89..163cc5fd 100644
--- a/gui/game_run.pas
+++ b/gui/game_run.pas
@@ -54,6 +54,9 @@ uses
md_game_process,
+ dev_dce,
+ display_soft,
+
//internal libs
ps4_libSceSystemService,
ps4_libSceUserService,
@@ -66,14 +69,14 @@ uses
//
-procedure TGameProcessSimple.suspend;
+procedure TGameProcessSimple.suspend;
begin
- thread_suspend_all(Ftd);
+ thread_suspend_all(nil);
end;
-procedure TGameProcessSimple.resume;
+procedure TGameProcessSimple.resume;
begin
- thread_resume_all(Ftd);
+ thread_resume_all(nil);
end;
Destructor TGameProcessSimple.Destroy;
@@ -122,6 +125,8 @@ begin
PROC_INIT_HOST_IPC(kern_ipc);
+ dev_dce.dce_interface:=display_soft.TDisplayHandleSoft;
+
Writeln(Item.FGameInfo.Exec);
Writeln(Item.FMountList.app0);
Writeln(Item.FMountList.system);
diff --git a/gui/main.pas b/gui/main.pas
index 75dea0dd..fd91ab74 100644
--- a/gui/main.pas
+++ b/gui/main.pas
@@ -7,6 +7,10 @@ interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ComCtrls, Grids, Menus,
+ LMessages,
+ LCLType,
+ LCLIntf,
+
g_bufstream,
LineStream,
synlog,
@@ -28,7 +32,12 @@ type
mdsRunned,
mdsSuspended);
- { TfrmMain }
+ TGameMainForm=class(TForm)
+ public
+ caption_format:RawByteString;
+ procedure SetCaptionFPS(Ffps:QWORD);
+ procedure WMEraseBkgnd(var Message:TLMEraseBkgnd); message LM_ERASEBKGND;
+ end;
TfrmMain = class(TForm)
MainImageList: TImageList;
@@ -82,6 +91,11 @@ type
FMainButtonsState:TMainButtonsState;
+ FGameMainForm:TGameMainForm;
+
+ function OpenMainWindows():THandle;
+ Procedure CloseMainWindows();
+
procedure ReadIniFile;
procedure LoadItemIni(Item:TGameItem);
procedure SaveItemIni(Item:TGameItem);
@@ -116,7 +130,15 @@ uses
{$R *.lfm}
-{ TfrmMain }
+procedure TGameMainForm.SetCaptionFPS(Ffps:QWORD);
+begin
+ Caption:=Format(caption_format,[Ffps]);
+end;
+
+procedure TGameMainForm.WMEraseBkgnd(var Message:TLMEraseBkgnd);
+begin
+ Message.Result:=1;
+end;
type
TMySynLog=class(TCustomSynLog)
@@ -155,7 +177,8 @@ function TGuiIpcHandler.OnMessage(mtype:t_mtype;mlen:DWORD;buf:Pointer):Ptruint;
begin
Result:=0;
case mtype of
- iKEV_EVENT:Result:=OnKevent(buf,mlen div sizeof(t_kevent));
+ iKEV_EVENT :Result:=OnKevent(buf,mlen div sizeof(t_kevent));
+ iMAIN_WINDOWS:Result:=Form.OpenMainWindows();
else;
ShowMessage(GetEnumName(TypeInfo(mtype),ord(mtype)));
end;
@@ -373,6 +396,38 @@ begin
end;
+function TfrmMain.OpenMainWindows():THandle;
+const
+ pd_Width=1280;
+ pd_Height=720;
+begin
+ if (FGameMainForm<>nil) then Exit(FGameMainForm.Handle);
+
+ FGameMainForm:=TGameMainForm.CreateNew(Self);
+ FGameMainForm.ShowInTaskBar:=stAlways;
+ FGameMainForm.DoubleBuffered:=False;
+ FGameMainForm.ParentDoubleBuffered:=False;
+ FGameMainForm.FormStyle:=fsNormal;
+ FGameMainForm.SetBounds(100, 100, pd_Width, pd_Height);
+ //FGameMainForm.caption_format:=get_caption_format;
+ FGameMainForm.SetCaptionFPS(0);
+ //FGameMainForm.OnClose:=@FGameMainForm.CloseEvent;
+ //FGameMainForm.OnKeyDown:=@FGameMainForm.KeyEvent;
+ FGameMainForm.Position:=poScreenCenter;
+
+ ///
+ ///
+
+ FGameMainForm.Show;
+
+ Exit(FGameMainForm.Handle);
+end;
+
+Procedure TfrmMain.CloseMainWindows();
+begin
+ FreeAndNil(FGameMainForm);
+end;
+
procedure TfrmMain.MIAddClick(Sender: TObject);
var
form:TfrmGameEditor;
@@ -475,7 +530,7 @@ begin
cfg.hOutput:=FAddHandle;
cfg.hError :=FAddHandle;
- cfg.fork_proc:=True;
+ cfg.fork_proc:=False;
FGameProcess:=run_item(cfg,Item);
@@ -516,6 +571,8 @@ begin
SetButtonsState(mbsStopped);
FreeAndNil(FGameProcess);
//
+ CloseMainWindows;
+ //
Pages.ActivePage:=TabList;
end;
end;
diff --git a/sys/dev/dev_dce.pas b/sys/dev/dev_dce.pas
index 2e9299c1..d6c4be3f 100644
--- a/sys/dev/dev_dce.pas
+++ b/sys/dev/dev_dce.pas
@@ -18,7 +18,7 @@ uses
procedure dce_initialize();
var
- dce_interface:TAbstractDisplay=TDisplayInterface;
+ dce_interface:TAbstractDisplay=TDisplayHandle;
dce_handle:TDisplayHandle;
@@ -27,6 +27,7 @@ var
dce_page:Pointer;
knlist_lock_flip:mtx;
+
g_video_out_event_flip:t_knlist;
implementation
@@ -58,6 +59,7 @@ begin
end;
var
+ callout_lock :mtx;
callout_vblank:t_callout;
callout_refs :Int64=0;
@@ -65,9 +67,11 @@ procedure vblank_expire(arg:Pointer);
begin
if (callout_refs<>0) then
begin
- knote_eventid(EVENTID_VBLANK, 0, 1); //SCE_VIDEO_OUT_EVENT_VBLANK
+ knote_eventid(EVENTID_PREVBLANK, 0, 0); //SCE_VIDEO_OUT_EVENT_PRE_VBLANK_START
//
callout_reset(@callout_vblank, callout_vblank.c_time, @vblank_expire, nil);
+ //
+ knote_eventid(EVENTID_VBLANK, 0, 0); //SCE_VIDEO_OUT_EVENT_VBLANK
end;
end;
@@ -106,10 +110,12 @@ type
paneWidth :DWORD;
paneHeight :DWORD;
refreshHz :DWORD; //Single
- screenSizeInInch:DWORD;
+ screenSizeInInch:DWORD; //Single
padding:array[0..19] of Byte;
end;
+ t_scaler_info=array[0..63] of Byte;
+
//SCE_VIDEO_OUT_REFRESH_RATE_UNKNOWN = 0,
//SCE_VIDEO_OUT_REFRESH_RATE_23_98HZ = 1,
//SCE_VIDEO_OUT_REFRESH_RATE_50HZ = 2,
@@ -157,9 +163,6 @@ type
f_0x40 :QWORD;
end;
-var
- flipArg:QWORD=0;
-
type
p_cursor_enable=^t_cursor_enable;
t_cursor_enable=packed record
@@ -309,6 +312,7 @@ var
case byte of
0:(r_status:t_resolution_status);
1:(f_status:t_flip_status);
+ 2:(i_scaler:t_scaler_info);
end;
begin
Result:=0;
@@ -338,7 +342,17 @@ begin
if (dce_handle=nil) then
begin
- dce_handle:=dce_interface.Open;
+ dce_handle:=dce_interface.Create;
+
+ if (dce_handle=nil) then
+ begin
+ Result:=EBUSY;
+ end else
+ begin
+ dce_handle.event_flip:=@g_video_out_event_flip;
+ Result:=dce_handle.Open();
+ end;
+
end else
begin
Result:=EBUSY;
@@ -499,15 +513,6 @@ begin
end;
u.f_status:=Default(t_flip_status);
- u.f_status.flipArg :=flipArg;
- u.f_status.count :=0;
- u.f_status.processTime :=0;
- u.f_status.tsc :=0;
- u.f_status.currentBuffer :=0;
- u.f_status.flipPendingNum0:=0;
- u.f_status.gcQueueNum :=0;
- u.f_status.flipPendingNum1:=0;
- u.f_status.submitTsc :=0;
mtx_lock(dce_mtx);
@@ -544,13 +549,14 @@ begin
if (data^.arg2<>$a5a5) then Exit(EINVAL);
ptr:=Pointer(data^.arg3);
+ len:=QWORD (data^.arg4);
- len:=0;
+ u.i_scaler:=Default(t_scaler_info);
- Writeln('dce_flip_control(',data^.id,'):get_data?');
- print_backtrace_td(stderr);
+ //Writeln('dce_flip_control(',data^.id,'):get_data?');
+ //print_backtrace_td(stderr);
- Result:=copyout(@len,ptr,8);
+ Result:=copyout(@u.i_scaler,ptr,len);
Exit;
end;
@@ -569,20 +575,9 @@ begin
if (data^.arg2<>$a5a5) then Exit(EINVAL);
ptr:=Pointer(data^.arg3);
-
- len:=Integer(data^.arg4);
- if (len>SizeOf(t_resolution_status)) then
- begin
- len:=SizeOf(t_resolution_status);
- end;
+ len:=QWORD (data^.arg4);
u.r_status:=Default(t_resolution_status);
- u.r_status.width :=1920;
- u.r_status.heigth :=1080;
- u.r_status.paneWidth :=1920;
- u.r_status.paneHeight :=1080;
- u.r_status.refreshHz :=$426fc28f;
- u.r_status.screenSizeInInch:=32;
mtx_lock(dce_mtx);
@@ -806,10 +801,6 @@ begin
'0x',HexStr(data^.flipArg,16),' ',
'0x',HexStr(data^.eop_val));
- knote_eventid(EVENTID_FLIP, data^.flipArg, 0); //SCE_VIDEO_OUT_EVENT_FLIP
-
- flipArg:=data^.flipArg;
-
if (data^.eop_nz=1) then
begin
Result:=copyout(@submit_eop,data^.eop_val,SizeOf(QWORD));
@@ -1070,7 +1061,8 @@ begin
knlist_init_mtx(@g_video_out_event_flip,@knlist_lock_flip);
- callout_init_mtx(@callout_vblank,knlist_lock_flip,0);
+ mtx_init(callout_lock,'vblank_lock');
+ callout_init_mtx(@callout_vblank,callout_lock,0);
kqueue_add_filteropts(EVFILT_DISPLAY,@filterops_display);
diff --git a/sys/dev/display_interface.pas b/sys/dev/display_interface.pas
index 72a4d91f..41b90479 100644
--- a/sys/dev/display_interface.pas
+++ b/sys/dev/display_interface.pas
@@ -4,6 +4,17 @@ unit display_interface;
interface
+uses
+ sys_event,
+ md_time;
+
+const
+ EVENTID_FLIP =$0006;
+ EVENTID_VBLANK =$0007;
+ EVENTID_SETMODE =$0051;
+ EVENTID_POSITION =$0058;
+ EVENTID_PREVBLANK=$0059;
+
type
p_flip_status=^t_flip_status;
t_flip_status=packed record
@@ -26,7 +37,7 @@ type
paneWidth :DWORD;
paneHeight :DWORD;
refreshHz :DWORD; //Single
- screenSizeInInch:DWORD;
+ screenSizeInInch:DWORD; //Single
end;
p_register_buffer_attr=^t_register_buffer_attr;
@@ -58,39 +69,56 @@ type
end;
TDisplayHandle=class
- function GetFlipStatus (status:p_flip_status):Integer; virtual;
- function GetResolutionStatus (status:p_resolution_status):Integer; virtual;
- function SetFlipRate (rate:Integer):Integer; virtual;
- function RegisterBufferAttribute(attrid:Byte;attr:p_register_buffer_attr):Integer; virtual;
- function SubmitBufferAttribute (attrid:Byte;attr:p_register_buffer_attr):Integer; virtual;
- function RegisterBuffer (buf:p_register_buffer):Integer; virtual;
- function UnregisterBuffer (index:Integer):Integer; virtual;
- function SubmitFlip (submit:p_submit_flip):Integer; virtual;
- function SubmitFlipEop (submit:p_submit_flip;submit_id:QWORD):Integer; virtual;
+ event_flip:p_knlist;
+ last_status:t_flip_status;
+ procedure knote_eventid (event_id:WORD;flipArg:QWORD);
+ function Open ():Integer; virtual;
+ function GetFlipStatus (status:p_flip_status):Integer; virtual;
+ function GetResolutionStatus (status:p_resolution_status):Integer; virtual;
+ function SetFlipRate (rate:Integer):Integer; virtual;
+ function RegisterBufferAttribute(attrid:Byte;attr:p_register_buffer_attr):Integer; virtual;
+ function SubmitBufferAttribute (attrid:Byte;attr:p_register_buffer_attr):Integer; virtual;
+ function RegisterBuffer (buf:p_register_buffer):Integer; virtual;
+ function UnregisterBuffer (index:Integer):Integer; virtual;
+ function SubmitFlip (submit:p_submit_flip):Integer; virtual;
+ function SubmitFlipEop (submit:p_submit_flip;submit_id:QWORD):Integer; virtual;
end;
- TDisplayInterface=class
- class Function Open:TDisplayHandle; virtual;
- end;
-
- TAbstractDisplay=class of TDisplayInterface;
+ TAbstractDisplay=class of TDisplayHandle;
implementation
-class Function TDisplayInterface.Open:TDisplayHandle;
+//
+
+procedure TDisplayHandle.knote_eventid(event_id:WORD;flipArg:QWORD);
begin
- Result:=TDisplayHandle.Create;
+ knote(event_flip, event_id or (flipArg shl 16), 0);
end;
-//
+function TDisplayHandle.Open():Integer;
+begin
+ last_status.currentBuffer:=DWORD(-1);
+ last_status.flipArg :=QWORD(-1);
+
+ Result:=0;
+end;
function TDisplayHandle.GetFlipStatus(status:p_flip_status):Integer;
begin
+ status^:=last_status;
+
Result:=0;
end;
function TDisplayHandle.GetResolutionStatus(status:p_resolution_status):Integer;
begin
+ status^.width :=1920;
+ status^.heigth :=1080;
+ status^.paneWidth :=1920;
+ status^.paneHeight :=1080;
+ status^.refreshHz :=$426fc28f; //( 59.94)
+ status^.screenSizeInInch:=$42500000; //( 52.00)
+ //
Result:=0;
end;
@@ -121,11 +149,34 @@ end;
function TDisplayHandle.SubmitFlip(submit:p_submit_flip):Integer;
begin
+ last_status.flipArg :=submit^.flipArg;
+ last_status.flipArg2 :=submit^.flipArg2;
+ last_status.count :=last_status.count+1;
+ last_status.submitTsc :=rdtsc;
+ last_status.currentBuffer:=submit^.bufferIndex;
+
+ knote_eventid(EVENTID_FLIP, submit^.flipArg);
+
+ last_status.tsc :=rdtsc;
+ last_status.processTime:=last_status.tsc;
+
Result:=0;
end;
+
function TDisplayHandle.SubmitFlipEop(submit:p_submit_flip;submit_id:QWORD):Integer;
begin
+ last_status.flipArg :=submit^.flipArg;
+ last_status.flipArg2 :=submit^.flipArg2;
+ last_status.count :=last_status.count+1;
+ last_status.submitTsc :=rdtsc;
+ last_status.currentBuffer:=submit^.bufferIndex;
+
+ knote_eventid(EVENTID_FLIP, submit^.flipArg);
+
+ last_status.tsc :=rdtsc;
+ last_status.processTime:=last_status.tsc;
+
Result:=0;
end;
diff --git a/sys/dev/display_soft.pas b/sys/dev/display_soft.pas
new file mode 100644
index 00000000..38ebe9b4
--- /dev/null
+++ b/sys/dev/display_soft.pas
@@ -0,0 +1,132 @@
+unit display_soft;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+ display_interface,
+ md_time;
+
+type
+ p_buffer=^t_buffer;
+ t_buffer=packed record
+ attr :t_register_buffer_attr;
+ left :Pointer; //buffer ptr
+ right:Pointer; //Stereo ptr
+ end;
+
+ TDisplayHandleSoft=class(TDisplayHandle)
+
+ hWindow:THandle;
+
+ m_attr:array[0..3 ] of t_register_buffer_attr;
+ m_bufs:array[0..15] of t_buffer;
+
+ function Open ():Integer; override;
+ //function GetFlipStatus (status:p_flip_status):Integer; virtual;
+ //function GetResolutionStatus (status:p_resolution_status):Integer; virtual;
+ //function SetFlipRate (rate:Integer):Integer; virtual;
+ function RegisterBufferAttribute(attrid:Byte;attr:p_register_buffer_attr):Integer; override;
+ //function SubmitBufferAttribute (attrid:Byte;attr:p_register_buffer_attr):Integer; virtual;
+ function RegisterBuffer (buf:p_register_buffer):Integer; override;
+ //function UnregisterBuffer (index:Integer):Integer; virtual;
+ function SubmitFlip (submit:p_submit_flip):Integer; override;
+ //function SubmitFlipEop (submit:p_submit_flip;submit_id:QWORD):Integer; virtual;
+ end;
+
+implementation
+
+uses
+ windows,
+ kern_proc,
+ kern_thr;
+
+function TDisplayHandleSoft.Open():Integer;
+begin
+ Result:=inherited;
+
+ Writeln('OpenMainWindows->');
+
+ hWindow:=p_proc.p_host_ipc.OpenMainWindows();
+
+ Writeln('OpenMainWindows:',hWindow);
+
+ SetWindowTextA(hWindow,'OpenMainWindows');
+end;
+
+function TDisplayHandleSoft.RegisterBufferAttribute(attrid:Byte;attr:p_register_buffer_attr):Integer;
+begin
+ m_attr[attrid]:=attr^;
+
+ Result:=0;
+end;
+
+function TDisplayHandleSoft.RegisterBuffer(buf:p_register_buffer):Integer;
+var
+ i:Integer;
+begin
+ i:=buf^.index;
+
+ m_bufs[i].attr :=m_attr[buf^.attrid];
+ m_bufs[i].left :=buf^.left;
+ m_bufs[i].right:=buf^.right;
+
+ Result:=0;
+end;
+
+procedure SoftFlip(hWindow:THandle;buf:p_buffer);
+var
+ hdc:THandle;
+ bi:BITMAPINFO;
+
+begin
+ hdc:=GetDC(hWindow);
+
+ bi:=Default(BITMAPINFO);
+
+ bi.bmiHeader.biSize :=sizeof(bi.bmiHeader);
+ bi.bmiHeader.biWidth :=buf^.attr.width;
+ bi.bmiHeader.biHeight :=buf^.attr.height;
+ bi.bmiHeader.biPlanes :=1;
+ bi.bmiHeader.biBitCount :=32;
+ bi.bmiHeader.biCompression:=BI_RGB;
+
+ SetDIBitsToDevice(hdc,
+ 0, 0,
+ buf^.attr.width, buf^.attr.height,
+ 0, 0,
+ 0, buf^.attr.height,
+ buf^.left, bi, DIB_RGB_COLORS);
+
+ ReleaseDC(hWindow, hdc);
+end;
+
+function TDisplayHandleSoft.SubmitFlip(submit:p_submit_flip):Integer;
+var
+ buf:p_buffer;
+begin
+ last_status.flipArg :=submit^.flipArg;
+ last_status.flipArg2 :=submit^.flipArg2;
+ last_status.count :=last_status.count+1;
+ last_status.submitTsc :=rdtsc;
+ last_status.currentBuffer:=submit^.bufferIndex;
+
+ buf:=@m_bufs[submit^.bufferIndex];
+
+ SoftFlip(hWindow,buf);
+
+ knote_eventid(EVENTID_FLIP, submit^.flipArg);
+
+ last_status.tsc :=rdtsc;
+ last_status.processTime:=last_status.tsc;
+
+ Result:=0;
+end;
+
+
+end.
+
+
+
+
diff --git a/sys/host_ipc.pas b/sys/host_ipc.pas
index 28f81fa8..c034b6cb 100644
--- a/sys/host_ipc.pas
+++ b/sys/host_ipc.pas
@@ -19,7 +19,8 @@ type
iRESULT,
iKEV_CHANGE,
iKEV_EVENT,
- iMOUNT
+ iMOUNT,
+ iMAIN_WINDOWS
);
PNodeHeader=^TNodeHeader;
@@ -69,6 +70,7 @@ type
public
//
procedure kevent(kev:p_kevent;count:Integer);
+ function OpenMainWindows():THandle;
//
function SendSync(mtype:t_mtype;mlen:DWORD;buf:Pointer):Ptruint;
procedure SendAsyn(mtype:t_mtype;mlen:DWORD;buf:Pointer);
@@ -198,8 +200,6 @@ begin
kev :=@node^.buf;
count:=node^.header.mlen div SizeOf(t_kevent);
- Writeln('RecvKevent ',kev^.ident,' ',count);
-
if (Fkq=nil) then
begin
Fkq:=kern_kqueue2('[ipc]',@kq_wakeup,Pointer(Self));
@@ -291,6 +291,11 @@ begin
SendAsyn(iKEV_CHANGE,count*SizeOf(t_kevent),kev);
end;
+function THostIpcConnect.OpenMainWindows():THandle;
+begin
+ Result:=THandle(SendSync(iMAIN_WINDOWS,0,nil));
+end;
+
//
function THostIpcConnect.NewNodeSync:PNodeIpcSync;
diff --git a/sys/md/md_host_ipc.pas b/sys/md/md_host_ipc.pas
index 27d15caf..10c0ccf7 100644
--- a/sys/md/md_host_ipc.pas
+++ b/sys/md/md_host_ipc.pas
@@ -74,6 +74,8 @@ begin
end;
procedure t_ipc_proto.Recv;
+label
+ _next;
var
node:PQNode;
begin
@@ -87,11 +89,15 @@ begin
evbuffer_remove(Finput,@FHeader,SizeOf(TNodeHeader));
FState:=1;
+
+ if (FHeader.mlen=0) then goto _next;
end;
1:
begin
if (evbuffer_get_length(Finput)