source: tags/1.3.1/UBrain.pas

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