Skip to content

P
puzzle-editor
Commit 4021fc87 authored by rarnu's avatar rarnu
Browse files
Options

add: 更新图标，修复读取MDPro3安装信息的方式，增加调用MDPro3进行测试

parent cbe6afdb
Expand all Hide whitespace changes
Inline Side-by-side
Showing with 559 additions and 314 deletions
PuzzleEditor.lpi
View file @ 4021fc87
...@@ -211,6 +211,9 @@ ...@@ -211,6 +211,9 @@
<Item> <Item>
<Name Value="RunError(103)"/> <Name Value="RunError(103)"/>
</Item> </Item>
<Item>
<Name Value="ESocketError"/>
</Item>
</Exceptions> </Exceptions>
</Debugging> </Debugging>
</CONFIG> </CONFIG>
PuzzleEditor.lpr
View file @ 4021fc87
...@@ -11,18 +11,16 @@ uses ...@@ -11,18 +11,16 @@ uses
{$ENDIF} {$ENDIF}
Interfaces, // this includes the LCL widgetset Interfaces, // this includes the LCL widgetset
SysUtils, SysUtils,
Forms, Dialogs, opensslsockets, untData, frmHome; Forms, Dialogs, opensslsockets, untData, frmHome, untConfig;
{$R *.res} {$R *.res}
var var
AMDPro3Path: string; AMDPro3Path: string;
ADataPath: string;
begin begin
AMDPro3Path:= ExtractFilePath(ParamStr(0)) + 'MDPro3.exe'; AMDPro3Path:= TConfigReader.GetMDPro3InstallPath();
ADataPath:= ExtractFilePath(ParamStr(0)) + 'Data'; if (AMDPro3Path = '') or (not DirectoryExists(AMDPro3Path)) then begin
if (not FileExists(AMDPro3Path)) or (not DirectoryExists(ADataPath)) then begin MessageDlg('提示', '没有安装 MDPro3，请先进行安装', mtError, [mbOK], 0);
ShowMessage('请将残局编辑器放置到 MDPro3 的安装目录下');
Exit; Exit;
end; end;
......
frmhome.lfm
View file @ 4021fc87
This diff is collapsed.
frmhome.pas
View file @ 4021fc87
...@@ -5,8 +5,8 @@ unit frmHome; ...@@ -5,8 +5,8 @@ unit frmHome;
interface interface
uses uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, orca_scene2d, fgl, untData, untConstant, untCard, untUtils, Windows, Classes, SysUtils, Forms, Controls, Graphics, Dialogs, orca_scene2d, fgl, untData, untConstant, untCard, untUtils,
untAPI; untAPI, ShellApi;
type type
...@@ -209,7 +209,7 @@ type ...@@ -209,7 +209,7 @@ type
btnOpen: TD2ToolButton; btnOpen: TD2ToolButton;
btnSave: TD2ToolButton; btnSave: TD2ToolButton;
btnConfig: TD2ToolButton; btnConfig: TD2ToolButton;
btnExport: TD2ToolButton; btnDebug: TD2ToolButton;
txtOwner: TD2Text; txtOwner: TD2Text;
procedure btnAboutClick(Sender: TObject); procedure btnAboutClick(Sender: TObject);
procedure btnAddCardClick(Sender: TObject); procedure btnAddCardClick(Sender: TObject);
...@@ -218,7 +218,7 @@ type ...@@ -218,7 +218,7 @@ type
procedure btnConfigClick(Sender: TObject); procedure btnConfigClick(Sender: TObject);
procedure btnDelCardClick(Sender: TObject); procedure btnDelCardClick(Sender: TObject);
procedure btnEditCardListClick(Sender: TObject); procedure btnEditCardListClick(Sender: TObject);
procedure btnExportClick(Sender: TObject); procedure btnDebugClick(Sender: TObject);
procedure btnNewClick(Sender: TObject); procedure btnNewClick(Sender: TObject);
procedure btnOpenClick(Sender: TObject); procedure btnOpenClick(Sender: TObject);
procedure btnSaveClick(Sender: TObject); procedure btnSaveClick(Sender: TObject);
...@@ -1031,8 +1031,39 @@ begin ...@@ -1031,8 +1031,39 @@ begin
end; end;
procedure TFormHome.UploadPuzzle(); procedure TFormHome.UploadPuzzle();
var
APuzzleCode: string;
AP: TEntityPuzzle;
ARet: TSavePuzzleResult;
begin begin
// TODO: upload puzzle // upload puzzle
if FPuzzle = nil then Exit;
if FUserInfo = nil then Exit;
if FUserInfo.id = 0 then Exit;
if FUserToken = '' then Exit;
btnUpload.Enabled:= False;
APuzzleCode:= TScriptGenerator.Generate(FPuzzle);
AP := TEntityPuzzle.Create;
AP.id:= FPuzzle.PuzzleId;
AP.name:= FPuzzle.PuzzleName;
AP.userId:= FUserInfo.id;
AP.contributor:= FUserInfo.username;
AP.message:= FPuzzle.Message;
AP.solution:= FPuzzle.Solution;
AP.coverCard:= GetFirstCardFromScriptCode(APuzzleCode);
AP.luaScript:= APuzzleCode;
ARet := TAPI.SavePuzzle(AP, FUserInfo.id, FUserToken);
if ARet <> nil then begin
FPuzzle.PuzzleId:= Aret.data;
SavePuzzle();
ARet.Free;
MessageDlg('提示', '上传残局成功', mtConfirmation, [mbOK], 0);
end else begin
MessageDlg('提示', '上传残局失败', mtError, [mbOK], 0);
end;
btnUpload.Enabled:= True;
end; end;
procedure TFormHome.btnNewClick(Sender: TObject); procedure TFormHome.btnNewClick(Sender: TObject);
...@@ -1046,12 +1077,14 @@ procedure TFormHome.btnConfigClick(Sender: TObject); ...@@ -1046,12 +1077,14 @@ procedure TFormHome.btnConfigClick(Sender: TObject);
begin begin
// config // config
with TFormPuzzleConfig.Create(Self) do begin with TFormPuzzleConfig.Create(Self) do begin
PPuzzleName:= FPuzzle.PuzzleName;
PAIName:= FPuzzle.AIName; PAIName:= FPuzzle.AIName;
P0LP:= FPuzzle.LPSelf; P0LP:= FPuzzle.LPSelf;
P1LP:= FPuzzle.LPOpponent; P1LP:= FPuzzle.LPOpponent;
PMessage:= FPuzzle.Message; PMessage:= FPuzzle.Message;
PSolution:= FPuzzle.Solution; PSolution:= FPuzzle.Solution;
if ShowModal = mrOK then begin if ShowModal = mrOK then begin
FPuzzle.PuzzleName:= PPuzzleName;
FPuzzle.AIName:= PAIName; FPuzzle.AIName:= PAIName;
FPuzzle.LPSelf:= P0LP; FPuzzle.LPSelf:= P0LP;
FPuzzle.LPOpponent:= P1LP; FPuzzle.LPOpponent:= P1LP;
...@@ -1267,8 +1300,6 @@ begin ...@@ -1267,8 +1300,6 @@ begin
FillCardIds(cardIds); FillCardIds(cardIds);
if ShowModal = mrOK then begin if ShowModal = mrOK then begin
// CardList; // CardList;
ShowMessage(Format('Changed %d', [CardList.Count]));
case FFieldInfo.Owner of case FFieldInfo.Owner of
foSelf: foSelf:
begin begin
...@@ -1339,23 +1370,29 @@ begin ...@@ -1339,23 +1370,29 @@ begin
cardIds.Free; cardIds.Free;
end; end;
procedure TFormHome.btnExportClick(Sender: TObject); procedure TFormHome.btnDebugClick(Sender: TObject);
const
DEBUG_NAME = '._debug_';
var var
ADir: string;
ALuaFileName: string; ALuaFileName: string;
ACode: string; ACode: string;
AMDPro3Path: string;
begin begin
SavePuzzle(); SavePuzzle();
if (FFilePath <> '') then begin if (FFilePath = '') then Exit;
// export ADir:= TConfigReader.GetMDPro3InstallPath();
ALuaFileName := ChangeFileExt(FFilePath, '.lua'); ALuaFileName:= ADir + DirectorySeparator + 'Puzzle' + DirectorySeparator + DEBUG_NAME + '.lua';
ACode := TScriptGenerator.Generate(FPuzzle); ACode:= TScriptGenerator.Generate(FPuzzle);
with TStringList.Create do begin with TStringList.Create do begin
Text:= ACode; Text:= ACode;
SaveToFile(ALuaFileName); SaveToFile(ALuaFileName);
Free; Free;
end;
ShowMessage('导出残局脚本完成!');
end; end;
// debug
AMDPro3Path:= ADir + DirectorySeparator + 'MDPro3.exe';
ShellExecute(0, 'open', PChar(AMDPro3Path), PChar(Format('-s %s', [DEBUG_NAME])), PChar(ADir), SW_SHOWNORMAL);
end; end;
procedure TFormHome.btnOpenClick(Sender: TObject); procedure TFormHome.btnOpenClick(Sender: TObject);
......
frmpuzzleconfig.lfm
View file @ 4021fc87
...@@ -26,7 +26,7 @@ object FormPuzzleConfig: TFormPuzzleConfig ...@@ -26,7 +26,7 @@ object FormPuzzleConfig: TFormPuzzleConfig
HitTest = False HitTest = False
object Layout1: TD2Layout object Layout1: TD2Layout
Align = vaTop Align = vaTop
Position.Point = '(8,58)' Position.Point = '(8,108)'
Width = 584 Width = 584
Height = 50 Height = 50
object Label1: TD2Label object Label1: TD2Label
...@@ -62,7 +62,7 @@ object FormPuzzleConfig: TFormPuzzleConfig ...@@ -62,7 +62,7 @@ object FormPuzzleConfig: TFormPuzzleConfig
end end
object Layout2: TD2Layout object Layout2: TD2Layout
Align = vaTop Align = vaTop
Position.Point = '(8,108)' Position.Point = '(8,158)'
Width = 584 Width = 584
Height = 50 Height = 50
object Label2: TD2Label object Label2: TD2Label
...@@ -98,9 +98,9 @@ object FormPuzzleConfig: TFormPuzzleConfig ...@@ -98,9 +98,9 @@ object FormPuzzleConfig: TFormPuzzleConfig
end end
object Layout3: TD2Layout object Layout3: TD2Layout
Align = vaTop Align = vaTop
Position.Point = '(8,158)' Position.Point = '(8,208)'
Width = 584 Width = 584
Height = 300 Height = 265
object Label3: TD2Label object Label3: TD2Label
Align = vaTop Align = vaTop
Position.Point = '(8,0)' Position.Point = '(8,0)'
...@@ -119,7 +119,7 @@ object FormPuzzleConfig: TFormPuzzleConfig ...@@ -119,7 +119,7 @@ object FormPuzzleConfig: TFormPuzzleConfig
Align = vaClient Align = vaClient
Position.Point = '(8,50)' Position.Point = '(8,50)'
Width = 568 Width = 568
Height = 242 Height = 207
Padding.Rect = '(8,0,8,8)' Padding.Rect = '(8,0,8,8)'
TabOrder = 1 TabOrder = 1
UseSmallScrollBars = True UseSmallScrollBars = True
...@@ -130,9 +130,9 @@ object FormPuzzleConfig: TFormPuzzleConfig ...@@ -130,9 +130,9 @@ object FormPuzzleConfig: TFormPuzzleConfig
end end
object Layout4: TD2Layout object Layout4: TD2Layout
Align = vaClient Align = vaClient
Position.Point = '(8,458)' Position.Point = '(8,473)'
Width = 584 Width = 584
Height = 284 Height = 269
object Label4: TD2Label object Label4: TD2Label
Align = vaTop Align = vaTop
Position.Point = '(8,0)' Position.Point = '(8,0)'
...@@ -151,7 +151,7 @@ object FormPuzzleConfig: TFormPuzzleConfig ...@@ -151,7 +151,7 @@ object FormPuzzleConfig: TFormPuzzleConfig
Align = vaClient Align = vaClient
Position.Point = '(8,50)' Position.Point = '(8,50)'
Width = 568 Width = 568
Height = 226 Height = 211
Padding.Rect = '(8,0,8,8)' Padding.Rect = '(8,0,8,8)'
TabOrder = 1 TabOrder = 1
UseSmallScrollBars = True UseSmallScrollBars = True
...@@ -204,7 +204,7 @@ object FormPuzzleConfig: TFormPuzzleConfig ...@@ -204,7 +204,7 @@ object FormPuzzleConfig: TFormPuzzleConfig
end end
object Layout6: TD2Layout object Layout6: TD2Layout
Align = vaTop Align = vaTop
Position.Point = '(8,8)' Position.Point = '(8,58)'
Width = 584 Width = 584
Height = 50 Height = 50
object Label5: TD2Label object Label5: TD2Label
...@@ -222,6 +222,39 @@ object FormPuzzleConfig: TFormPuzzleConfig ...@@ -222,6 +222,39 @@ object FormPuzzleConfig: TFormPuzzleConfig
Text = 'AI 名称' Text = 'AI 名称'
end end
object edtAIName: TD2TextBox object edtAIName: TD2TextBox
Align = vaClient
Position.Point = '(136,8)'
Width = 440
Height = 34
Padding.Rect = '(8,8,8,8)'
TabOrder = 1
Font.Family = 'Microsoft Yahei'
Font.Size = 18
ReadOnly = False
Password = False
Text = '我的AI'
end
end
object Layout7: TD2Layout
Align = vaTop
Position.Point = '(8,8)'
Width = 584
Height = 50
object Label6: TD2Label
Align = vaLeft
Position.Point = '(8,0)'
Width = 120
Height = 50
Padding.Rect = '(8,0,0,0)'
TabOrder = 0
Font.Family = 'Microsoft yahei'
Font.Size = 18
Font.Style = d2FontBold
TextAlign = d2TextAlignNear
VertTextAlign = d2TextAlignCenter
Text = '残局名称'
end
object edtPuzzleName: TD2TextBox
Align = vaClient Align = vaClient
Position.Point = '(136,8)' Position.Point = '(136,8)'
Width = 440 Width = 440
...@@ -1859,7 +1892,7 @@ object FormPuzzleConfig: TFormPuzzleConfig ...@@ -1859,7 +1892,7 @@ object FormPuzzleConfig: TFormPuzzleConfig
000000000000F005400648656967687405000000000000008803400C50616464 000000000000F005400648656967687405000000000000008803400C50616464
696E672E52656374060928302C322C302C32290C436C69704368696C6472656E 696E672E52656374060928302C322C302C32290C436C69704368696C6472656E
09000C54443252656374616E676C650005416C69676E070C7661486F72697A6F 09000C54443252656374616E676C650005416C69676E070C7661486F72697A6F
6E74616C0E506F736974696F6E2E506F696E74060628312C383429064C6F636B 6E74616C0E506F736974696F6E2E506F696E74060628312C383629064C6F636B
6564090557696474680500000000000000EC0540064865696768740500000000 6564090557696474680500000000000000EC0540064865696768740500000000
000000E404400C50616464696E672E52656374060928312C312C312C31290748 000000E404400C50616464696E672E52656374060928312C312C312C31290748
697454657374080A46696C6C2E5374796C65070F643242727573684772616469 697454657374080A46696C6C2E5374796C65070F643242727573684772616469
......
frmpuzzleconfig.pas
View file @ 4021fc87
...@@ -20,6 +20,7 @@ type ...@@ -20,6 +20,7 @@ type
Label3: TD2Label; Label3: TD2Label;
Label4: TD2Label; Label4: TD2Label;
Label5: TD2Label; Label5: TD2Label;
Label6: TD2Label;
Layout1: TD2Layout; Layout1: TD2Layout;
Layout2: TD2Layout; Layout2: TD2Layout;
Layout3: TD2Layout; Layout3: TD2Layout;
...@@ -28,26 +29,31 @@ type ...@@ -28,26 +29,31 @@ type
edtSelfLP: TD2NumberBox; edtSelfLP: TD2NumberBox;
edtOpponentLP: TD2NumberBox; edtOpponentLP: TD2NumberBox;
Layout6: TD2Layout; Layout6: TD2Layout;
Layout7: TD2Layout;
mmMessage: TD2Memo; mmMessage: TD2Memo;
mmSolution: TD2Memo; mmSolution: TD2Memo;
Root: TD2Background; Root: TD2Background;
Scene: TD2Scene; Scene: TD2Scene;
edtAIName: TD2TextBox; edtAIName: TD2TextBox;
edtPuzzleName: TD2TextBox;
private private
function GetAIName: string; function GetAIName: string;
function GetP0LP: Integer; function GetP0LP: Integer;
function GetP1LP: Integer; function GetP1LP: Integer;
function GetPMessage: string; function GetPMessage: string;
function GetPPuzzleName: string;
function GetPSolution: string; function GetPSolution: string;
procedure SetAIName(AValue: string); procedure SetAIName(AValue: string);
procedure SetP0LP(AValue: Integer); procedure SetP0LP(AValue: Integer);
procedure SetP1LP(AValue: Integer); procedure SetP1LP(AValue: Integer);
procedure SetPMessage(AValue: string); procedure SetPMessage(AValue: string);
procedure SetPPuzzleName(AValue: string);
procedure SetPSolution(AValue: string); procedure SetPSolution(AValue: string);
public public
published published
property PPuzzleName: string read GetPPuzzleName write SetPPuzzleName;
property PAIName: string read GetAIName write SetAIName; property PAIName: string read GetAIName write SetAIName;
property P0LP: Integer read GetP0LP write SetP0LP; property P0LP: Integer read GetP0LP write SetP0LP;
property P1LP: Integer read GetP1LP write SetP1LP; property P1LP: Integer read GetP1LP write SetP1LP;
...@@ -84,6 +90,11 @@ begin ...@@ -84,6 +90,11 @@ begin
Exit(mmMessage.Lines.Text); Exit(mmMessage.Lines.Text);
end; end;
function TFormPuzzleConfig.GetPPuzzleName: string;
begin
Exit(edtPuzzleName.Text);
end;
function TFormPuzzleConfig.GetPSolution: string; function TFormPuzzleConfig.GetPSolution: string;
begin begin
Exit(mmSolution.Lines.Text); Exit(mmSolution.Lines.Text);
...@@ -109,6 +120,11 @@ begin ...@@ -109,6 +120,11 @@ begin
mmMessage.Lines.Text:= AValue; mmMessage.Lines.Text:= AValue;
end; end;
procedure TFormPuzzleConfig.SetPPuzzleName(AValue: string);
begin
edtPuzzleName.Text:= AValue;
end;
procedure TFormPuzzleConfig.SetPSolution(AValue: string); procedure TFormPuzzleConfig.SetPSolution(AValue: string);
begin begin
mmSolution.Lines.Text:= AValue; mmSolution.Lines.Text:= AValue;
......
frmsearchcard.lfm
View file @ 4021fc87
...@@ -52,7 +52,6 @@ object FormSearchCard: TFormSearchCard ...@@ -52,7 +52,6 @@ object FormSearchCard: TFormSearchCard
Font.Size = 18 Font.Size = 18
ReadOnly = False ReadOnly = False
Password = False Password = False
Text = '百夫'
end end
object btnSearchCard: TD2CornerButton object btnSearchCard: TD2CornerButton
Align = vaLeft Align = vaLeft
...@@ -1751,7 +1750,7 @@ object FormSearchCard: TFormSearchCard ...@@ -1751,7 +1750,7 @@ object FormSearchCard: TFormSearchCard
000000000000F005400648656967687405000000000000008803400C50616464 000000000000F005400648656967687405000000000000008803400C50616464
696E672E52656374060928302C322C302C32290C436C69704368696C6472656E 696E672E52656374060928302C322C302C32290C436C69704368696C6472656E
09000C54443252656374616E676C650005416C69676E070C7661486F72697A6F 09000C54443252656374616E676C650005416C69676E070C7661486F72697A6F
6E74616C0E506F736974696F6E2E506F696E74060628312C383229064C6F636B 6E74616C0E506F736974696F6E2E506F696E74060628312C383429064C6F636B
6564090557696474680500000000000000EC0540064865696768740500000000 6564090557696474680500000000000000EC0540064865696768740500000000
000000E404400C50616464696E672E52656374060928312C312C312C31290748 000000E404400C50616464696E672E52656374060928312C312C312C31290748
697454657374080A46696C6C2E5374796C65070F643242727573684772616469 697454657374080A46696C6C2E5374796C65070F643242727573684772616469
......
images/menu_about.png
View replaced file @ cbe6afdb View file @ 4021fc87
images/menu_about.png

