-
Notifications
You must be signed in to change notification settings - Fork 48
/
Copy pathBaseConflict.Entity.pas
2781 lines (2518 loc) · 104 KB
/
BaseConflict.Entity.pas
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
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
unit BaseConflict.Entity;
interface
uses
Math,
Engine.Math,
Generics.Defaults,
Generics.Collections,
RTTI,
TypInfo,
Engine.Helferlein.Threads,
Engine.Helferlein,
Engine.Helferlein.Windows,
SysUtils,
BaseConflict.Constants,
BaseConflict.Constants.Cards,
Engine.Script,
Engine.Log,
System.Classes,
dwsComp,
dwsExprs,
dwsDataContext,
dwsSymbols,
dwsRttiExposer;
type
ProcEventReadParam0 = function : RParam of object;
ProcEventReadParam1 = function(var Param1 : RParam) : RParam of object;
ProcEventReadParam2 = function(var Param1, Param2 : RParam) : RParam of object;
ProcEventReadParam3 = function(var Param1, Param2, Param3 : RParam) : RParam of object;
ProcEventReadParam4 = function(var Param1, Param2, Param3, Param4 : RParam) : RParam of object;
ProcEventReadParam5 = function(var Param1, Param2, Param3, Param4, Param5 : RParam) : RParam of object;
ProcEventReadParam6 = function(var Param1, Param2, Param3, Param4, Param5, Param6 : RParam) : RParam of object;
ProcEventTriggerParam0 = function : boolean of object;
ProcEventTriggerParam1 = function(var Param1 : RParam) : boolean of object;
ProcEventTriggerParam2 = function(var Param1, Param2 : RParam) : boolean of object;
ProcEventTriggerParam3 = function(var Param1, Param2, Param3 : RParam) : boolean of object;
ProcEventTriggerParam4 = function(var Param1, Param2, Param3, Param4 : RParam) : boolean of object;
ProcEventTriggerParam5 = function(var Param1, Param2, Param3, Param4, Param5 : RParam) : boolean of object;
ProcEventTriggerParam6 = function(var Param1, Param2, Param3, Param4, Param5, Param6 : RParam) : boolean of object;
ERegisterEventException = class(Exception);
EHandleEventException = class(Exception);
REntityComponentClassMap = record
FromClass : TClass;
ToClass : TClass;
end;
EnumParameterSlot = (psSlot0, psSlot1, psSlot2, psSlot3, psSlot4);
SetVarParameter = set of EnumParameterSlot;
{$RTTI EXPLICIT METHODS([vcPublished, vcPublic]) FIELDS([vcPublic, vcProtected])}
{$TYPEINFO ON}
TEntityComponent = class;
{$TYPEINFO OFF}
{$RTTI EXPLICIT METHODS([vcPublished, vcPublic]) FIELDS([vcPublic, vcProtected])}
TEntity = class;
EnumEventPriority = (epFirst, epHigher, epHigh, epMiddle, epLow, epLower, epLast);
EnumEventScope = (esLocal, esGlobal);
EnumEventType = (etRead, etTrigger, etWrite);
REventSpecification = record
Event : EnumEventIdentifier;
EventPriotity : EnumEventPriority;
EventType : EnumEventType;
EventScope : EnumEventScope;
constructor Create(Event : EnumEventIdentifier; EventPriotity : EnumEventPriority; EventType : EnumEventType; EventScope : EnumEventScope);
end;
XEvent = class(TCustomAttribute)
private
FEventSpecification : REventSpecification;
public
constructor Create(Event : EnumEventIdentifier; EventPriotity : EnumEventPriority; EventType : EnumEventType; EventScope : EnumEventScope = esLocal);
end;
XNetworkSerialize = class(TCustomAttribute)
private
FEvent : EnumEventIdentifier;
public
property Event : EnumEventIdentifier read FEvent;
constructor Create(Event : EnumEventIdentifier);
end;
XNetworkBasetype = class(TCustomAttribute);
ENoSubscriberForRead = class(Exception);
{$RTTI EXPLICIT METHODS([]) FIELDS([])}
SetComponentGroup = set of Byte;
/// <summary> Holds a value for every event. Entitylocal pool of values. Will be serialized between
/// Server and Client </summary>
TBlackboard = class
private
function GetValueRaw(Event : EnumEventIdentifier; GroupIndex, Index : integer) : RParam; inline;
procedure SetValueRaw(Event : EnumEventIdentifier; GroupIndex, Index : integer; const Value : RParam); inline;
protected
FOwner : TEntity;
// Values for [Event][GroupIndex][SubIndex]
FValues : array [EnumEventIdentifier] of array of array of RParam;
procedure SaveToStream(Stream : TStream);
procedure LoadFromStream(Stream : TStream);
public
constructor Create(Owner : TEntity);
procedure SetIndexedValue(Event : EnumEventIdentifier; const Group : SetComponentGroup; Index : integer; const Value : RParam);
/// <summary> The global group has index -1. Other indices as usual. If value is not present returns RPARAMEMPTY. </summary>
function GetIndexedValue(Event : EnumEventIdentifier; const Group : SetComponentGroup; Index : integer) : RParam;
procedure SetValue(Event : EnumEventIdentifier; const Group : SetComponentGroup; const Value : RParam);
function GetValue(Event : EnumEventIdentifier; const Group : SetComponentGroup) : RParam; inline;
function GetIndexMap(Event : EnumEventIdentifier; const Group : SetComponentGroup) : TDictionary<integer, RParam>;
procedure DeleteValues(const Group : SetComponentGroup);
end;
TEventbus = class;
TRemoteSubscription = class(TObject)
protected
FTargetEventbus : TEventbus;
FTargetComponent : TEntityComponent;
FComponentFreed : boolean;
FEventbusFreed : boolean;
FEvent : EnumEventIdentifier;
FEventType : EnumEventType;
FEventPriotity : EnumEventPriority;
FRefCounter : integer;
procedure DecRefCounter;
public
constructor Create(TargetComponent : TEntityComponent; TargetEventbus : TEventbus; Event : EnumEventIdentifier; EventType : EnumEventType; EventPriority : EnumEventPriority);
procedure FreeComponent;
procedure FreeEventbus;
destructor Destroy; override;
end;
TEventbus = class
protected
type
PSubscriber = ^RSubscriber;
RSubscriber = record
EntityComponent : TEntityComponent;
Priority : EnumEventPriority;
constructor Create(EntityComponent : TEntityComponent; Priority : EnumEventPriority);
end;
type
TEventhandler = class;
TEventEnumerator = class
strict private
FOwner : TEventhandler;
private
FCurrentlyActive : boolean;
FActiveIndex : integer;
public
constructor Create(Owner : TEventhandler);
function CurrentSubscriber : RSubscriber; inline;
function HasNext : boolean; inline;
procedure Increment; inline;
procedure Decrement; inline;
procedure BeginEvent; inline;
procedure EndEvent; inline;
end;
TEventhandler = class
strict private
ParameterCount : integer;
FEnumerators : TObjectList<TEventEnumerator>;
FEnumeratorIndex : Byte;
private
Subscribers : TList<RSubscriber>;
public
constructor Create(ParameterCount : integer);
procedure AddSubscriber(const Subscriber : RSubscriber);
procedure RemoveSubscriber(const Subscriber : RSubscriber);
function GetEnumerator : TEventEnumerator; inline;
procedure ReleaseEnumerator; inline;
destructor Destroy; override;
end;
var
FOwner : TEntity;
FEventhandler : array [EnumEventIdentifier] of array [EnumEventType] of TEventhandler;
FRemoteSubscriptions : TList<TRemoteSubscription>;
procedure StartEvent(Event : EnumEventIdentifier; const Group : SetComponentGroup); inline;
procedure EndEvent; inline;
public
property Owner : TEntity read FOwner;
constructor Create(Owner : TEntity);
/// <summary> Reads a value in the local group and if empty is returned, read in the global group. </summary>
function ReadHierarchic(Eventname : EnumEventIdentifier; const Values : TArray<RParam>; const Group : SetComponentGroup) : RParam;
function Read(Eventname : EnumEventIdentifier; Parameters : array of RParam; const Group : SetComponentGroup = []; ComponentID : integer = 0) : RParam;
procedure Trigger(Eventname : EnumEventIdentifier; Values : array of RParam; const Group : SetComponentGroup = []; ComponentID : integer = 0; Write : boolean = False);
procedure InvokeWithRawData(Eventname : EnumEventIdentifier; const Group : SetComponentGroup; ComponentID : integer; const ValuesAsRawData : TArray<Byte>; WriteEvent : boolean);
procedure Write(Eventname : EnumEventIdentifier; const Values : array of RParam; const Group : SetComponentGroup = []; ComponentID : integer = 0);
procedure Subscribe(Eventname : EnumEventIdentifier; EventType : EnumEventType; Priority : EnumEventPriority; EntityCompononent : TEntityComponent; ParameterCount : integer);
/// <summary> Subscribe one remote eventbus and return class to manage subscription.</summary>
procedure SubscribeRemote(Eventname : EnumEventIdentifier; EventType : EnumEventType; Priority : EnumEventPriority; EntityCompononent : TEntityComponent; const MethodName : string; ParameterCount : integer; NetworkSender : EnumNetworkSender = nsNone);
procedure Unsubscribe(Eventname : EnumEventIdentifier; EventType : EnumEventType; Priority : EnumEventPriority; EntityComponent : TEntityComponent);
destructor Destroy; override;
end;
ProcEnumerateEntityComponentCallback = reference to procedure(Component : TEntityComponent);
TEntityComponent = class
private
type
RSubscriptionPattern = record
EventSpecification : REventSpecification;
EventHandler : Pointer;
ParameterLength : integer;
constructor Create(const EventSpecification : REventSpecification; EventHandler : Pointer; ParameterLength : integer);
end;
TSubscribedEvent = class
private
Eventname : EnumEventIdentifier;
EventType : EnumEventType;
EventPriority : EnumEventPriority;
EventHandler : Pointer;
ParameterCount : integer;
TargetEventbus : TEventbus;
public
constructor Create(Eventname : EnumEventIdentifier; EventHandler : Pointer; ParameterCount : integer; TargetEventbus : TEventbus; EventPriority : EnumEventPriority; EventType : EnumEventType);
end;
strict private
[ScriptExcludeMember]
FComponentGroup : SetComponentGroup;
class var FComponentSubscriptionPatterns : TThreadSafeObjectDictionary<TClass, TList<RSubscriptionPattern>>;
private
FRttiContext : TRttiContext;
FSubscribedEvents : array [EnumEventIdentifier] of array [EnumEventType] of TObjectList<TSubscribedEvent>;
FRemoteSubscription : TList<TRemoteSubscription>;
function LookUpSubscribedEvent(Caller : TEventbus; ei : EnumEventIdentifier; et : EnumEventType) : TSubscribedEvent;
procedure DeploySubscribedEvent(Event : TSubscribedEvent);
procedure DeleteSubscribedEvent(Event : TSubscribedEvent);
procedure ExtractSubscribedEvent(Event : TSubscribedEvent);
function OnRead(Caller : TEventbus; Event : EnumEventIdentifier; var Parameters : array of RParam; var ResultFromAncestor : RParam) : RParam;
function OnTrigger(Caller : TEventbus; Event : EnumEventIdentifier; var Parameters : array of RParam; Write : boolean) : boolean; virtual;
/// <summary> Look for published methods with an XEvent-Attribute and subscribe them to their events. If more than one XEvent
/// attribute is present, the first one will be chosen and the rest will be dropped. </summary>
procedure SubscribeEvents; virtual;
procedure SubscribeEvent(Event : EnumEventIdentifier; EventType : EnumEventType; EventPriority : EnumEventPriority; EventHandler : Pointer; ParameterCount : integer; TargetEventbus : TEventbus);
procedure UnSubscribeEvents; virtual;
procedure SetSetComponentGroup(const Value : SetComponentGroup);
procedure RegisterInOwner;
procedure DeregisterInOwner;
protected
FOwner : TEntity;
/// <summary> Unique ID for component related to owner entity NOT global. </summary>
FUniqueID : integer;
// Eventbus of the Owner
function Eventbus : TEventbus;
function GlobalEventbus : TEventbus;
function BuildExceptionMessage(const ExceptionMessage : string) : string; overload;
function BuildExceptionMessage(const ExceptionMessage : string; const FormatParameters : array of const) : string; overload;
procedure MakeException(const ExceptionMessage : string); overload;
procedure MakeException(const ExceptionMessage : string; const FormatParameters : array of const); overload;
procedure ComponentFree; virtual;
procedure BeforeComponentFree; virtual;
procedure EnumerateComponents(Callback : ProcEnumerateEntityComponentCallback); virtual;
/// <summary> Use to free component in an event stack. </summary>
procedure DeferFree;
/// <summary> Returns whether the caller belongs to my own group. Prevents execution of groupless events in local groups. </summary>
function IsLocalCall : boolean; overload;
function IsLocalCall(const TargetGroup : SetComponentGroup) : boolean; overload;
published
[XEvent(eiEnumerateComponents, epLast, etTrigger)]
function OnEnumerate(const Callback : RParam) : boolean;
[XEvent(eiBeforeFree, epLast, etTrigger)]
function OnBeforeComponentFree() : boolean;
[XEvent(eiFree, epLast, etTrigger)]
function OnComponentFree() : boolean;
public
property Owner : TEntity read FOwner;
property UniqueID : integer read FUniqueID;
[ScriptExcludeMember]
property ComponentGroup : SetComponentGroup read FComponentGroup write SetSetComponentGroup;
/// <summary> Shortcut to read resource reCardLevel. </summary>
function CardLevel() : integer;
/// <summary> Shortcut to read resource reCardLeague. </summary>
function CardLeague() : integer;
constructor Create(Owner : TEntity); virtual;
constructor CreateGrouped(Owner : TEntity; Group : TArray<Byte>); virtual;
constructor CreateGroupedAll(Owner : TEntity); virtual;
procedure ChangeEventPriority(Eventname : EnumEventIdentifier; EventType : EnumEventType; Priority : EnumEventPriority; Scope : EnumEventScope = esLocal);
destructor Destroy; override;
class constructor Create;
class destructor Destroy;
end;
CEntityComponent = class of TEntityComponent;
{$RTTI INHERIT}
TSerializableEntityComponent = class(TEntityComponent)
protected
function GetBaseType(AType : TRttiType) : TRttiType;
public
/// <summary> Load all data with Rtti from stream. Only called on clients</summary>
[ScriptExcludeMember]
procedure Deserialize(Stream : TStream);
published
/// <summary> save all data with Rtti to stream. Only called on server</summary>
[ScriptExcludeMember]
[XEvent(eiSerialize, epLast, etTrigger)]
function Serialize(const Stream : RParam) : boolean;
end;
CSerializableEntityComponent = class of TSerializableEntityComponent;
ProcEntityInitializer = reference to procedure(Entity : TEntity);
TEntity = class
strict private
FCollisionRadius : single;
FPosition, FFront : RVector2;
{$IFDEF CLIENT}
FDisplayPosition, FDisplayFront, FDisplayUp : RVector3;
{$ENDIF}
procedure SetFront(const Value : RVector2);
procedure SetPosition(const Value : RVector2);
class function CreateFromScriptProc(const PatternFileName, ProcName : string; GlobalEventbus : TEventbus; const Initializer : ProcEntityInitializer = nil; IsMeta : boolean = False; FileNameOverride : string = '') : TEntity; static;
protected
const
RESERVED_GROUPS = 20; // reserve the first n groups, so the user can hardcode something
var
FEventbus : TEventbus;
FGlobalEventbus : TEventbus;
FBlackboard : TBlackboard;
FAbstract : boolean;
FID : integer;
FCreatedTimestamp : int64;
FScriptFile, FUID, FSkinID : string;
FCurrentComponentID : integer;
// Count of entity components in each group. If 0 group is free to use, if <0 group is reserved by someone
FGroupsInUse : TList<integer>;
function GetID : integer;
function GetNewComponentID : integer;
procedure RegisterComponent(EntityComponent : TEntityComponent);
procedure DeregisterComponent(EntityComponent : TEntityComponent);
public
property ID : integer read GetID write FID;
property UID : string read FUID write FUID;
property ScriptFile : string read FScriptFile write FScriptFile;
/// <summary> Same as ScriptFile, but without file path and extension. </summary>
function ScriptFileName : string;
/// <summary>The local eventbus of this entity.</summary>
property Eventbus : TEventbus read FEventbus;
property Blackboard : TBlackboard read FBlackboard;
property GlobalEventbus : TEventbus read FGlobalEventbus;
/// <summary> Determines whether entity is a final entity in world or only abstract. </summary>
property IsAbstract : boolean read FAbstract write FAbstract;
property CreatedTimestamp : int64 read FCreatedTimestamp;
property SkinID : string read FSkinID write FSkinID;
function SkinFileSuffix : string;
function HasSkin : boolean;
[ScriptExcludeMember]
function GetSkinID(const ComponentGroup : SetComponentGroup) : string;
[ScriptExcludeMember]
function GetSkinFileSuffix(const ComponentGroup : SetComponentGroup) : string;
[ScriptExcludeMember]
property Position : RVector2 read FPosition write SetPosition;
[ScriptExcludeMember]
property Front : RVector2 read FFront write SetFront;
{$IFDEF CLIENT}
[ScriptExcludeMember]
property DisplayPosition : RVector3 read FDisplayPosition write FDisplayPosition;
[ScriptExcludeMember]
property DisplayFront : RVector3 read FDisplayFront write FDisplayFront;
[ScriptExcludeMember]
property DisplayUp : RVector3 read FDisplayUp write FDisplayUp;
{$ENDIF}
property CollisionRadius : single read FCollisionRadius write FCollisionRadius;
/// <summary>Creates the entity. Now components can be added.</summary>
constructor Create(GlobalEventbus : TEventbus; ID : integer = 0);
class function CreateFromScript(const PatternFileName : string; GlobalEventbus : TEventbus) : TEntity; overload; static;
[ScriptExcludeMember]
class function CreateFromScript(const PatternFileName : string; GlobalEventbus : TEventbus; const Initializer : ProcEntityInitializer) : TEntity; overload; static;
[ScriptExcludeMember]
class function CreateMetaFromScript(const PatternFileName : string; GlobalEventbus : TEventbus; const Initializer : ProcEntityInitializer) : TEntity; static;
[ScriptExcludeMember]
class function CreateDataFromScript(const PatternFileName : string; GlobalEventbus : TEventbus; const Initializer : ProcEntityInitializer) : TEntity; static;
[ScriptExcludeMember]
procedure ApplyScript(ScriptFileName : string; ProcName : string = ''; Parameters : TArray<TValue> = nil);
[ScriptExcludeMember]
function ApplyScriptReturnGroups(const ScriptFileName : string; const ProcName : string = '') : SetComponentGroup;
/// <summary> Reserves a unused group for further usage. The first component placed in this group will free
/// the reserved state. So if killed the group is free for next use. </summary>
function ReserveFreeGroup : Byte;
/// <summary> Release all content of the groups and unreserves them. </summary>
[ScriptExcludeMember]
procedure FreeGroups(const Groups : SetComponentGroup);
/// <summary>Registers the entity in the game. Should be called after adding the components.</summary>
procedure Deploy;
[ScriptExcludeMember]
procedure Serialize(Stream : TStream);
/// <summary> Creates an entity with the serialized components. Won't be deployed. </summary>
[ScriptExcludeMember]
class function Deserialize(EntityID : integer; Stream : TStream; GlobalEventbus : TEventbus; const ClassMap : TArray<REntityComponentClassMap>) : TEntity; static;
[ScriptExcludeMember]
/// <summary> Shortcut to read unit properties from eventbus. </summary>
function UnitProperties : SetUnitProperty; inline;
[ScriptExcludeMember]
/// <summary> Shortcut to read unit data from blackboads. </summary>
function UnitData(const DataType : EnumUnitData) : RParam; inline;
/// <summary> Shortcut to read resource balance from eventbus. </summary>
function BalanceInt(const ResourceType : EnumResource) : integer; overload; inline;
/// <summary> Shortcut to read resource balance from eventbus. </summary>
function BalanceSingle(const ResourceType : EnumResource) : single; overload; inline;
[ScriptExcludeMember]
/// <summary> Shortcut to read resource balance from eventbus. </summary>
function Balance(const ResourceType : EnumResource) : RParam; overload; inline;
[ScriptExcludeMember]
/// <summary> Shortcut to read resource balance from eventbus. </summary>
function Balance(const ResourceType : EnumResource; const Group : SetComponentGroup) : RParam; overload; inline;
/// <summary> Shortcut to read resource cap from eventbus. </summary>
function CapSingle(const ResourceType : EnumResource) : single; inline;
[ScriptExcludeMember]
/// <summary> Shortcut to read resource cap from eventbus. </summary>
function Cap(const ResourceType : EnumResource) : RParam; overload; inline;
[ScriptExcludeMember]
/// <summary> Shortcut to read resource cap from eventbus. </summary>
function Cap(const ResourceType : EnumResource; const Group : SetComponentGroup) : RParam; overload; inline;
[ScriptExcludeMember]
/// <summary> Shortcut to read resource fill percentage from eventbus. </summary>
function ResFill(const ResourceType : EnumResource) : single; overload; inline;
[ScriptExcludeMember]
/// <summary> Shortcut to read resource fill percentage from eventbus. </summary>
function ResFill(const ResourceType : EnumResource; const Group : SetComponentGroup) : single; overload; inline;
[ScriptExcludeMember]
/// <summary> Shortcut to read teamid from eventbus. </summary>
function TeamID() : integer; inline;
[ScriptExcludeMember]
/// <summary> Shortcut to read owner commander id from eventbus. </summary>
function CommanderID() : integer; inline;
[ScriptExcludeMember]
function OwningCommander : TEntity;
/// <summary> Returns whether this unit has this property or not. </summary>
function HasUnitProperty(UnitProperty : EnumUnitProperty) : boolean;
/// <summary> Returns whether the main weapon of this unit has this type or not. </summary>
function HasDamageType(DamageType : EnumDamageType) : boolean;
/// <summary> Shortcut to read coloridentity from eventbus. </summary>
function ColorIdentity() : integer; overload;
function ColorIdentity(Group : TArray<Byte>) : integer; overload;
/// <summary> Shortcut to read collisionradius from eventbus. </summary>
function ReadCollisionRadius(Group : TArray<Byte>) : single; overload;
/// <summary> Shortcut to read resource reCardLevel. </summary>
function CardLevel() : integer; overload;
function CardLevel(Group : Byte) : integer; overload;
function CardLevel(Group : TArray<Byte>) : integer; overload;
/// <summary> Shortcut to read resource reCardLeague. </summary>
function CardLeague() : integer; overload;
function CardLeague(Group : Byte) : integer; overload;
function CardLeague(Group : TArray<Byte>) : integer; overload;
/// <summary> Adds the groups to be removed by the entity manager. </summary>
procedure RemoveGroups(const Groups : TArray<Byte>);
procedure DeferFree;
destructor Destroy; override;
end;
REventInformation = record
EventIdentifier : EnumEventIdentifier;
CalledToGroup : SetComponentGroup;
end;
function ByteArrayToComponentGroup(const inArray : TArray<Byte>) : SetComponentGroup;
function IntArrayToComponentGroup(const inArray : TArray<integer>) : SetComponentGroup;
function ComponentGroupToByteArray(const inSet : SetComponentGroup) : TArray<Byte>;
const
ALLGROUP_INDEX : Byte = 255;
ALLGROUP : SetComponentGroup = [255];
{$RTTI EXPLICIT METHODS([vcPublic, vcPublished]) PROPERTIES([vcPublic, vcPublished]) FIELDS([vcPrivate, vcProtected, vcPublic])}
threadvar
/// <summary> Holds information about the currently executing event. </summary>
CurrentEvent : REventInformation;
threadvar
Eventstack : TFastStack<REventInformation>;
implementation
uses
BaseConflict.Globals,
BaseConflict.Game,
BaseConflict.Classes.Shared,
BaseConflict.EntityComponents.Shared;
{ TEntity }
function TEntity.Cap(const ResourceType : EnumResource) : RParam;
begin
Result := Eventbus.Read(eiResourceCap, [ord(ResourceType)]);
end;
function TEntity.CardLeague : integer;
begin
Result := Eventbus.Read(eiResourceBalance, [ord(reCardLeague)]).AsInteger;
end;
function TEntity.CardLeague(Group : Byte) : integer;
begin
Result := Eventbus.ReadHierarchic(eiResourceBalance, [ord(reCardLeague)], [Group]).AsInteger;
end;
function TEntity.Cap(const ResourceType : EnumResource; const Group : SetComponentGroup) : RParam;
begin
Result := Eventbus.ReadHierarchic(eiResourceCap, [ord(ResourceType)], Group);
end;
function TEntity.CapSingle(const ResourceType: EnumResource): single;
begin
result := Cap(ResourceType).AsSingle;
end;
function TEntity.CardLeague(Group : TArray<Byte>) : integer;
begin
Result := Eventbus.ReadHierarchic(eiResourceBalance, [ord(reCardLeague)], ByteArrayToComponentGroup(Group)).AsInteger;
end;
function TEntity.CardLevel(Group : Byte) : integer;
begin
Result := Eventbus.Read(eiResourceBalance, [ord(reCardLevel)], [Group]).AsInteger;
end;
function TEntity.CardLevel(Group : TArray<Byte>) : integer;
begin
Result := Eventbus.Read(eiResourceBalance, [ord(reCardLevel)], ByteArrayToComponentGroup(Group)).AsInteger;
end;
function TEntity.CardLevel : integer;
begin
Result := Eventbus.Read(eiResourceBalance, [ord(reCardLevel)]).AsInteger;
end;
function TEntity.ColorIdentity : integer;
begin
Result := ord(Eventbus.Read(eiColorIdentity, []).AsEnumType<EnumEntityColor>);
end;
function TEntity.ReadCollisionRadius(Group : TArray<Byte>) : single;
begin
Result := Eventbus.Read(eiCollisionRadius, [], ByteArrayToComponentGroup(Group)).AsSingle;
end;
function TEntity.ColorIdentity(Group : TArray<Byte>) : integer;
begin
Result := ord(Eventbus.Read(eiColorIdentity, [], ByteArrayToComponentGroup(Group)).AsEnumType<EnumEntityColor>);
end;
function TEntity.CommanderID : integer;
begin
Result := Eventbus.Read(eiOwnerCommander, []).AsInteger;
end;
constructor TEntity.Create(GlobalEventbus : TEventbus; ID : integer = 0);
begin
FID := ID;
FEventbus := TEventbus.Create(self);
FGlobalEventbus := GlobalEventbus;
FBlackboard := TBlackboard.Create(self);
FGroupsInUse := TList<integer>.Create;
FCreatedTimestamp := TimeManager.GetTimeStamp;
{$IFDEF SERVER}FCurrentComponentID := low(integer); {$ENDIF}
{$IFDEF CLIENT}FCurrentComponentID := high(integer); {$ENDIF}
TResourceManagerComponent.CreateGroupedAll(self);
end;
class function TEntity.CreateDataFromScript(const PatternFileName : string; GlobalEventbus : TEventbus; const Initializer : ProcEntityInitializer) : TEntity;
begin
Result := CreateFromScriptProc(PatternFileName, 'CreateData', GlobalEventbus, Initializer, True);
end;
class function TEntity.CreateFromScript(const PatternFileName : string; GlobalEventbus : TEventbus) : TEntity;
begin
Result := CreateFromScript(PatternFileName, GlobalEventbus, nil);
end;
class function TEntity.CreateFromScript(const PatternFileName : string; GlobalEventbus : TEventbus; const Initializer : ProcEntityInitializer) : TEntity;
begin
Result := CreateFromScriptProc(PatternFileName, 'CreateEntity', GlobalEventbus, Initializer);
end;
class function TEntity.CreateFromScriptProc(const PatternFileName, ProcName : string; GlobalEventbus : TEventbus; const Initializer : ProcEntityInitializer; IsMeta : boolean; FileNameOverride : string) : TEntity;
var
EntityPattern : TScript;
ScriptFilePath, ParentScriptFilePath, FinalScriptFilename : string;
begin
if FileNameOverride = '' then FinalScriptFilename := PatternFileName
else FinalScriptFilename := FileNameOverride;
ScriptFilePath := AbsolutePath('scripts\' + PatternFileName);
if ExtractFileExt(ScriptFilePath) = '' then ScriptFilePath := ScriptFilePath + FILE_EXTENSION_ENTITY;
EntityPattern := ScriptManager.CompileScriptFromFile(ScriptFilePath); // checks file exist
EntityPattern.RunMain; // init global variables of the script
EntityPattern.SetGlobalVariableValueIfExist<TEventbus>('GlobalEventbus', GlobalEventbus);
EntityPattern.SetGlobalVariableValueIfExist<TGame>('Game', Game);
// if script file inherits from another script, initialize the entity with that file and afterwards
// run our script over this entity
if EntityPattern.TryGetGlobalVariableValue<string>(SCRIPT_INHERIT_VAR_NAME, ParentScriptFilePath) then
begin
Result := TEntity.CreateFromScriptProc(ParentScriptFilePath, ProcName, GlobalEventbus, Initializer, IsMeta, FinalScriptFilename);
end
else
if EntityPattern.TryGetGlobalVariableValue<string>(SCRIPT_INHERIT_PRECEDING_VAR_NAME, ParentScriptFilePath) then
begin
Result := TEntity.CreateFromScriptProc(ParentScriptFilePath, ProcName, GlobalEventbus,
procedure(Entity : TEntity)
begin
if assigned(Initializer) then Initializer(Entity);
EntityPattern.ExecuteFunction(ProcName, [TValue.From<TEntity>(Entity)], nil);
end,
IsMeta, FinalScriptFilename);
Result.ScriptFile := FinalScriptFilename;
EntityPattern.Free;
exit;
end
else
begin
// only base script file runs initilization methods
Result := TEntity.Create(GlobalEventbus, 0);
Result.IsAbstract := IsMeta;
if assigned(Initializer) then Initializer(Result);
end;
Result.ScriptFile := FinalScriptFilename;
EntityPattern.ExecuteFunction(ProcName, [TValue.From<TEntity>(Result)], nil);
EntityPattern.Free;
end;
procedure TEntity.ApplyScript(ScriptFileName : string; ProcName : string; Parameters : TArray<TValue>);
var
Script : TScript;
begin
if ProcName = '' then ProcName := 'Apply';
if not HFilepathManager.IsAbsolute(ScriptFileName) and not ScriptFileName.StartsWith(PATH_SCRIPT) then ScriptFileName := PATH_SCRIPT + ScriptFileName;
Script := ScriptManager.CompileScriptFromFile(AbsolutePath(ScriptFileName));
Script.RunMain; // init global variables of the script
Script.SetGlobalVariableValueIfExist<TEventbus>('GlobalEventbus', GlobalEventbus);
Script.SetGlobalVariableValueIfExist<TGame>('Game', Game);
if assigned(Parameters) then Script.ExecuteFunction(ProcName, Parameters, nil)
else
Script.ExecuteFunction(ProcName, [TValue.From<TEntity>(self)], nil);
Script.Free;
end;
function TEntity.ApplyScriptReturnGroups(const ScriptFileName, ProcName : string) : SetComponentGroup;
var
finalProcName : string;
Script : TScript;
ReturnValue : TValue;
arr : TArray<integer>;
barr : TArray<Byte>;
begin
if ProcName = '' then finalProcName := 'Apply'
else finalProcName := ProcName;
Script := ScriptManager.CompileScriptFromFile(FormatDateiPfad('scripts\' + ScriptFileName));
Script.RunMain; // init global variables of the script
Script.SetGlobalVariableValueIfExist<TEventbus>('GlobalEventbus', GlobalEventbus);
Script.SetGlobalVariableValueIfExist<TGame>('Game', Game);
ReturnValue := Script.ExecuteFunction(finalProcName, [TValue.From<TEntity>(self)], TypeInfo(TArray<integer>));
if ReturnValue.IsEmpty or not ReturnValue.IsArray then
Result := []
else
begin
arr := ReturnValue.AsType<TArray<integer>>;
barr := HArray.Map<integer, Byte>(arr,
function(const int : integer) : Byte
begin
Result := int;
end);
Result := ByteArrayToComponentGroup(barr);
end;
Script.Free;
end;
function TEntity.Balance(const ResourceType : EnumResource; const Group : SetComponentGroup) : RParam;
begin
Result := Eventbus.ReadHierarchic(eiResourceBalance, [ord(ResourceType)], Group);
end;
function TEntity.BalanceInt(const ResourceType : EnumResource) : integer;
begin
Result := Eventbus.Read(eiResourceBalance, [ord(ResourceType)]).AsInteger;
end;
function TEntity.BalanceSingle(const ResourceType : EnumResource) : single;
begin
Result := Eventbus.Read(eiResourceBalance, [ord(ResourceType)]).AsSingle;
end;
function TEntity.Balance(const ResourceType : EnumResource) : RParam;
begin
Result := Eventbus.Read(eiResourceBalance, [ord(ResourceType)]);
end;
class function TEntity.CreateMetaFromScript(const PatternFileName : string; GlobalEventbus : TEventbus; const Initializer : ProcEntityInitializer) : TEntity;
begin
Result := CreateFromScriptProc(PatternFileName, 'CreateMeta', GlobalEventbus, Initializer, True);
end;
procedure TEntity.DeferFree;
begin
if assigned(Game) and assigned(Game.EntityManager) then
Game.EntityManager.FreeEntity(self)
else
self.Free;
end;
procedure TEntity.Deploy;
begin
FGlobalEventbus.Trigger(eiNewEntity, [self]);
Eventbus.Trigger(eiDeploy, []);
end;
class function TEntity.Deserialize(EntityID : integer; Stream : TStream; GlobalEventbus : TEventbus; const ClassMap : TArray<REntityComponentClassMap>) : TEntity;
function MapClass(AClass : TClass) : TClass;
var
i : integer;
begin
// default value no mapping found use class as is
Result := AClass;
for i := 0 to length(ClassMap) - 1 do
if ClassMap[i].FromClass = AClass then exit(ClassMap[i].ToClass);
end;
var
QualifiedName, ScriptFile, SkinID, UID : string;
RttiContext : TRttiContext;
RttiType : TRttiInstanceType;
Field : TRttiField;
Value : TValue;
EntityComponent : TSerializableEntityComponent;
Attributes : TArray<TCustomAttribute>;
SerializeAttribute : XNetworkSerialize;
BlackboardStreamPosition : int64;
begin
RttiContext := TRttiContext.Create;
ScriptFile := Stream.ReadString;
SkinID := Stream.ReadString;
UID := Stream.ReadString;
BlackboardStreamPosition := Stream.Position;
Result := TEntity.CreateFromScript(
ScriptFile,
GlobalEventbus,
procedure(Entity : TEntity)
begin
Entity.SkinID := SkinID;
// init all values set by the server to the entity, so all components have access to them
Entity.Blackboard.LoadFromStream(Stream);
end);
// now override all values already overwritten by the server, but set by the creation script
Stream.Position := BlackboardStreamPosition;
Result.Blackboard.LoadFromStream(Stream);
Result.FID := EntityID;
Result.UID := UID;
while Stream.Position < Stream.Size do
begin
QualifiedName := Stream.ReadString;
RttiType := RttiContext.FindType(QualifiedName).AsInstance;
if not assigned(RttiType) then raise Exception.Create('TEntity.DeSerialize: Can''t find typeinfo for type "' + QualifiedName + '"');
assert(RttiType.MetaclassType.InheritsFrom(TSerializableEntityComponent));
EntityComponent := CSerializableEntityComponent(MapClass(RttiType.MetaclassType)).Create(Result);
EntityComponent.Deserialize(Stream);
for Field in RttiType.GetFields do
begin
Attributes := Field.GetAttributes;
SerializeAttribute := XNetworkSerialize(HRtti.SearchForAttribute(XNetworkSerialize, Attributes));
if SerializeAttribute <> nil then
begin
Value := Field.GetValue(EntityComponent);
Result.Eventbus.Write(SerializeAttribute.Event, [RParam.FromTValue(Value)]);
end;
end;
end;
RttiContext.Free;
end;
function TEntity.ScriptFileName : string;
begin
Result := ChangeFileExt(ExtractFileName(ScriptFile), '');
end;
procedure TEntity.Serialize(Stream : TStream);
begin
Stream.WriteData(FID);
Stream.WriteString(FScriptFile);
Stream.WriteString(FSkinID);
Stream.WriteString(FUID);
Blackboard.SaveToStream(Stream);
Eventbus.Trigger(eiSerialize, [Stream]);
end;
procedure TEntity.SetFront(const Value : RVector2);
begin
FFront := Value;
Eventbus.Write(eiFront, [Value]);
end;
procedure TEntity.SetPosition(const Value : RVector2);
begin
FPosition := Value;
Eventbus.Write(eiPosition, [Value]);
end;
function TEntity.SkinFileSuffix : string;
begin
if HasSkin then
Result := '_' + FSkinID
else
Result := '';
end;
function TEntity.TeamID : integer;
begin
Result := Eventbus.Read(eiTeamID, []).AsInteger;
end;
function TEntity.UnitData(const DataType : EnumUnitData) : RParam;
begin
Result := Blackboard.GetIndexedValue(eiUnitData, [], ord(DataType));
end;
function TEntity.UnitProperties : SetUnitProperty;
begin
Result := Eventbus.Read(eiUnitProperties, []).AsSetType<SetUnitProperty>;
end;
destructor TEntity.Destroy;
begin
FEventbus.Trigger(eiBeforeFree, []);
FEventbus.Trigger(eiFree, []);
FEventbus.Free;
FBlackboard.Free;
FGroupsInUse.Free;
inherited;
end;
procedure TEntity.FreeGroups(const Groups : SetComponentGroup);
var
i : integer;
cg : SetComponentGroup;
begin
Eventbus.Trigger(eiBeforeFree, [], Groups);
Eventbus.Trigger(eiFree, [], Groups);
Blackboard.DeleteValues(Groups);
cg := Groups;
for i in Groups do
begin
if FGroupsInUse.Count > i then
begin
assert(FGroupsInUse[i] <= 0, 'TEntity.FreeGroups: Some components seems to ignore to call to free them. After freeing a group it is still in use.');
FGroupsInUse[i] := 0;
end;
end;
end;
function TEntity.GetID : integer;
begin
if assigned(self) then Result := FID
else Result := -1;
end;
function TEntity.GetNewComponentID : integer;
begin
Result := FCurrentComponentID;
{$IFDEF SERVER}inc(FCurrentComponentID); {$ENDIF}
{$IFDEF CLIENT}dec(FCurrentComponentID); {$ENDIF}
end;
function TEntity.GetSkinFileSuffix(const ComponentGroup : SetComponentGroup) : string;
begin
Result := GetSkinID(ComponentGroup);
if Result <> '' then
Result := '_' + Result;
end;
function TEntity.GetSkinID(const ComponentGroup : SetComponentGroup) : string;
begin
Result := Eventbus.ReadHierarchic(eiSkinIdentifier, [], ComponentGroup).AsString;
if Result = '' then
Result := SkinID;
end;
function TEntity.HasDamageType(DamageType : EnumDamageType) : boolean;
begin
Result := DamageType in Eventbus.Read(eiDamageType, [], [GROUP_MAINWEAPON]).AsType<SetDamageType>;
end;
function TEntity.HasSkin : boolean;
begin
Result := FSkinID <> '';
end;
function TEntity.HasUnitProperty(UnitProperty : EnumUnitProperty) : boolean;
begin
Result := UnitProperty in Eventbus.Read(eiUnitProperties, []).AsSetType<SetUnitProperty>;
end;
function TEntity.OwningCommander : TEntity;
begin
if not assigned(Game) or not Game.EntityManager.TryGetEntityByID(CommanderID, Result) then
Result := nil;;
end;
procedure TEntity.RegisterComponent(EntityComponent : TEntityComponent);
var
i : integer;
begin
if EntityComponent.ComponentGroup = ALLGROUP then exit;
for i in EntityComponent.ComponentGroup do
begin
while FGroupsInUse.Count <= i do FGroupsInUse.Add(0);
// if group is reserved, first component dereserves it
if FGroupsInUse[i] < 0 then FGroupsInUse[i] := 0;
FGroupsInUse[i] := FGroupsInUse[i] + 1;
end;
end;
procedure TEntity.RemoveGroups(const Groups : TArray<Byte>);
begin
GlobalEventbus.Trigger(eiRemoveComponentGroup, [ID, RParam.From<SetComponentGroup>(ByteArrayToComponentGroup(Groups))]);
end;
procedure TEntity.DeregisterComponent(EntityComponent : TEntityComponent);
var
i : integer;
begin
if EntityComponent.ComponentGroup = ALLGROUP then exit;
for i in EntityComponent.ComponentGroup do
begin
assert(FGroupsInUse.Count > i, 'TEntity.DeregisterComponent: Some component seems to deregister but never registered or changed its group without notifing the entity.');
FGroupsInUse[i] := FGroupsInUse[i] - 1;
end;
end;
function TEntity.ReserveFreeGroup : Byte;
var
i : Byte;
begin
for i := RESERVED_GROUPS - 1 to high(Byte) do
begin
while FGroupsInUse.Count <= i do FGroupsInUse.Add(0);
if FGroupsInUse[i] = 0 then
begin
// reserve group
FGroupsInUse[i] := -1;
if i > 200 then
NOOP;
exit(i);
end;
end;
// should never happen, except we exaggerate with buffs (256 groups are filled up = ~ 128 Buffs)
raise EOutOfResources.Create('TEntity.ReserveFreeGroup: Could not find free group!');
end;
function TEntity.ResFill(const ResourceType : EnumResource; const Group : SetComponentGroup) : single;
begin
if ResourceType in RES_INT_RESOURCES then
Result := Balance(ResourceType, Group).AsInteger / Cap(ResourceType, Group).AsInteger
else
Result := Balance(ResourceType, Group).AsSingle / Cap(ResourceType, Group).AsSingle;
end;
function TEntity.ResFill(const ResourceType : EnumResource) : single;
begin
if ResourceType in RES_INT_RESOURCES then
Result := Balance(ResourceType).AsInteger / Cap(ResourceType).AsInteger
else
Result := Balance(ResourceType).AsSingle / Cap(ResourceType).AsSingle;
end;
{ TEventbus }
constructor TEventbus.Create(Owner : TEntity);
begin
FOwner := Owner;
FRemoteSubscriptions := TList<TRemoteSubscription>.Create;
end;
destructor TEventbus.Destroy;
var
ei : EnumEventIdentifier;