Mercurial Mercurial > hedgewars / comparison
summary | shortlog | changelog | graph | tags | bookmarks | branches | files | changeset | file | latest | revisions | annotate | diff | comparison | raw | help
Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
hedgewars/uFLGameConfig.pas
branchqmlfrontend
changeset 10432 b0abef0ee78c
parent 10430 899a30018ede
child 10444 47a6231f1fc1
equal deleted inserted replaced
10430:899a30018ede 10432:b0abef0ee78c 
    10 
    10 
    11 procedure setSeed(seed: PChar); cdecl;
 
    11 procedure setSeed(seed: PChar); cdecl;
 
    12 function  getSeed: PChar; cdecl;
 
    12 function  getSeed: PChar; cdecl;
 
    13 
    13 
    14 implementation
 
    14 implementation
 
    15 uses uFLIPC, hwengine;
 
    15 uses uFLIPC, hwengine, uFLUtils, uFLTeams;
 
    16 
    16 
    17 var guiCallbackPointer: pointer;
 
    17 var guiCallbackPointer: pointer;
 
    18     guiCallbackFunction: TGUICallback;
 
    18     guiCallbackFunction: TGUICallback;
 
    19 
    19 
    20 const
 
    20 const
 
    21     MAXCONFIGS = 5;
 
    21     MAXCONFIGS = 5;
 
    22     MAXARGS = 32;
 
    22     MAXARGS = 32;
 
    23 
    23 
    24 type
 
    24 type
 
    25     TGameType = (gtPreview, gtLocal);
 
       
    26     THedgehog = record
 
       
    27             name: shortstring;
 
       
    28             hat: shortstring;
 
       
    29             end;
 
       
    30     TTeam = record
 
       
    31             teamName: shortstring;
 
       
    32             flag: shortstring;
 
       
    33             graveName: shortstring;
 
       
    34             fortName: shortstring;
 
       
    35             owner: shortstring;
 
       
    36             extDriven: boolean;
 
       
    37             botLevel: Longword;
 
       
    38             hedgehogs: array[0..7] of THedgehog;
 
       
    39             hogsNumber: Longword;
 
       
    40             end;
 
       
    41     TGameConfig = record
 
    25     TGameConfig = record
 
    42             seed: shortstring;
 
    26             seed: shortstring;
 
    43             theme: shortstring;
 
    27             theme: shortstring;
 
    44             script: shortstring;
 
    28             script: shortstring;
 
       
    29             mapgen: Longint;
 
    45             gameType: TGameType;
 
    30             gameType: TGameType;
 
    46             teams: array[0..7] of TTeam;
 
    31             teams: array[0..7] of TTeam;
 
    47             arguments: array[0..Pred(MAXARGS)] of shortstring;
 
    32             arguments: array[0..Pred(MAXARGS)] of shortstring;
 
    48             argv: array[0..Pred(MAXARGS)] of PChar;
 
    33             argv: array[0..Pred(MAXARGS)] of PChar;
 
    49             argumentsNumber: Longword;
 
    34             argumentsNumber: Longword;
 
    50             end;
 
    35             end;
 
    51     PGameConfig = ^TGameConfig;
 
    36     PGameConfig = ^TGameConfig;
 
    52 
    37 
    53 var currentConfig: TGameConfig;
 
    38 var
 
    54     str2PCharBuffer: array[0..255] of char;
 
    39     currentConfig: TGameConfig;
 
    55 
    40 
    56 function str2PChar(const s: shortstring): PChar;
 
    41 
    57 var i: Integer;
 
    42 procedure sendConfig(config: PGameConfig);
 
       
    43 var i: Longword;
 
    58 begin
 
    44 begin
 
    59    for i:= 1 to Length(s) do
 
    45 with config^ do
 
    60       begin
 
    46 begin
 
    61       str2PCharBuffer[i - 1] := s[i];
 
    47     case gameType of
 
    62       end;
 
    48     gtPreview: begin
 
    63    str2PCharBuffer[Length(s)]:= #0;
 
    49             ipcToEngine('eseed ' + seed);
 
    64    str2PChar:= @(str2PCharBuffer[0]);
 
    50             ipcToEngine('e$mapgen ' + intToStr(mapgen));
 
    65 end;    
    51         end;
 
       
    52     gtLocal: begin
 
       
    53             ipcToEngine('eseed ' + seed);
 
       
    54             ipcToEngine('e$mapgen ' + intToStr(mapgen));
 
       
    55             i:= 0;
 
       
    56             while (i < 8) and (teams[i].hogsNumber > 0) do
 
       
    57                 begin
 
       
    58                     ipcToEngine('eammloadt 93919294221991210322351110012000000002111001010111110001');
 
       
    59                     ipcToEngine('eammprob 04050405416006555465544647765766666661555101011154111111');
 
       
    60                     ipcToEngine('eammdelay 00000000000002055000000400070040000000002200000006000200');
 
       
    61                     ipcToEngine('eammreinf 13111103121111111231141111111111111112111111011111111111');
 
       
    62                     ipcToEngine('eammstore');
 
       
    63                     sendTeamConfig(teams[i]);
 
       
    64                     inc(i)
 
       
    65                 end;
 
       
    66         end;
 
       
    67     end;
 
       
    68 
       
    69     ipcToEngine('!');
 
       
    70 end;
 
       
    71 end;
 
    66 
    72 
    67 procedure queueExecution;
 
    73 procedure queueExecution;
 
    68 var pConfig: PGameConfig;
 
    74 var pConfig: PGameConfig;
 
    69     i: Longword;
 
    75     i: Longword;
 
    70 begin
 
    76 begin
 
    80                 arguments[i][byte(arguments[i][0]) + 1]:= #0;
 
    86                 arguments[i][byte(arguments[i][0]) + 1]:= #0;
 
    81             argv[i]:= @arguments[i][1]
 
    87             argv[i]:= @arguments[i][1]
 
    82         end;
 
    88         end;
 
    83 
    89 
    84     RunEngine(pConfig^.argumentsNumber, @pConfig^.argv);
 
    90     RunEngine(pConfig^.argumentsNumber, @pConfig^.argv);
 
       
    91 
       
    92     sendConfig(pConfig)
 
    85 end;
 
    93 end;
 
    86 
    94 
    87 procedure resetGameConfig; cdecl;
 
    95 procedure resetGameConfig; cdecl;
 
    88 begin
 
    96 begin
 
    89 end;
 
    97 end;
 
    98     getSeed:= str2PChar(currentConfig.seed)
 
   106     getSeed:= str2PChar(currentConfig.seed)
 
    99 end;
 
   107 end;
 
   100 
   108 
   101 procedure runQuickGame; cdecl;
 
   109 procedure runQuickGame; cdecl;
 
   102 begin
 
   110 begin
 
       
   111     with currentConfig do
 
       
   112     begin
 
       
   113         gameType:= gtLocal;
 
       
   114         arguments[0]:= '';
 
       
   115         arguments[1]:= '--internal';
 
       
   116         arguments[2]:= '--nosound';
 
       
   117         argumentsNumber:= 3;
 
   103 
   118 
       
   119         teams[0]:= createRandomTeam;
 
       
   120         teams[0].color:= '6341088';
 
       
   121         teams[1]:= createRandomTeam;
 
       
   122         teams[1].color:= '2113696';
 
       
   123         teams[1].botLevel:= 1;
 
       
   124 
       
   125         queueExecution;
 
       
   126     end;
 
   104 end;
 
   127 end;
 
   105 
   128 
   106 procedure getPreview; cdecl;
 
   129 procedure getPreview; cdecl;
 
   107 begin
 
   130 begin
 
   108     with currentConfig do
 
   131     with currentConfig do
 
   112         arguments[1]:= '--internal';
 
   135         arguments[1]:= '--internal';
 
   113         arguments[2]:= '--landpreview';
 
   136         arguments[2]:= '--landpreview';
 
   114         argumentsNumber:= 3;
 
   137         argumentsNumber:= 3;
 
   115 
   138 
   116         queueExecution;
 
   139         queueExecution;
 
   117 
       
   118         ipcToEngine('eseed ' + seed);
 
       
   119         ipcToEngine('e$mapgen 0');
 
       
   120         ipcToEngine('!');
 
       
   121     end;
 
   140     end;
 
   122 end;
 
   141 end;
 
   123 
   142 
   124 procedure engineMessageCallback(p: pointer; msg: PChar; len: Longword);
 
   143 procedure engineMessageCallback(p: pointer; msg: PChar; len: Longword);
 
   125 begin
 
   144 begin
hedgewars