1.29 KB | W: | H:

images/menu_about.png

10.2 KB | W: | H:

images/menu_about.png
images/menu_about.png
images/menu_about.png
images/menu_about.png
  • 2-up
  • Swipe
  • Onion skin
images/menu_config.png
View replaced file @ cbe6afdb View file @ 4021fc87
images/menu_config.png

1.44 KB | W: | H:

images/menu_config.png

9.91 KB | W: | H:

images/menu_config.png
images/menu_config.png
images/menu_config.png
images/menu_config.png
  • 2-up
  • Swipe
  • Onion skin
images/menu_new.png
View replaced file @ cbe6afdb View file @ 4021fc87
images/menu_new.png

829 Bytes | W: | H:

images/menu_new.png

10.8 KB | W: | H:

images/menu_new.png
images/menu_new.png
images/menu_new.png
images/menu_new.png
  • 2-up
  • Swipe
  • Onion skin
images/menu_open.png
View replaced file @ cbe6afdb View file @ 4021fc87
images/menu_open.png

1.16 KB | W: | H:

images/menu_open.png

10 KB | W: | H:

images/menu_open.png
images/menu_open.png
images/menu_open.png
images/menu_open.png
  • 2-up
  • Swipe
  • Onion skin
images/menu_save.png
View replaced file @ cbe6afdb View file @ 4021fc87
images/menu_save.png

