1 unit uFLTeams; |
|
2 interface |
|
3 uses uFLTypes; |
|
4 |
|
5 function createRandomTeam: TTeam; |
|
6 procedure sendTeamConfig(hp: LongInt; var team: TTeam); |
|
7 |
|
8 function getTeamsList: PPChar; cdecl; |
|
9 procedure freeTeamsList; |
|
10 |
|
11 function teamByName(s: shortstring): PTeam; |
|
12 |
|
13 procedure sendTeam(var team: TTeam); |
|
14 procedure removeTeam(teamName: shortstring); |
|
15 |
|
16 implementation |
|
17 uses uFLUtils, uFLIPC, uPhysFSLayer, uFLThemes, uFLNet; |
|
18 |
|
19 const MAX_TEAM_NAMES = 128; |
|
20 var |
|
21 teamsList: PTeam; |
|
22 teamsNumber: Longword; |
|
23 listOfTeamNames: array[0..MAX_TEAM_NAMES] of PChar; |
|
24 |
|
25 |
|
26 function createRandomTeam: TTeam; |
|
27 var t: TTeam; |
|
28 i: Longword; |
|
29 begin |
|
30 with t do |
|
31 begin |
|
32 teamName:= 'team' + inttostr(random(100)); |
|
33 |
|
34 for i:= 0 to 7 do |
|
35 with hedgehogs[i] do |
|
36 begin |
|
37 name:= 'hedgehog ' + inttostr(i); |
|
38 hat:= 'NoHat' |
|
39 end; |
|
40 |
|
41 botLevel:= 0; |
|
42 hogsNumber:= 4 |
|
43 end; |
|
44 createRandomTeam:= t |
|
45 end; |
|
46 |
|
47 |
|
48 procedure sendTeamConfig(hp: LongInt; var team: TTeam); |
|
49 var i: Longword; |
|
50 begin |
|
51 with team do |
|
52 begin |
|
53 ipcToEngine('eaddteam <hash> ' + colorsSet[color] + ' ' + teamName); |
|
54 |
|
55 if extDriven then |
|
56 ipcToEngine('erdriven'); |
|
57 |
|
58 for i:= 0 to Pred(hogsNumber) do |
|
59 begin |
|
60 ipcToEngine('eaddhh ' + IntToStr(botLevel) + ' ' + IntToStr(hp) + ' ' + hedgehogs[i].name); |
|
61 ipcToEngine('ehat ' + hedgehogs[i].hat); |
|
62 end; |
|
63 end |
|
64 end; |
|
65 |
|
66 |
|
67 procedure loadTeam(var team: TTeam; fileName: shortstring); |
|
68 var f: PFSFile; |
|
69 section: LongInt; |
|
70 l: shortstring; |
|
71 begin |
|
72 section:= -1; |
|
73 f:= pfsOpenRead(fileName); |
|
74 |
|
75 while (not pfsEOF(f)) do |
|
76 begin |
|
77 pfsReadLn(f, l); |
|
78 |
|
79 if l = '' then |
|
80 else if l = '[Team]' then |
|
81 section:= -2 |
|
82 else if copy(l, 1, 9) = '[Hedgehog' then |
|
83 section:= StrToInt(copy(l, 10, 1)) |
|
84 else if section = -2 then |
|
85 begin // [Team] |
|
86 if copy(l, 1, 5) = 'Name=' then |
|
87 team.teamName:= midStr(l, 6) |
|
88 else if copy(l, 1, 6) = 'Grave=' then |
|
89 team.grave:= midStr(l, 7) |
|
90 else if copy(l, 1, 5) = 'Fort=' then |
|
91 team.fort:= midStr(l, 6) |
|
92 else if copy(l, 1, 5) = 'Flag=' then |
|
93 team.flag:= midStr(l, 6) |
|
94 else if copy(l, 1, 10) = 'Voicepack=' then |
|
95 team.voice:= midStr(l, 11) |
|
96 else if copy(l, 1, 11) = 'Difficulty=' then |
|
97 team.botLevel:= StrToInt(midStr(l, 12)) |
|
98 end else if (section >= 0) and (section <= 7) then |
|
99 begin // [Hedgehog*] |
|
100 if copy(l, 1, 5) = 'Name=' then |
|
101 team.hedgehogs[section].name:= midStr(l, 6) |
|
102 else if copy(l, 1, 4) = 'Hat=' then |
|
103 team.hedgehogs[section].hat:= midStr(l, 5) |
|
104 end; |
|
105 end; |
|
106 |
|
107 pfsClose(f) |
|
108 end; |
|
109 |
|
110 |
|
111 procedure loadTeams; |
|
112 var filesList, tmp: PPChar; |
|
113 team: PTeam; |
|
114 s: shortstring; |
|
115 l: Longword; |
|
116 begin |
|
117 filesList:= pfsEnumerateFiles('/Config/Teams'); |
|
118 teamsNumber:= 0; |
|
119 |
|
120 tmp:= filesList; |
|
121 while tmp^ <> nil do |
|
122 begin |
|
123 s:= shortstring(tmp^); |
|
124 l:= length(s); |
|
125 if (l > 4) and (copy(s, l - 3, 4) = '.hwt') then inc(teamsNumber); |
|
126 inc(tmp) |
|
127 end; |
|
128 |
|
129 // TODO: no teams at all? |
|
130 teamsList:= GetMem(sizeof(teamsList^) * teamsNumber); |
|
131 |
|
132 team:= teamsList; |
|
133 tmp:= filesList; |
|
134 while tmp^ <> nil do |
|
135 begin |
|
136 s:= shortstring(tmp^); |
|
137 l:= length(s); |
|
138 if (l > 4) and (copy(s, l - 3, 4) = '.hwt') then |
|
139 begin |
|
140 loadTeam(team^, '/Config/Teams/' + s); |
|
141 inc(team) |
|
142 end; |
|
143 inc(tmp) |
|
144 end; |
|
145 |
|
146 pfsFreeList(filesList) |
|
147 end; |
|
148 |
|
149 |
|
150 function getTeamsList: PPChar; cdecl; |
|
151 var i, t, l: Longword; |
|
152 team: PTeam; |
|
153 begin |
|
154 if teamsList = nil then |
|
155 loadTeams; |
|
156 |
|
157 t:= teamsNumber; |
|
158 if t >= MAX_TEAM_NAMES then |
|
159 t:= MAX_TEAM_NAMES; |
|
160 |
|
161 team:= teamsList; |
|
162 for i:= 0 to Pred(t) do |
|
163 begin |
|
164 l:= length(team^.teamName); |
|
165 if l >= 255 then l:= 254; |
|
166 team^.teamName[l + 1]:= #0; |
|
167 listOfTeamNames[i]:= @team^.teamName[1]; |
|
168 inc(team) |
|
169 end; |
|
170 |
|
171 listOfTeamNames[t]:= nil; |
|
172 |
|
173 getTeamsList:= listOfTeamNames |
|
174 end; |
|
175 |
|
176 function teamByName(s: shortstring): PTeam; |
|
177 var i: Longword; |
|
178 team: PTeam; |
|
179 begin |
|
180 team:= teamsList; |
|
181 i:= 0; |
|
182 while (i < teamsNumber) and (team^.teamName <> s) do |
|
183 begin |
|
184 inc(team); |
|
185 inc(i) |
|
186 end; |
|
187 |
|
188 if i < teamsNumber then teamByName:= team else teamByName:= nil |
|
189 end; |
|
190 |
|
191 procedure freeTeamsList; |
|
192 begin |
|
193 if teamsList <> nil then |
|
194 FreeMem(teamsList, sizeof(teamsList^) * teamsNumber) |
|
195 end; |
|
196 |
|
197 procedure sendTeam(var team: TTeam); |
|
198 var i: Longword; |
|
199 begin |
|
200 with team do |
|
201 begin |
|
202 sendNetLn('ADD_TEAM'); |
|
203 sendNetLn(teamName); |
|
204 sendNetLn(IntToStr(color)); |
|
205 sendNetLn(grave); |
|
206 sendNetLn(fort); |
|
207 sendNetLn(voice); |
|
208 sendNetLn(flag); |
|
209 sendNetLn(IntToStr(botLevel)); |
|
210 for i := 0 to 7 do |
|
211 begin |
|
212 sendNetLn(hedgehogs[i].name); |
|
213 sendNetLn(hedgehogs[i].hat); |
|
214 end; |
|
215 sendNetLn('') |
|
216 end; |
|
217 end; |
|
218 |
|
219 procedure removeTeam(teamName: shortstring); |
|
220 begin |
|
221 sendNetLn('REMOVE_TEAM'); |
|
222 sendNet(teamName) |
|
223 end; |
|
224 |
|
225 end. |
|