source: tags/1.3.4/Brain.pas

Last change on this file was 544, checked in by chronos, 7 months ago
  • Fixed: Correct translation of offered players AIs.
File size: 5.5 KB
Line 
1unit Brain;
2
3interface
4
5uses
6 Classes, SysUtils, Generics.Collections, Protocol, LazFileUtils,
7 dynlibs, Types,
8 {$IFDEF DPI}Dpi.Graphics{$ELSE}Graphics{$ENDIF};
9
10const
11 // module flags
12 fMultiple = $10000000;
13 fDotNet = $20000000;
14 fUsed = $40000000;
15
16type
17 TBrainType = (btNoTerm, btSuperVirtual, btTerm, btRandom, btAI, btNetworkServer,
18 btNetworkClient);
19
20 { TBrain }
21
22 TBrain = class
23 private
24 FName: string;
25 function GetName: string;
26 procedure SetName(AValue: string);
27 public
28 FileName: string;
29 DLLName: string;
30 LookupName: string;
31 Credits: string; { filename and full name }
32 hm: TLibHandle; { module handle }
33 Flags: Integer;
34 ServerVersion: Integer;
35 DataVersion: Integer;
36 DataSize: Integer;
37 Client: TClientCall; { client function address }
38 Initialized: Boolean;
39 Kind: TBrainType;
40 Picture: TBitmap;
41 Beginner: Boolean;
42 procedure LoadPicture;
43 procedure LoadFromFile(AIFileName: string);
44 constructor Create;
45 destructor Destroy; override;
46 property Name: string read GetName write SetName;
47 end;
48
49 { TBrains }
50
51 TBrains = class(TObjectList<TBrain>)
52 function AddNew: TBrain;
53 function GetKindCount(Kind: TBrainType): Integer;
54 procedure GetByKind(Kind: TBrainType; Brains: TBrains);
55 function GetBeginner: TBrain;
56 procedure LoadPictures;
57 end;
58
59
60implementation
61
62uses
63 ScreenTools, Directories;
64
65{ TBrain }
66
67function TBrain.GetName: string;
68begin
69 if FName <> '' then Result := FName
70 else Result := Phrases.Lookup(LookupName);
71end;
72
73procedure TBrain.SetName(AValue: string);
74begin
75 FName := AValue;
76end;
77
78procedure TBrain.LoadPicture;
79var
80 TextSize: TSize;
81begin
82 if not LoadGraphicFile(Picture, GetAiDir + DirectorySeparator +
83 FileName + DirectorySeparator + FileName + '.png', [gfNoError]) then begin
84 with Picture.Canvas do begin
85 Brush.Color := $904830;
86 FillRect(Rect(0, 0, 64, 64));
87 Font.Assign(UniFont[ftTiny]);
88 Font.Style := [];
89 Font.Color := $5FDBFF;
90 TextSize := TextExtent(FileName);
91 TextOut(32 - TextSize.Width div 2, 32 - TextSize.Height div 2, FileName);
92 end;
93 end;
94end;
95
96procedure TBrain.LoadFromFile(AIFileName: string);
97var
98 T: Text;
99 Key: string;
100 Value: string;
101 S: string;
102 BasePath: string;
103 I: Integer;
104begin
105 BasePath := ExtractFileDir(AIFileName);
106 FileName := ExtractFileName(ExtractFileNameWithoutExt(ExtractFileNameWithoutExt(AIFileName)));
107 Name := FileName;
108 DLLName := BasePath + DirectorySeparator + Name + '.dll';
109 Credits := '';
110 Flags := fMultiple;
111 Client := nil;
112 Initialized := false;
113 ServerVersion := 0;
114 if not FileExists(AIFileName) then
115 raise Exception.Create(Format('AI specification file %s not found', [AIFileName]));
116 AssignFile(T, AIFileName);
117 Reset(T);
118 while not EOF(T) do
119 begin
120 ReadLn(T, s);
121 s := trim(s);
122 if Pos(' ', S) > 0 then begin
123 Key := Copy(S, 1, Pos(' ', S) - 1);
124 Value := Trim(Copy(S, Pos(' ', S) + 1, Length(S)));
125 end else begin
126 Key := S;
127 Value := '';
128 end;
129 if Key = '#NAME' then
130 Name := Value
131 else if Key = '#.NET' then
132 Flags := Flags or fDotNet
133 else if Key = '#BEGINNER' then
134 Beginner := True
135 else if Key = '#PATH' then
136 DLLName := BasePath + DirectorySeparator + Value
137 {$IFDEF WINDOWS}{$IFDEF CPU32}
138 else if Key = '#PATH_WIN32' then
139 DLLName := BasePath + DirectorySeparator + Value
140 {$ENDIF}{$ENDIF}
141 {$IFDEF WINDOWS}{$IFDEF CPU64}
142 else if Key = '#PATH_WIN64' then
143 DLLName := BasePath + DirectorySeparator + Value
144 {$ENDIF}{$ENDIF}
145 {$IFDEF UNIX}{$IFDEF CPUI386}
146 else if Key = '#PATH_LINUX_I386' then
147 DLLName := BasePath + DirectorySeparator + Value
148 {$ENDIF}{$ENDIF}
149 {$IFDEF UNIX}{$IFDEF CPUAMD64}
150 else if Key = '#PATH_LINUX_AMD64' then
151 DLLName := BasePath + DirectorySeparator + Value
152 {$ENDIF}{$ENDIF}
153 {$IFDEF UNIX}{$IFDEF CPUARM}
154 else if Key = '#PATH_LINUX_ARM32' then
155 DLLName := BasePath + DirectorySeparator + Value
156 {$ENDIF}{$ENDIF}
157 {$IFDEF UNIX}{$IFDEF CPUAARCH64}
158 else if Key = '#PATH_LINUX_ARM64' then
159 DLLName := BasePath + DirectorySeparator + Value
160 {$ENDIF}{$ENDIF}
161 else if Key = '#GAMEVERSION' then
162 for i := 1 to Length(Value) do
163 case Value[i] of
164 '0' .. '9':
165 ServerVersion := ServerVersion and $FFFF00 + ServerVersion and
166 $FF * 10 + ord(Value[i]) - 48;
167 '.':
168 ServerVersion := ServerVersion shl 8;
169 end
170 else if Key = '#CREDITS' then
171 Credits := Value;
172 end;
173 CloseFile(T);
174end;
175
176constructor TBrain.Create;
177begin
178 Picture := TBitmap.Create;
179 Picture.SetSize(64, 64);
180end;
181
182destructor TBrain.Destroy;
183begin
184 FreeAndNil(Picture);
185 inherited;
186end;
187
188{ TBrains }
189
190function TBrains.AddNew: TBrain;
191begin
192 Result := TBrain.Create;
193 Add(Result);
194end;
195
196function TBrains.GetKindCount(Kind: TBrainType): Integer;
197var
198 I: Integer;
199begin
200 Result := 0;
201 for I := 0 to Count - 1 do
202 if Items[I].Kind = Kind then Inc(Result);
203end;
204
205procedure TBrains.GetByKind(Kind: TBrainType; Brains: TBrains);
206var
207 I: Integer;
208begin
209 Brains.Clear;
210 for I := 0 to Count - 1 do
211 if Items[I].Kind = Kind then Brains.Add(Items[I]);
212end;
213
214function TBrains.GetBeginner: TBrain;
215var
216 I: Integer;
217begin
218 I := 0;
219 while (I < Count) and not Items[I].Beginner do Inc(I);
220 if I < Count then Result := Items[I]
221 else Result := nil;
222end;
223
224procedure TBrains.LoadPictures;
225var
226 I: Integer;
227begin
228 for I := 0 to Count - 1 do
229 with Items[I] do LoadPicture;
230end;
231
232end.
233
234
Note: See TracBrowser for help on using the repository browser.