1.18 KB | W: | H:

images/menu_save.png

9.83 KB | W: | H:

images/menu_save.png
images/menu_save.png
images/menu_save.png
images/menu_save.png
  • 2-up
  • Swipe
  • Onion skin
images/menu_upload.png
View replaced file @ cbe6afdb View file @ 4021fc87
images/menu_upload.png

449 Bytes | W: | H:

images/menu_upload.png

9.94 KB | W: | H:

images/menu_upload.png
images/menu_upload.png
images/menu_upload.png
images/menu_upload.png
  • 2-up
  • Swipe
  • Onion skin
untapi.pas
View file @ 4021fc87
...@@ -11,7 +11,7 @@ const ...@@ -11,7 +11,7 @@ const
BASE_URL = 'https://sapi.moecube.com:444'; BASE_URL = 'https://sapi.moecube.com:444';
API_ACC_SIGNIN = '/accounts/signin'; API_ACC_SIGNIN = '/accounts/signin';
API_ACC_AUTHUSER = '/accounts/authUser'; API_ACC_AUTHUSER = '/accounts/authUser';
PUZZLE_URL = 'http://rarnu.xyz:38383/api/mdpro3/puzzle'; PUZZLE_URL = 'http://rarnu.xyz:38383/api/mdpro3/puzzle/save';
type type
TCommonResult = class(TPersistent) TCommonResult = class(TPersistent)
...@@ -66,8 +66,9 @@ type ...@@ -66,8 +66,9 @@ type
{ TEntityPuzzleAdd } { TEntityPuzzleAdd }
TEntityPuzzleAdd = class(TPersistent) TEntityPuzzle = class(TPersistent)
private private
Fid: Int64;
Fcontributor: string; Fcontributor: string;
FcoverCard: Int64; FcoverCard: Int64;
FluaScript: String; FluaScript: String;
...@@ -76,6 +77,7 @@ type ...@@ -76,6 +77,7 @@ type
Fsolution: string; Fsolution: string;
FuserId: Int64; FuserId: Int64;
published published
property id: Int64 read Fid write Fid;
property name: string read Fname write Fname; property name: string read Fname write Fname;
property userId: Int64 read FuserId write FuserId; property userId: Int64 read FuserId write FuserId;
property contributor: string read Fcontributor write Fcontributor; property contributor: string read Fcontributor write Fcontributor;
...@@ -85,25 +87,25 @@ type ...@@ -85,25 +87,25 @@ type
property luaScript: String read FluaScript write FluaScript; property luaScript: String read FluaScript write FluaScript;
end; end;
{ TEntityPuzzleUpdate }
TEntityPuzzleUpdate = class(TEntityPuzzleAdd)
private
Fid: Int64;
published
property id: Int64 read Fid write Fid;
end;
type type
{ TAPI } { TAPI }
TSavePuzzleResult = class(TCommonResult)
private
Fdata: Int64;
published
property data: Int64 read Fdata write Fdata;
end;
TAPI = class TAPI = class
public public
class function MCLogin(AAccount: String; APassword: String): TMCUserWithToken; class function MCLogin(AAccount: String; APassword: String): TMCUserWithToken;
class function MCValidate(AToken: String): TMCUser; class function MCValidate(AToken: String): TMCUser;
class function AddPuzzle(AP: TEntityPuzzleAdd; AUserId: Int64; AToken: String): Boolean; // class function AddPuzzle(AP: TEntityPuzzle; AUserId: Int64; AToken: String): Boolean;
class function UpdatePuzzle(AP: TEntityPuzzleUpdate; AuserId: Int64; AToken: String): Boolean; // class function UpdatePuzzle(AP: TEntityPuzzle; AuserId: Int64; AToken: String): Boolean;
class function SavePuzzle(AP: TEntityPuzzle; AUserId: Int64; AToken: String): TSavePuzzleResult;
end; end;
implementation implementation
...@@ -175,7 +177,9 @@ begin ...@@ -175,7 +177,9 @@ begin
end; end;
end; end;
class function TAPI.AddPuzzle(AP: TEntityPuzzleAdd; AUserId: Int64; (*
class function TAPI.AddPuzzle(AP: TEntityPuzzle; AUserId: Int64;
AToken: String): Boolean; AToken: String): Boolean;
var var
AUrl: String; AUrl: String;
...@@ -190,7 +194,7 @@ begin ...@@ -190,7 +194,7 @@ begin
AHeader.Add('ReqSource', 'MDPro3'); AHeader.Add('ReqSource', 'MDPro3');
AHeader.Add('userId', AUserId.ToString()); AHeader.Add('userId', AUserId.ToString());
AHeader.Add('token', AToken); AHeader.Add('token', AToken);
AReqJson := ISCObjectToJSONString<TEntityPuzzleAdd>(AP); AReqJson := ISCObjectToJSONString<TEntityPuzzle>(AP);
ARetJson := ISCHttpPost(AUrl, AReqJson, AHeader); ARetJson := ISCHttpPost(AUrl, AReqJson, AHeader);
AHeader.Free; AHeader.Free;
AResult := ISCJSONStringToObject<TCommonResult>(ARetJson); AResult := ISCJSONStringToObject<TCommonResult>(ARetJson);
...@@ -198,7 +202,12 @@ begin ...@@ -198,7 +202,12 @@ begin
AResult.Free; AResult.Free;
end; end;
class function TAPI.UpdatePuzzle(AP: TEntityPuzzleUpdate; AuserId: Int64; *)
(*
class function TAPI.UpdatePuzzle(AP: TEntityPuzzle; AuserId: Int64;
AToken: String): Boolean; AToken: String): Boolean;
var var
AUrl: String; AUrl: String;
...@@ -213,7 +222,7 @@ begin ...@@ -213,7 +222,7 @@ begin
AHeader.Add('ReqSource', 'MDPro3'); AHeader.Add('ReqSource', 'MDPro3');
AHeader.Add('userId', AUserId.ToString()); AHeader.Add('userId', AUserId.ToString());
AHeader.Add('token', AToken); AHeader.Add('token', AToken);
AReqJson := ISCObjectToJSONString<TEntityPuzzleAdd>(AP); AReqJson := ISCObjectToJSONString<TEntityPuzzle>(AP);
ARetJson := ISCHttpPut(AUrl, AReqJson, AHeader); ARetJson := ISCHttpPut(AUrl, AReqJson, AHeader);
AHeader.Free; AHeader.Free;
AResult := ISCJSONStringToObject<TCommonResult>(ARetJson); AResult := ISCJSONStringToObject<TCommonResult>(ARetJson);
...@@ -221,5 +230,32 @@ begin ...@@ -221,5 +230,32 @@ begin
AResult.Free; AResult.Free;
end; end;
*)
class function TAPI.SavePuzzle(AP: TEntityPuzzle; AUserId: Int64; AToken: String): TSavePuzzleResult;
var
AUrl: String;
AHeader: TFPGMap<String, String>;
AReqJson: string;
ARetJson: string;
AResult: TSavePuzzleResult;
begin
AUrl := PUZZLE_URL;
AHeader := TFPGMap<String, String>.Create;
AHeader.Add('ReqSource', 'MDPro3');
AHeader.Add('userId', AUserId.ToString());
AHeader.Add('token', AToken);
AReqJson := ISCObjectToJSONString<TEntityPuzzle>(AP);
ARetJson := ISCHttpPost(AUrl, AReqJson, AHeader);
AHeader.Free;
AResult := ISCJSONStringToObject<TSavePuzzleResult>(ARetJson);
if (AResult.message = 'true') then begin
Exit(AResult);
end else begin
AResult.Free;
Exit(Nil);
end;;
end;
end. end.
untcard.pas
View file @ 4021fc87
...@@ -101,6 +101,8 @@ type ...@@ -101,6 +101,8 @@ type
FP1Grave: TFPGList<TCard>; FP1Grave: TFPGList<TCard>;
FP1Hand: TFPGList<TCard>; FP1Hand: TFPGList<TCard>;
FP1Removed: TFPGList<TCard>; FP1Removed: TFPGList<TCard>;
FPuzzleId: Int64;
FPuzzleName: string;
FSCards: array [0..1, 0..5] of TCard; FSCards: array [0..1, 0..5] of TCard;
FExtraMonsterCards: array [5..6] of TCard; FExtraMonsterCards: array [5..6] of TCard;
FLPOpponent: Integer; FLPOpponent: Integer;
...@@ -121,6 +123,7 @@ type ...@@ -121,6 +123,7 @@ type
procedure Optimize(); procedure Optimize();
published published
property PuzzleId: Int64 read FPuzzleId write FPuzzleId; property PuzzleId: Int64 read FPuzzleId write FPuzzleId;
property PuzzleName: string read FPuzzleName write FPuzzleName;
property P0Hand: TFPGList<TCard> read FP0Hand write FP0Hand; property P0Hand: TFPGList<TCard> read FP0Hand write FP0Hand;
property P0Deck: TFPGList<TCard> read FP0Deck write FP0Deck; property P0Deck: TFPGList<TCard> read FP0Deck write FP0Deck;
property P0ExtraDeck: TFPGList<TCard> read FP0ExtraDeck write FP0ExtraDeck; property P0ExtraDeck: TFPGList<TCard> read FP0ExtraDeck write FP0ExtraDeck;
...@@ -291,6 +294,7 @@ var ...@@ -291,6 +294,7 @@ var
i, j: Integer; i, j: Integer;
begin begin
FPuzzleId := 0; FPuzzleId := 0;
FPuzzleName:= '';
FAIName:= ''; FAIName:= '';
FLPOpponent:= 0; FLPOpponent:= 0;
FLPSelf:= 0; FLPSelf:= 0;
......
untcardjson.pas
View file @ 4021fc87
...@@ -127,6 +127,7 @@ begin ...@@ -127,6 +127,7 @@ begin
json := TJSONObject.Create(); json := TJSONObject.Create();
json.Int64s['puzzleId'] := APuzzle.PuzzleId; json.Int64s['puzzleId'] := APuzzle.PuzzleId;
json.Strings['puzzleName'] := APuzzle.PuzzleName;
json.Strings['aiName'] := APuzzle.AIName; json.Strings['aiName'] := APuzzle.AIName;
...@@ -245,6 +246,7 @@ begin ...@@ -245,6 +246,7 @@ begin
puz := TPuzzleField.Create; puz := TPuzzleField.Create;
puz.PuzzleId:= j.Int64s['puzzleId']; puz.PuzzleId:= j.Int64s['puzzleId'];
puz.PuzzleName:= j.Strings['puzzleName'];
puz.AIName := j.Strings['aiName']; puz.AIName := j.Strings['aiName'];
......
untconfig.pas
View file @ 4021fc87
...@@ -5,7 +5,7 @@ unit untConfig; ...@@ -5,7 +5,7 @@ unit untConfig;
interface interface
uses uses
Classes, SysUtils; Classes, SysUtils, Registry;
type type
...@@ -15,6 +15,7 @@ type ...@@ -15,6 +15,7 @@ type
public public
class function GetMCToken(): string; class function GetMCToken(): string;
class procedure SaveMCToken(AToken: string); class procedure SaveMCToken(AToken: string);
class function GetMDPro3InstallPath(): string;
end; end;
implementation implementation
...@@ -27,7 +28,7 @@ var ...@@ -27,7 +28,7 @@ var
i: Integer; i: Integer;
AToken: String = ''; AToken: String = '';
begin begin
ACfgPath:= ExtractFilePath(ParamStr(0)) + DirectorySeparator + 'Data' + DirectorySeparator + 'config.conf'; ACfgPath:= GetMDPro3InstallPath() + DirectorySeparator + 'Data' + DirectorySeparator + 'config.conf';
with TStringList.Create do begin with TStringList.Create do begin
LoadFromFile(ACfgPath); LoadFromFile(ACfgPath);
// MyCardToken-> // MyCardToken->
...@@ -48,7 +49,7 @@ var ...@@ -48,7 +49,7 @@ var
AFound: Boolean = False; AFound: Boolean = False;
i: Integer; i: Integer;
begin begin
ACfgPath:= ExtractFilePath(ParamStr(0)) + DirectorySeparator + 'Data' + DirectorySeparator + 'config.conf'; ACfgPath:= GetMDPro3InstallPath() + DirectorySeparator + 'Data' + DirectorySeparator + 'config.conf';
with TStringList.Create do begin with TStringList.Create do begin
LoadFromFile(ACfgPath); LoadFromFile(ACfgPath);
for i := 0 to Count - 1 do begin for i := 0 to Count - 1 do begin
...@@ -67,5 +68,23 @@ begin ...@@ -67,5 +68,23 @@ begin
end; end;
class function TConfigReader.GetMDPro3InstallPath(): string;
var
AOpened: Boolean;
APath: string = '';
begin
// GetMDPro3InstallPath
with TRegistry.Create do begin
RootKey:= HKEY_CURRENT_USER;
AOpened := OpenKey('Software\MDPro3\MDPro3Install', False);
if AOpened then begin
APath := ReadString('InstallPath');
CloseKey;
end;
Free;
end;
Exit(APath);
end;
end. end.
untdata.pas
View file @ 4021fc87
...@@ -41,13 +41,16 @@ var ...@@ -41,13 +41,16 @@ var
implementation implementation
uses
untConfig;
{ TCardDatabase } { TCardDatabase }
constructor TCardDatabase.Create; constructor TCardDatabase.Create;
var var
APath: string; APath: string;
begin begin
APath:= ExtractFilePath(ParamStr(0)) + DirectorySeparator + 'Data' + DirectorySeparator + 'locales' + DirectorySeparator + 'zh-CN' + DirectorySeparator + 'cards.cdb'; APath:= TConfigReader.GetMDPro3InstallPath() + DirectorySeparator + 'Data' + DirectorySeparator + 'locales' + DirectorySeparator + 'zh-CN' + DirectorySeparator + 'cards.cdb';
if (not FileExists(APath)) then raise EFileNotFoundException.CreateFmt('数据库 [%s] 不存在，请重新安装 MDPro3', [APath]); if (not FileExists(APath)) then raise EFileNotFoundException.CreateFmt('数据库 [%s] 不存在，请重新安装 MDPro3', [APath]);
FTrans := TSQLTransaction.Create(nil); FTrans := TSQLTransaction.Create(nil);
FDatabase := TSQLite3Connection.Create(nil); FDatabase := TSQLite3Connection.Create(nil);
......
untutils.pas
View file @ 4021fc87
...@@ -15,6 +15,8 @@ function CardTypeToReadable(ct: TCardType): string; ...@@ -15,6 +15,8 @@ function CardTypeToReadable(ct: TCardType): string;
function PickOneCardFromList(list: TFPGList<TCard>; ACardId: Int64; AOwner: TCardOwner; APlayer: TCardPlayer; ALocation: TCardLocation; ASeq: Integer): TCard; function PickOneCardFromList(list: TFPGList<TCard>; ACardId: Int64; AOwner: TCardOwner; APlayer: TCardPlayer; ALocation: TCardLocation; ASeq: Integer): TCard;
function WorkAsToCodeName(cwa: TCardWorkAs): String; function WorkAsToCodeName(cwa: TCardWorkAs): String;
function GetFirstCardFromScriptCode(ACode: string): Int64;
implementation implementation
function ElementNameToFieldRec(AName: string): TFieldRec; function ElementNameToFieldRec(AName: string): TFieldRec;
...@@ -164,5 +166,26 @@ begin ...@@ -164,5 +166,26 @@ begin
Exit(''); Exit('');
end; end;
function GetFirstCardFromScriptCode(ACode: string): Int64;
var
i: Integer;
tmp: string;
begin
// GetFirstCardFromScriptCode
with TStringList.Create do begin
Text:= ACode;
for i := 0 to Count - 1 do begin
if (Strings[i].Contains('Debug.AddCard(')) then begin
tmp := Strings[i];
tmp := tmp.Substring(tmp.IndexOf('(') + 1);
tmp := tmp.Substring(0, tmp.IndexOf(','));
Break;
end;
end;
Free;
end;
Exit(StrToInt64(tmp));
end;
end. end.
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment