File: UBrain.pas

package info (click to toggle)
c-evo-dh 3.0-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid
  • size: 10,540 kB
  • sloc: pascal: 57,645; xml: 243; makefile: 114; sh: 4
file content (207 lines) | stat: -rw-r--r-- 4,874 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
unit UBrain;

interface

uses
  Classes, SysUtils, Generics.Collections, Graphics, Protocol, LazFileUtils,
  dynlibs, Types;

const
  // module flags
  fMultiple = $10000000;
  fDotNet = $20000000;
  fUsed = $40000000;

type
  TBrainType = (btNoTerm, btSuperVirtual, btTerm, btRandom, btAI, btNetworkServer,
    btNetworkClient);

  { TBrain }

  TBrain = class
    FileName: string;
    DLLName: string;
    Name: string;
    Credits: string; { filename and full name }
    hm: TLibHandle; { module handle }
    Flags: Integer;
    ServerVersion: Integer;
    DataVersion: Integer;
    DataSize: Integer;
    Client: TClientCall; { client function address }
    Initialized: Boolean;
    Kind: TBrainType;
    Picture: TBitmap;
    Beginner: Boolean;
    procedure LoadPicture;
    procedure LoadFromFile(AIFileName: string);
    constructor Create;
    destructor Destroy; override;
  end;

  { TBrains }

  TBrains = class(TObjectList<TBrain>)
    function AddNew: TBrain;
    function GetKindCount(Kind: TBrainType): Integer;
    procedure GetByKind(Kind: TBrainType; Brains: TBrains);
    function GetBeginner: TBrain;
    procedure LoadPictures;
  end;


implementation

uses
  ScreenTools, Directories;

{ TBrain }

procedure TBrain.LoadPicture;
var
  TextSize: TSize;
begin
  if not LoadGraphicFile(Picture, GetAiDir + DirectorySeparator +
    FileName + DirectorySeparator + FileName + '.png', [gfNoError]) then begin
    with Picture.Canvas do begin
      Brush.Color := $904830;
      FillRect(Rect(0, 0, 64, 64));
      Font.Assign(UniFont[ftTiny]);
      Font.Style := [];
      Font.Color := $5FDBFF;
      TextSize := TextExtent(FileName);
      TextOut(32 - TextSize.Width div 2, 32 - TextSize.Height div 2, FileName);
    end;
  end;
end;

procedure TBrain.LoadFromFile(AIFileName: string);
var
  T: Text;
  Key: string;
  Value: string;
  S: string;
  BasePath: string;
  I: Integer;
begin
  BasePath := ExtractFileDir(AIFileName);
  FileName := ExtractFileName(ExtractFileNameWithoutExt(ExtractFileNameWithoutExt(AIFileName)));
  Name := FileName;
  DLLName := BasePath + DirectorySeparator + Name + '.dll';
  Credits := '';
  Flags := fMultiple;
  Client := nil;
  Initialized := false;
  ServerVersion := 0;
  if not FileExists(AIFileName) then
    raise Exception.Create(Format('AI specification file %s not found', [AIFileName]));
  AssignFile(T, AIFileName);
  Reset(T);
  while not EOF(T) do
  begin
    ReadLn(T, s);
    s := trim(s);
    if Pos(' ', S) > 0 then begin
      Key := Copy(S, 1, Pos(' ', S) - 1);
      Value := Trim(Copy(S, Pos(' ', S) + 1, Length(S)));
    end else begin
      Key := S;
      Value := '';
    end;
    if Key = '#NAME' then
      Name := Value
    else if Key = '#.NET' then
      Flags := Flags or fDotNet
    else if Key = '#BEGINNER' then
      Beginner := True
    else if Key = '#PATH' then
      DLLName := BasePath + DirectorySeparator + Value
    {$IFDEF WINDOWS}{$IFDEF CPU32}
    else if Key = '#PATH_WIN32' then
      DLLName := BasePath + DirectorySeparator + Value
    {$ENDIF}{$ENDIF}
    {$IFDEF WINDOWS}{$IFDEF CPU64}
    else if Key = '#PATH_WIN64' then
      DLLName := BasePath + DirectorySeparator + Value
    {$ENDIF}{$ENDIF}
    {$IFDEF UNIX}{$IFDEF CPU32}
    else if Key = '#PATH_LINUX32' then
      DLLName := BasePath + DirectorySeparator + Value
    {$ENDIF}{$ENDIF}
    {$IFDEF UNIX}{$IFDEF CPU64}
    else if Key = '#PATH_LINUX64' then
      DLLName := BasePath + DirectorySeparator + Value
    {$ENDIF}{$ENDIF}
    else if Key = '#GAMEVERSION' then
      for i := 1 to Length(Value) do
        case Value[i] of
          '0' .. '9':
            ServerVersion := ServerVersion and $FFFF00 + ServerVersion and
              $FF * 10 + ord(Value[i]) - 48;
          '.':
          ServerVersion := ServerVersion shl 8;
      end
    else if Key = '#CREDITS' then
      Credits := Value;
  end;
  CloseFile(T);
end;

constructor TBrain.Create;
begin
  Picture := TBitmap.Create;
  Picture.SetSize(64, 64);
end;

destructor TBrain.Destroy;
begin
  FreeAndNil(Picture);
  inherited;
end;

{ TBrains }

function TBrains.AddNew: TBrain;
begin
  Result := TBrain.Create;
  Add(Result);
end;

function TBrains.GetKindCount(Kind: TBrainType): Integer;
var
  I: Integer;
begin
  Result := 0;
  for I := 0 to Count - 1 do
    if Items[I].Kind = Kind then Inc(Result);
end;

procedure TBrains.GetByKind(Kind: TBrainType; Brains: TBrains);
var
  I: Integer;
begin
  Brains.Clear;
  for I := 0 to Count - 1 do
    if Items[I].Kind = Kind then Brains.Add(Items[I]);
end;

function TBrains.GetBeginner: TBrain;
var
  I: Integer;
begin
  I := 0;
  while (I < Count) and not Items[I].Beginner do Inc(I);
  if I < Count then Result := Items[I]
    else Result := nil;
end;

procedure TBrains.LoadPictures;
var
  I: Integer;
begin
  for I := 0 to Count - 1 do
    with Items[I] do LoadPicture;
end;

end.