source: tags/1.3.5/Brain.pas

Last change on this file was 592, checked in by chronos, 4 months ago
  • Fixed: Avoided more GTK2 chrashes.
  • Fixed: Build StdAI with O1 optimization level to avoid crash.
  • Modified: Code cleanup.
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, Picture.Width, Picture.Height));
87 Font.Assign(UniFont[ftTiny]);
88 Font.Style := [];
89 Font.Color := $5FDBFF;
90 TextSize := TextExtent(FileName);
91 TextOut((Picture.Width - TextSize.Width) div 2,
92 (Picture.Height - TextSize.Height) div 2, FileName);
93 end;
94 end;
95end;
96
97procedure TBrain.LoadFromFile(AIFileName: string);
98var
99 T: Text;
100 Key: string;
101 Value: string;
102 S: string;
103 BasePath: string;
104 I: Integer;
105begin
106 BasePath := ExtractFileDir(AIFileName);
107 FileName := ExtractFileNameOnly(ExtractFileNameOnly(AIFileName));
108 Name := FileName;
109 DLLName := BasePath + DirectorySeparator + Name + '.dll';
110 Credits := '';
111 Flags := fMultiple;
112 Client := nil;
113 Initialized := False;
114 ServerVersion := 0;
115 if not FileExists(AIFileName) then
116 raise Exception.Create(Format('AI specification file %s not found', [AIFileName]));
117 AssignFile(T, AIFileName);
118 Reset(T);
119 while not EOF(T) do
120 begin
121 ReadLn(T, S);
122 S := Trim(s);
123 if Pos(' ', S) > 0 then begin
124 Key := Copy(S, 1, Pos(' ', S) - 1);
125 Value := Trim(Copy(S, Pos(' ', S) + 1, Length(S)));
126 end else begin
127 Key := S;
128 Value := '';
129 end;
130 if Key = '#NAME' then
131 Name := Value
132 else if Key = '#.NET' then
133 Flags := Flags or fDotNet
134 else if Key = '#BEGINNER' then
135 Beginner := True
136 else if Key = '#PATH' then
137 DLLName := BasePath + DirectorySeparator + Value
138 {$IFDEF WINDOWS}{$IFDEF CPU32}
139 else if Key = '#PATH_WIN32' then
140 DLLName := BasePath + DirectorySeparator + Value
141 {$ENDIF}{$ENDIF}
142 {$IFDEF WINDOWS}{$IFDEF CPU64}
143 else if Key = '#PATH_WIN64' then
144 DLLName := BasePath + DirectorySeparator + Value
145 {$ENDIF}{$ENDIF}
146 {$IFDEF UNIX}{$IFDEF CPUI386}
147 else if Key = '#PATH_LINUX_I386' then
148 DLLName := BasePath + DirectorySeparator + Value
149 {$ENDIF}{$ENDIF}
150 {$IFDEF UNIX}{$IFDEF CPUAMD64}
151 else if Key = '#PATH_LINUX_AMD64' then
152 DLLName := BasePath + DirectorySeparator + Value
153 {$ENDIF}{$ENDIF}
154 {$IFDEF UNIX}{$IFDEF CPUARM}
155 else if Key = '#PATH_LINUX_ARM32' then
156 DLLName := BasePath + DirectorySeparator + Value
157 {$ENDIF}{$ENDIF}
158 {$IFDEF UNIX}{$IFDEF CPUAARCH64}
159 else if Key = '#PATH_LINUX_ARM64' then
160 DLLName := BasePath + DirectorySeparator + Value
161 {$ENDIF}{$ENDIF}
162 else if Key = '#GAMEVERSION' then
163 for I := 1 to Length(Value) do
164 case Value[I] of
165 '0' .. '9':
166 ServerVersion := ServerVersion and $FFFF00 + ServerVersion and
167 $FF * 10 + Ord(Value[I]) - 48;
168 '.':
169 ServerVersion := ServerVersion shl 8;
170 end
171 else if Key = '#CREDITS' then
172 Credits := Value;
173 end;
174 CloseFile(T);
175end;
176
177constructor TBrain.Create;
178begin
179 Picture := TBitmap.Create;
180 Picture.SetSize(64, 64);
181end;
182
183destructor TBrain.Destroy;
184begin
185 FreeAndNil(Picture);
186 inherited;
187end;
188
189{ TBrains }
190
191function TBrains.AddNew: TBrain;
192begin
193 Result := TBrain.Create;
194 Add(Result);
195end;
196
197function TBrains.GetKindCount(Kind: TBrainType): Integer;
198var
199 I: Integer;
200begin
201 Result := 0;
202 for I := 0 to Count - 1 do
203 if Items[I].Kind = Kind then Inc(Result);
204end;
205
206procedure TBrains.GetByKind(Kind: TBrainType; Brains: TBrains);
207var
208 I: Integer;
209begin
210 Brains.Clear;
211 for I := 0 to Count - 1 do
212 if Items[I].Kind = Kind then Brains.Add(Items[I]);
213end;
214
215function TBrains.GetBeginner: TBrain;
216var
217 I: Integer;
218begin
219 I := 0;
220 while (I < Count) and not Items[I].Beginner do Inc(I);
221 if I < Count then Result := Items[I]
222 else Result := nil;
223end;
224
225procedure TBrains.LoadPictures;
226var
227 I: Integer;
228begin
229 for I := 0 to Count - 1 do
230 with Items[I] do LoadPicture;
231end;
232
233end.
234
235
Note: See TracBrowser for help on using the repository browser.