pascal-libraries/messageport.pas at main · Hixie/pascal-libraries · GitHub

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
{$MODE OBJFPC} { -*- delphi -*- }
{$INCLUDE settings.inc}
unit messageport;

{$DEFINE TESTS}

interface

type
   generic TMessagePort<T> = class abstract
   strict private
      FOther: specialize TMessagePort<T>;
      function IsConnected(): Boolean; inline;
   protected
      constructor Create(); virtual;
      class procedure CreateChannel(out A, B);
      property Other: specialize TMessagePort<T> read FOther;
      procedure Send(Message: T);
      procedure HandleMessage(Message: T); virtual; abstract;
      procedure Disconnect(); virtual;
   public
      destructor Destroy(); override;
      property Connected: Boolean read IsConnected;
   end;

   generic TCustomMessagePort<T> = class(specialize TMessagePort<T>)
   public
      type
         TMessageCallback = procedure (Port: specialize TCustomMessagePort<T>; Message: T) of object;
         TDisconnectCallback = procedure (Port: specialize TCustomMessagePort<T>) of object;
   private
      FOnMessage: TMessageCallback;
      FOnDisconnect: TDisconnectCallback;
   protected
      procedure HandleMessage(Message: T); override;
      procedure Disconnect(); override;
   public
      property OnMessage: TMessageCallback read FOnMessage write FOnMessage;
      property OnDisconnect: TDisconnectCallback read FOnDisconnect write FOnDisconnect;
   end;

implementation

{$IFDEF TESTS}
uses sysutils;
{$ENDIF}

constructor TMessagePort.Create();
begin
   inherited;
end;

class procedure TMessagePort.CreateChannel(out A, B);
var
   P1: specialize TMessagePort<T> absolute A;
   P2: specialize TMessagePort<T> absolute B;
begin
   P1 := Create();
   P2 := Create();
   P1.FOther := P2;
   P2.FOther := P1;
end;

function TMessagePort.IsConnected(): Boolean;
begin
   Result := Assigned(FOther);
end;

procedure TMessagePort.Send(Message: T);
begin
   Assert(Assigned(FOther));
   FOther.HandleMessage(Message);
end;

procedure TMessagePort.Disconnect();
begin
   FOther := nil;
end;

destructor TMessagePort.Destroy();
begin
   if (Assigned(FOther)) then
   begin
      FOther.Disconnect();
      FOther := nil;
   end;
   inherited;
end;


procedure TCustomMessagePort.HandleMessage(Message: T);
begin
   if (Assigned(FOnMessage)) then
      FOnMessage(Self, Message);
end;

procedure TCustomMessagePort.Disconnect();
begin
   inherited;
   if (Assigned(FOnDisconnect)) then
      FOnDisconnect(Self);
end;


{$IFDEF TESTS}
var
   Log: UTF8String;

type
   TMessagePortTest = class
      FID: UTF8String;
      FPort: specialize TCustomMessagePort<Integer>;
      constructor Create(AID: UTF8String; APort: specialize TCustomMessagePort<Integer>);
      destructor Destroy(); override;
      procedure HandleMessage(Port: specialize TCustomMessagePort<Integer>; Message: Integer);
      procedure HandleDisconnect(Port: specialize TCustomMessagePort<Integer>);
      procedure Test();
   end;

constructor TMessagePortTest.Create(AID: UTF8String; APort: specialize TCustomMessagePort<Integer>);
begin
   inherited Create();
   FID := AID;
   FPort := APort;
   FPort.OnMessage := @HandleMessage;
   FPort.OnDisconnect := @HandleDisconnect;
end;

destructor TMessagePortTest.Destroy();
begin
   FPort.Free();
   inherited;
end;

procedure TMessagePortTest.HandleMessage(Port: specialize TCustomMessagePort<Integer>; Message: Integer);
begin
   Log := Log + FID + ' RECEIVED ' + IntToStr(Message) + #$0A;
end;

procedure TMessagePortTest.HandleDisconnect(Port: specialize TCustomMessagePort<Integer>);
begin
   Log := Log + FID + ' LOST PARTNER' + #$0A;
   FreeAndNil(FPort);
end;

procedure TMessagePortTest.Test();
begin
   if (Assigned(FPort)) then
      FPort.Send(123);
end;

var
   A, B: specialize TCustomMessagePort<Integer>;
   X, Y: TMessagePortTest;
initialization
   specialize TCustomMessagePort<Integer>.CreateChannel(A, B);
   X := TMessagePortTest.Create('X', A);
   Y := TMessagePortTest.Create('Y', B);
   X.Test();
   Y.Test();
   FreeAndNil(X);
   Y.Test();
   FreeAndNil(Y);
   Assert(Log = 'Y RECEIVED 123' + #$0A + 'X RECEIVED 123' + #$0A + 'Y LOST PARTNER' + #$0A);
{$ENDIF}
end.