hedgewars/uFLGameConfig.pas
branchqmlfrontend
changeset 10951 89a7f617e091
parent 10892 83a99e2f8b00
child 11429 86c13e5662f1
equal deleted inserted replaced
10949:6a1f5f452460 10951:89a7f617e091
     4 
     4 
     5 procedure resetGameConfig; cdecl;
     5 procedure resetGameConfig; cdecl;
     6 procedure runQuickGame; cdecl;
     6 procedure runQuickGame; cdecl;
     7 procedure runLocalGame; cdecl;
     7 procedure runLocalGame; cdecl;
     8 procedure getPreview; cdecl;
     8 procedure getPreview; cdecl;
     9 
       
    10 procedure registerGUIMessagesCallback(p: pointer; f: TGUICallback); cdecl;
       
    11 
     9 
    12 procedure setSeed(seed: PChar); cdecl;
    10 procedure setSeed(seed: PChar); cdecl;
    13 function  getSeed: PChar; cdecl;
    11 function  getSeed: PChar; cdecl;
    14 procedure setTheme(themeName: PChar); cdecl;
    12 procedure setTheme(themeName: PChar); cdecl;
    15 procedure setScript(scriptName: PChar); cdecl;
    13 procedure setScript(scriptName: PChar); cdecl;
    19 procedure tryAddTeam(teamName: PChar); cdecl;
    17 procedure tryAddTeam(teamName: PChar); cdecl;
    20 procedure tryRemoveTeam(teamName: PChar); cdecl;
    18 procedure tryRemoveTeam(teamName: PChar); cdecl;
    21 procedure changeTeamColor(teamName: PChar; dir: LongInt); cdecl;
    19 procedure changeTeamColor(teamName: PChar; dir: LongInt); cdecl;
    22 
    20 
    23 implementation
    21 implementation
    24 uses uFLIPC, hwengine, uFLUtils, uFLTeams, uFLData, uFLSChemes, uFLAmmo;
    22 uses uFLIPC, hwengine, uFLUtils, uFLTeams, uFLData, uFLSChemes, uFLAmmo, uFLUICallback;
    25 
       
    26 var guiCallbackPointer: pointer;
       
    27     guiCallbackFunction: TGUICallback;
       
    28 
    23 
    29 const
    24 const
    30     MAXCONFIGS = 5;
    25     MAXCONFIGS = 5;
    31     MAXARGS = 32;
    26     MAXARGS = 32;
    32 
    27 
   198 
   193 
   199         queueExecution;
   194         queueExecution;
   200     end;
   195     end;
   201 end;
   196 end;
   202 
   197 
   203 
       
   204 procedure engineMessageCallback(p: pointer; msg: PChar; len: Longword);
       
   205 begin
       
   206     if len = 128 * 256 then guiCallbackFunction(guiCallbackPointer, mtPreview, msg, len)
       
   207 end;
       
   208 
       
   209 procedure registerGUIMessagesCallback(p: pointer; f: TGUICallback); cdecl;
       
   210 begin
       
   211     guiCallbackPointer:= p;
       
   212     guiCallbackFunction:= f;
       
   213 
       
   214     registerIPCCallback(nil, @engineMessageCallback)
       
   215 end;
       
   216 
       
   217 
       
   218 procedure tryAddTeam(teamName: PChar); cdecl;
   198 procedure tryAddTeam(teamName: PChar); cdecl;
   219 var msg: ansistring;
   199 var msg: ansistring;
   220     i, hn, hedgehogsNumber: Longword;
   200     i, hn, hedgehogsNumber: Longword;
   221     team: PTeam;
   201     team: PTeam;
   222     c: Longword;
   202     c: Longword;
   247         teams[i].hogsNumber:= hn;
   227         teams[i].hogsNumber:= hn;
   248 
   228 
   249         teams[i].color:= c;
   229         teams[i].color:= c;
   250 
   230 
   251         msg:= '0' + #10 + teamName;
   231         msg:= '0' + #10 + teamName;
   252         guiCallbackFunction(guiCallbackPointer, mtAddPlayingTeam, @msg[1], length(msg));
   232         sendUI(mtAddPlayingTeam, @msg[1], length(msg));
   253 
   233 
   254         msg:= teamName + #10 + colorsSet[teams[i].color];
   234         msg:= teamName + #10 + colorsSet[teams[i].color];
   255         guiCallbackFunction(guiCallbackPointer, mtTeamColor, @msg[1], length(msg));
   235         sendUI(mtTeamColor, @msg[1], length(msg));
   256 
   236 
   257         msg:= teamName;
   237         msg:= teamName;
   258         guiCallbackFunction(guiCallbackPointer, mtRemoveTeam, @msg[1], length(msg))
   238         sendUI(mtRemoveTeam, @msg[1], length(msg))
   259     end
   239     end
   260 end;
   240 end;
   261 
   241 
   262 
   242 
   263 procedure tryRemoveTeam(teamName: PChar); cdecl;
   243 procedure tryRemoveTeam(teamName: PChar); cdecl;
   284         teams[i].hogsNumber:= 0
   264         teams[i].hogsNumber:= 0
   285     end;
   265     end;
   286 
   266 
   287     msg:= teamName;
   267     msg:= teamName;
   288 
   268 
   289     guiCallbackFunction(guiCallbackPointer, mtRemovePlayingTeam, @msg[1], length(msg));
   269     sendUI(mtRemovePlayingTeam, @msg[1], length(msg));
   290     guiCallbackFunction(guiCallbackPointer, mtAddTeam, @msg[1], length(msg))
   270     sendUI(mtAddTeam, @msg[1], length(msg))
   291 end;
   271 end;
   292 
   272 
   293 
   273 
   294 procedure changeTeamColor(teamName: PChar; dir: LongInt); cdecl;
   274 procedure changeTeamColor(teamName: PChar; dir: LongInt); cdecl;
   295 var i, dc: Longword;
   275 var i, dc: Longword;
   307 
   287 
   308         if dir >= 0 then dc:= 1 else dc:= 8;
   288         if dir >= 0 then dc:= 1 else dc:= 8;
   309         teams[i].color:= (teams[i].color + dc) mod 9;
   289         teams[i].color:= (teams[i].color + dc) mod 9;
   310 
   290 
   311         msg:= tn + #10 + colorsSet[teams[i].color];
   291         msg:= tn + #10 + colorsSet[teams[i].color];
   312         guiCallbackFunction(guiCallbackPointer, mtTeamColor, @msg[1], length(msg))
   292         sendUI(mtTeamColor, @msg[1], length(msg))
   313     end
   293     end
   314 end;
   294 end;
   315 
   295 
   316 procedure setTheme(themeName: PChar); cdecl;
   296 procedure setTheme(themeName: PChar); cdecl;
   317 begin
   297 begin