hedgewars/uFLTeams.pas
branchqmlfrontend
changeset 10440 b74a7bbe224e
parent 10434 1614b13ad35e
child 10442 c58db813240b
equal deleted inserted replaced
10438:50ed968e4fee 10440:b74a7bbe224e
     3 uses uFLTypes;
     3 uses uFLTypes;
     4 
     4 
     5 function createRandomTeam: TTeam;
     5 function createRandomTeam: TTeam;
     6 procedure sendTeamConfig(var team: TTeam);
     6 procedure sendTeamConfig(var team: TTeam);
     7 
     7 
       
     8 function getTeamsList: PPChar; cdecl;
       
     9 procedure freeTeamsList;
     8 
    10 
     9 implementation
    11 implementation
    10 uses uFLUtils, uFLIPC;
    12 uses uFLUtils, uFLIPC, uPhysFSLayer;
       
    13 
       
    14 const MAX_TEAM_NAMES = 128;
       
    15 var
       
    16     teamsList: PTeam;
       
    17     teamsNumber: Longword;
       
    18     listOfTeamNames: array[0..MAX_TEAM_NAMES] of PChar;
       
    19 
    11 
    20 
    12 function createRandomTeam: TTeam;
    21 function createRandomTeam: TTeam;
    13 var t: TTeam;
    22 var t: TTeam;
    14     i: Longword;
    23     i: Longword;
    15 begin
    24 begin
    28         hogsNumber:= 4
    37         hogsNumber:= 4
    29     end;
    38     end;
    30     createRandomTeam:= t
    39     createRandomTeam:= t
    31 end;
    40 end;
    32 
    41 
       
    42 
    33 procedure sendTeamConfig(var team: TTeam);
    43 procedure sendTeamConfig(var team: TTeam);
    34 var i: Longword;
    44 var i: Longword;
    35 begin
    45 begin
    36     with team do
    46     with team do
    37     begin
    47     begin
    42             ipcToEngine('ehat ' + hedgehogs[i].hat);
    52             ipcToEngine('ehat ' + hedgehogs[i].hat);
    43         end;
    53         end;
    44     end
    54     end
    45 end;
    55 end;
    46 
    56 
       
    57 
       
    58 procedure loadTeam(var team: TTeam; fileName: shortstring);
       
    59 var f: PFSFile;
       
    60     section: LongInt;
       
    61     l: shortstring;
       
    62 begin
       
    63     section:= -1;
       
    64     f:= pfsOpenRead(fileName);
       
    65 
       
    66     while (not pfsEOF(f)) do
       
    67     begin
       
    68         pfsReadLn(f, l);
       
    69 
       
    70         if l = '' then
       
    71         else if l = '[Team]' then 
       
    72             section:= 0
       
    73         else if l[1] = '[' then
       
    74             section:= -1
       
    75         else if section = 0 then
       
    76         begin // [Team]
       
    77             if copy(l, 1, 5) = 'Name=' then
       
    78                 team.teamName:= midStr(l, 6)
       
    79             else if copy(l, 1, 6) = 'Grave=' then
       
    80                 team.graveName:= midStr(l, 7)
       
    81             else if copy(l, 1, 5) = 'Fort=' then
       
    82                 team.fortName:= midStr(l, 6)
       
    83             else if copy(l, 1, 5) = 'Flag=' then
       
    84                 team.flag:= midStr(l, 6)
       
    85         end;
       
    86         // TODO: load hedgehogs and other stuff
       
    87     end;
       
    88 
       
    89     pfsClose(f)
       
    90 end;
       
    91 
       
    92 
       
    93 procedure loadTeams;
       
    94 var filesList, tmp: PPChar;
       
    95     team: PTeam;
       
    96     s: shortstring;
       
    97     l: Longword;
       
    98 begin
       
    99     filesList:= pfsEnumerateFiles('Teams');
       
   100     teamsNumber:= 0;
       
   101 
       
   102     tmp:= filesList;
       
   103     while tmp^ <> nil do
       
   104     begin
       
   105         s:= shortstring(tmp^);
       
   106         l:= length(s);
       
   107         if (l > 4) and (copy(s, l - 3, 4) = '.hwt') then inc(teamsNumber)
       
   108     end;
       
   109 
       
   110     // TODO: no teams at all?
       
   111     teamsList:= GetMem(sizeof(teamsList^) * teamsNumber);
       
   112 
       
   113     team:= teamsList;
       
   114     tmp:= filesList;
       
   115     while tmp^ <> nil do
       
   116     begin
       
   117         s:= shortstring(tmp^);
       
   118         l:= length(s);
       
   119         if (l > 4) and (copy(s, l - 3, 4) = '.hwt') then 
       
   120             begin
       
   121                 loadTeam(team^, '/Config/Teams/' + s);
       
   122                 inc(team)
       
   123             end;
       
   124     end;
       
   125 
       
   126     pfsFreeList(filesList)
       
   127 end;
       
   128 
       
   129 
       
   130 function getTeamsList: PPChar; cdecl;
       
   131 var i, t, l: Longword;
       
   132     team: PTeam;
       
   133 begin
       
   134     if teamsList = nil then
       
   135         loadTeams;
       
   136 
       
   137     t:= teamsNumber;
       
   138     if t >= MAX_TEAM_NAMES then 
       
   139         t:= MAX_TEAM_NAMES;
       
   140 
       
   141     team:= teamsList;
       
   142     for i:= 0 to Pred(t) do
       
   143     begin
       
   144         l:= length(team^.teamName);
       
   145         if l >= 255 then l:= 254;
       
   146         team^.teamName[l + 1]:= #0;
       
   147         listOfTeamNames[i]:= @team^.teamName[1]
       
   148     end;
       
   149 
       
   150     listOfTeamNames[t]:= nil;
       
   151 
       
   152     getTeamsList:= listOfTeamNames
       
   153 end;
       
   154 
       
   155 
       
   156 procedure freeTeamsList;
       
   157 begin
       
   158     if teamsList <> nil then
       
   159         FreeMem(teamsList, sizeof(teamsList^) * teamsNumber)
       
   160 end;
       
   161 
    47 end.
   162 end.