Skip to content

E
emiMobile
Commit ee79d138 by Michael Brachmann
Options

websocket progress

parent 7481bbad
Showing with 995 additions and 294 deletions
emiMobileServer/Source/Ws.DataModel.pas 0 → 100644
unit Ws.DataModel;
// Server-side WebSocket data model.
// Owns a VCL timer that fires every FIntervalMs milliseconds, queries the
// database for the five data sets used by the polling timers that existed in
// each connected browser client, and broadcasts the results to every
// handshaked WebSocket connection via the supplied broadcast callback.
//
// All five result shapes mirror what the XData API methods return so that the
// client-side parsing code can be shared between the initial HTTP load and the
// subsequent WebSocket pushes.
interface
uses
System.SysUtils, System.Classes, System.JSON,
Vcl.ExtCtrls,
Api.Database,
WsMessages,
Common.Logging;
type
TWsBroadcastProc = reference to procedure(const AMessage: string);
TWsDataModel = class
private
FDb: TApiDatabaseModule;
FTimer: TTimer;
FBroadcast: TWsBroadcastProc;
procedure TimerFire(Sender: TObject);
procedure BroadcastAll;
function BuildBadgeCountsJson: string;
function BuildUnitMapJson: string;
function BuildComplaintMapJson: string;
function BuildUnitListJson: string;
function BuildComplaintListJson: string;
public
constructor Create(ABroadcast: TWsBroadcastProc; AIntervalMs: Integer = 30000);
destructor Destroy; override;
end;
implementation
uses
System.StrUtils, System.DateUtils;
{ TWsDataModel }
constructor TWsDataModel.Create(ABroadcast: TWsBroadcastProc; AIntervalMs: Integer);
begin
inherited Create;
FBroadcast := ABroadcast;
FDb := TApiDatabaseModule.Create(nil);
FTimer := TTimer.Create(nil);
FTimer.Interval := AIntervalMs;
FTimer.OnTimer := TimerFire;
FTimer.Enabled := True;
end;
destructor TWsDataModel.Destroy;
begin
FTimer.Enabled := False;
FTimer.Free;
FDb.Free;
inherited;
end;
procedure TWsDataModel.TimerFire(Sender: TObject);
begin
BroadcastAll;
end;
procedure TWsDataModel.BroadcastAll;
begin
Logger.Log(3, 'WsDataModel: broadcasting all');
try FBroadcast(BuildBadgeCountsJson); except on E: Exception do Logger.Log(2, 'WsDataModel BADGE_COUNTS error: ' + E.Message); end;
try FBroadcast(BuildUnitMapJson); except on E: Exception do Logger.Log(2, 'WsDataModel UNIT_MAP error: ' + E.Message); end;
try FBroadcast(BuildComplaintMapJson); except on E: Exception do Logger.Log(2, 'WsDataModel COMPLAINT_MAP error: ' + E.Message); end;
try FBroadcast(BuildUnitListJson); except on E: Exception do Logger.Log(2, 'WsDataModel UNIT_LIST error: ' + E.Message); end;
try FBroadcast(BuildComplaintListJson); except on E: Exception do Logger.Log(2, 'WsDataModel COMPLAINT_LIST error: ' + E.Message); end;
end;
function TWsDataModel.BuildBadgeCountsJson: string;
var
msg: TWsBadgeCountsMessage;
begin
msg := TWsBadgeCountsMessage.Create;
try
with FDb.uqBadgeCounts do
begin
Open;
try
msg.BadgeComplaints := FieldByName('COMPLAINTS').AsInteger;
msg.BadgeUnits := FieldByName('UNITS').AsInteger;
finally
Close;
end;
end;
Result := msg.AsJson;
finally
msg.Free;
end;
end;
function TWsDataModel.BuildUnitMapJson: string;
var
obj: TJSONObject;
data: TJSONArray;
item: TJSONObject;
unitStatus, updateTimeText: string;
begin
obj := TJSONObject.Create;
data := TJSONArray.Create;
try
obj.AddPair('RequestId', WS_MSG_UNIT_MAP);
obj.AddPair('data', data);
with FDb.uqMapUnits do
begin
Close;
Open;
try
First;
while not Eof do
begin
if (not FDb.uqMapUnitsGPS_LATITUDE.IsNull) and (not FDb.uqMapUnitsGPS_LONGITUDE.IsNull) then
begin
item := TJSONObject.Create;
data.AddElement(item);
item.AddPair('UnitId', FDb.uqMapUnitsUNITID.AsString);
item.AddPair('UnitName', FDb.uqMapUnitsUNITNAME.AsString);
item.AddPair('UnitBadge', FDb.uqMapUnitsUNITNAME.AsString);
item.AddPair('Agency', FDb.uqMapUnitsAGENCY.AsString);
item.AddPair('AgencyName', FDb.uqMapUnitsAGENCY_NAME.AsString);
item.AddPair('AgencyType', FDb.uqMapUnitsAGENCYTYPE.AsString);
item.AddPair('Lat', TJSONNumber.Create(FDb.uqMapUnitsGPS_LATITUDE.AsFloat));
item.AddPair('Lng', TJSONNumber.Create(FDb.uqMapUnitsGPS_LONGITUDE.AsFloat));
item.AddPair('CallType', FDb.uqMapUnitsCALL_TYPE.AsString);
item.AddPair('Priority', FDb.uqMapUnitsPRIORITY.AsString);
unitStatus := FDb.uqMapUnitsUNIT_STATUS_DESC.AsString;
if Trim(unitStatus) = '' then unitStatus := 'Available';
item.AddPair('Status', unitStatus);
updateTimeText := '';
if not FDb.uqMapUnitsUPDATE_TIME.IsNull then
updateTimeText := FormatDateTime('yyyy-mm-dd hh:nn:ss', FDb.uqMapUnitsUPDATE_TIME.AsDateTime);
item.AddPair('UpdateTime', updateTimeText);
item.AddPair('Officer1Lname', FDb.uqMapUnitsOFFICER1_LNAME.AsString);
item.AddPair('Officer1Fname', FDb.uqMapUnitsOFFICER1_FNAME.AsString);
item.AddPair('Officer1Empnum', FDb.uqMapUnitsOFFICER1_EMPNUM.AsString);
item.AddPair('Officer2Lname', FDb.uqMapUnitsOFFICER2_LNAME.AsString);
item.AddPair('Officer2Fname', FDb.uqMapUnitsOFFICER2_FNAME.AsString);
item.AddPair('Officer2Empnum', FDb.uqMapUnitsOFFICER2_EMPNUM.AsString);
item.AddPair('CanShowDetails', TJSONBool.Create(not FDb.uqMapUnitsDIS_UNITID.IsNull));
end;
Next;
end;
finally
Close;
end;
end;
obj.AddPair('count', TJSONNumber.Create(data.Count));
obj.AddPair('returned', TJSONNumber.Create(data.Count));
Result := obj.ToJSON;
finally
obj.Free;
end;
end;
function TWsDataModel.BuildComplaintMapJson: string;
var
obj: TJSONObject;
data: TJSONArray;
item, unitObj: TJSONObject;
unitArray: TJSONArray;
UnitsByComplaintMap: TDictionary<string, TJSONArray>;
complaintId, unitStatus: string;
latestUpdate: TDateTime;
begin
obj := TJSONObject.Create;
data := TJSONArray.Create;
UnitsByComplaintMap := TDictionary<string, TJSONArray>.Create;
try
obj.AddPair('RequestId', WS_MSG_COMPLAINT_MAP);
obj.AddPair('data', data);
// Build unit→complaint map first
FDb.uqMapComplaintUnitsList.Close;
FDb.uqMapComplaintUnitsList.Open;
try
while not FDb.uqMapComplaintUnitsList.Eof do
begin
complaintId := FDb.uqMapComplaintUnitsListCOMPLAINTID.AsString;
if not UnitsByComplaintMap.TryGetValue(complaintId, unitArray) then
begin
unitArray := TJSONArray.Create;
UnitsByComplaintMap.Add(complaintId, unitArray);
end;
unitStatus := 'Dispatched';
if not FDb.uqMapComplaintUnitsListDATECLEARED.IsNull then unitStatus := 'Cleared'
else if not FDb.uqMapComplaintUnitsListDATEARRIVED.IsNull then unitStatus := 'On Scene'
else if not FDb.uqMapComplaintUnitsListDATERESPONDED.IsNull then unitStatus := 'Enroute';
latestUpdate := 0;
if not FDb.uqMapComplaintUnitsListDATEDISPATCHED.IsNull then
latestUpdate := FDb.uqMapComplaintUnitsListDATEDISPATCHED.AsDateTime;
if (not FDb.uqMapComplaintUnitsListDATERESPONDED.IsNull) and
(FDb.uqMapComplaintUnitsListDATERESPONDED.AsDateTime > latestUpdate) then
latestUpdate := FDb.uqMapComplaintUnitsListDATERESPONDED.AsDateTime;
if (not FDb.uqMapComplaintUnitsListDATEARRIVED.IsNull) and
(FDb.uqMapComplaintUnitsListDATEARRIVED.AsDateTime > latestUpdate) then
latestUpdate := FDb.uqMapComplaintUnitsListDATEARRIVED.AsDateTime;
if (not FDb.uqMapComplaintUnitsListDATECLEARED.IsNull) and
(FDb.uqMapComplaintUnitsListDATECLEARED.AsDateTime > latestUpdate) then
latestUpdate := FDb.uqMapComplaintUnitsListDATECLEARED.AsDateTime;
unitObj := TJSONObject.Create;
unitArray.AddElement(unitObj);
unitObj.AddPair('Unit', FDb.uqMapComplaintUnitsListUNITNAME.AsString);
unitObj.AddPair('Status', unitStatus);
unitObj.AddPair('Updated', IfThen(latestUpdate <> 0, FormatDateTime('yyyy-mm-dd hh:nn:ss', latestUpdate), ''));
FDb.uqMapComplaintUnitsList.Next;
end;
finally
FDb.uqMapComplaintUnitsList.Close;
end;
// Build complaint rows
FDb.uqMapComplaints.Close;
FDb.uqMapComplaints.Open;
try
while not FDb.uqMapComplaints.Eof do
begin
item := TJSONObject.Create;
data.AddElement(item);
complaintId := FDb.uqMapComplaintsCOMPLAINTID.AsString;
item.AddPair('ComplaintId', complaintId);
item.AddPair('DispatchDistrict', FDb.uqMapComplaintsDISPATCHDISTRICT.AsString);
item.AddPair('Agency', FDb.uqMapComplaintsAGENCY.AsString);
item.AddPair('AgencyName', FDb.uqMapComplaintsAGENCY_NAME.AsString);
item.AddPair('DispatchCodeDesc', FDb.uqMapComplaintsDISPATCH_CODE_DESC.AsString);
item.AddPair('DispatchCodeCategory', FDb.uqMapComplaintsDISPATCHCODECATEGORY.AsString);
item.AddPair('Priority', FDb.uqMapComplaintsPRIORITY.AsString);
item.AddPair('PriorityBadge', FDb.uqMapComplaintspriorityBadge.AsString);
item.AddPair('ComplaintStatusKey', FDb.uqMapComplaintscomplaintStatusKey.AsString);
item.AddPair('pngName', FDb.uqMapComplaintspngName.AsString);
item.AddPair('Address', FDb.uqMapComplaintsADDRESS.AsString);
item.AddPair('Business', FDb.uqMapComplaintsBUSINESS.AsString);
item.AddPair('Lat', TJSONNumber.Create(FDb.uqMapComplaintsLAT.AsFloat));
item.AddPair('Lng', TJSONNumber.Create(FDb.uqMapComplaintsLNG.AsFloat));
if UnitsByComplaintMap.TryGetValue(complaintId, unitArray) then
item.AddPair('Units', TJSONArray(unitArray.Clone))
else
item.AddPair('Units', TJSONArray.Create);
FDb.uqMapComplaints.Next;
end;
finally
FDb.uqMapComplaints.Close;
end;
obj.AddPair('count', TJSONNumber.Create(data.Count));
obj.AddPair('returned', TJSONNumber.Create(data.Count));
Result := obj.ToJSON;
finally
// Free the per-complaint unit arrays (not cloned copies — those are now owned by item)
for unitArray in UnitsByComplaintMap.Values do
unitArray.Free;
UnitsByComplaintMap.Free;
obj.Free;
end;
end;
function TWsDataModel.BuildUnitListJson: string;
var
obj: TJSONObject;
data: TJSONArray;
item: TJSONObject;
lastAgency, curAgency: string;
o1, f1, m1, o2, f2, m2: string;
statusDesc, complaintNumber: string;
mapLat, mapLng: Double;
canShowMap: Boolean;
begin
obj := TJSONObject.Create;
data := TJSONArray.Create;
lastAgency := '';
try
obj.AddPair('RequestId', WS_MSG_UNIT_LIST);
with FDb.uqUnitList do
begin
Open;
First;
while not Eof do
begin
item := TJSONObject.Create;
curAgency := Trim(FDb.uqUnitListAGENCY_NAME.AsString);
if curAgency = '' then curAgency := Trim(FDb.uqUnitListAGENCY.AsString);
if curAgency = '' then curAgency := 'Unknown Agency';
if not SameText(curAgency, lastAgency) then
begin
item.AddPair('AgencyHeader', curAgency);
lastAgency := curAgency;
end
else
item.AddPair('AgencyHeader', '');
item.AddPair('UnitId', FDb.uqUnitListUNITID.AsString);
item.AddPair('UnitName', FDb.uqUnitListUNITNAME.AsString);
item.AddPair('Agency', FDb.uqUnitListAGENCY.AsString);
item.AddPair('AgencyName', FDb.uqUnitListAGENCY_NAME.AsString);
item.AddPair('AgencyType', FDb.uqUnitListAGENCYTYPE.AsString);
item.AddPair('CarNumberDesc', FDb.uqUnitListCARNUMBER_DESC.AsString);
item.AddPair('District', FDb.uqUnitListDISTRICT_DESC.AsString);
item.AddPair('Sector', FDb.uqUnitListSECTOR_DESC.AsString);
item.AddPair('CallType', FDb.uqUnitListCALL_TYPE.AsString);
canShowMap := False;
if (not FDb.uqUnitListGPS_LATITUDE.IsNull) and (not FDb.uqUnitListGPS_LONGITUDE.IsNull) then
begin
mapLat := FDb.uqUnitListGPS_LATITUDE.AsFloat;
mapLng := FDb.uqUnitListGPS_LONGITUDE.AsFloat;
canShowMap :=
((mapLat <> 0) or (mapLng <> 0)) and
(Abs(mapLat) <= 90) and (Abs(mapLng) <= 180);
end;
item.AddPair('CanShowMap', IfThen(canShowMap, 'true', 'false'));
item.AddPair('MapButtonClass', IfThen(canShowMap, 'btn-primary', 'btn-secondary disabled'));
item.AddPair('MapButtonDisabled', IfThen(canShowMap, '', 'disabled="disabled" aria-disabled="true"'));
item.AddPair('MapButtonTitle', IfThen(canShowMap, 'Show on map', 'No map location available'));
complaintNumber := Trim(FDb.uqUnitListCOMPLAINT.AsString);
item.AddPair('Location', FDb.uqUnitListLOCATION.AsString);
item.AddPair('Complaint', complaintNumber);
item.AddPair('ComplaintHeader', IfThen(complaintNumber <> '', ' - ' + complaintNumber, ''));
statusDesc := FDb.uqUnitListUNIT_STATUS_DESC.AsString;
if statusDesc = '' then statusDesc := 'Available';
item.AddPair('Status', statusDesc);
o1 := Trim(FDb.uqUnitListOFFICER1_LAST_NAME.AsString);
f1 := Trim(FDb.uqUnitListOFFICER1_FIRST_NAME.AsString);
m1 := Trim(FDb.uqUnitListOFFICER1_MI.AsString);
if o1 <> '' then
begin
if f1 <> '' then o1 := o1 + ', ' + f1;
if m1 <> '' then o1 := o1 + ' ' + m1;
item.AddPair('Officer1', o1);
end;
o2 := Trim(FDb.uqUnitListOFFICER2_LAST_NAME.AsString);
f2 := Trim(FDb.uqUnitListOFFICER2_FIRST_NAME.AsString);
m2 := Trim(FDb.uqUnitListOFFICER2_MI.AsString);
if o2 <> '' then
begin
if f2 <> '' then o2 := o2 + ', ' + f2;
if m2 <> '' then o2 := o2 + ' ' + m2;
item.AddPair('Officer2', o2);
end;
data.AddElement(item);
Next;
end;
end;
obj.AddPair('count', TJSONNumber.Create(data.Count));
obj.AddPair('returned', TJSONNumber.Create(data.Count));
obj.AddPair('data', data);
Result := obj.ToJSON;
finally
FDb.uqUnitList.Close;
obj.Free;
end;
end;
function TWsDataModel.BuildComplaintListJson: string;
var
obj: TJSONObject;
data: TJSONArray;
item: TJSONObject;
lastDistrict, curAgency: string;
status, statusColor, statusTextColor: string;
colorVal: Integer;
complaintNumber: string;
begin
obj := TJSONObject.Create;
data := TJSONArray.Create;
lastDistrict := '';
try
obj.AddPair('RequestId', WS_MSG_COMPLAINT_LIST);
with FDb.uqComplaintList do
begin
Open;
(FieldByName('DATEREPORTED') as TDateTimeField).DisplayFormat := 'yyyy-mm-dd hh:nn:ss';
First;
while not Eof do
begin
if not FieldByName('DATEARRIVED').IsNull then
begin
status := 'On Scene'; statusColor := '#22C55E'; statusTextColor := '#000000';
end
else if not FieldByName('DATERESPONDED').IsNull then
begin
status := 'Enroute'; statusColor := '#FFFF00'; statusTextColor := '#000000';
end
else if not FieldByName('DATEDISPATCHED').IsNull then
begin
status := 'Dispatched'; statusColor := '#FFFF00'; statusTextColor := '#000000';
end
else
begin
status := 'Pending'; statusColor := '#FF8080'; statusTextColor := '#000000';
end;
item := TJSONObject.Create;
curAgency := Trim(FDb.uqComplaintListAGENCY.AsString);
if curAgency = '' then curAgency := 'Unknown Agency';
if not SameText(curAgency, lastDistrict) then
item.AddPair('DistrictHeader', curAgency);
lastDistrict := curAgency;
item.AddPair('AgencyLine', 'Agency: ' + curAgency);
colorVal := FDb.uqComplaintListPRIORITY_COLOR.AsInteger;
item.AddPair('PriorityColor', '#' + IntToHex(colorVal and $FFFFFF, 6));
item.AddPair('PriorityTextColor', '#000000');
complaintNumber := FDb.uqComplaintListcomplaintNumber.AsString;
item.AddPair('ComplaintId', FDb.uqComplaintListCOMPLAINTID.AsString);
item.AddPair('Complaint', complaintNumber);
item.AddPair('Agency', FDb.uqComplaintListAGENCY.AsString);
item.AddPair('Priority', FDb.uqComplaintListPRIORITY.AsString);
item.AddPair('DispatchCodeDesc', FDb.uqComplaintListDISPATCH_CODE_DESC.AsString);
item.AddPair('Address', FDb.uqComplaintListADDRESS.AsString);
item.AddPair('Business', FDb.uqComplaintListBUSINESS.AsString);
item.AddPair('CFSId', FDb.uqComplaintListCFSID.AsString);
item.AddPair('Status', status);
item.AddPair('StatusColor', statusColor);
item.AddPair('StatusTextColor', statusTextColor);
item.AddPair('DispatchDistrict', FDb.uqComplaintListDISPATCHDISTRICT.AsString);
item.AddPair('DateReported', FDb.uqComplaintListDATEREPORTED.AsString);
data.AddElement(item);
Next;
end;
end;
obj.AddPair('count', TJSONNumber.Create(data.Count));
obj.AddPair('returned', TJSONNumber.Create(data.Count));
obj.AddPair('data', data);
Result := obj.ToJSON;
finally
FDb.uqComplaintList.Close;
obj.Free;
end;
end;
end.
emiMobileServer/Source/Ws.Server.Module.pas
......@@ -5,7 +5,8 @@ interface
uses
System.SysUtils, System.Classes,
IdContext,
WebSocketServer;
WebSocketServer,
Ws.DataModel;
type
TWsServerModule = class(TDataModule)
......@@ -13,6 +14,7 @@ type
procedure DataModuleDestroy(Sender: TObject);
private
FServer: TWebSocketServer;
FDataModel: TWsDataModel;
procedure DoConnect(AContext: TIdContext);
procedure DoDisconnect(AContext: TIdContext);
procedure DoExecute(AContext: TIdContext);
......@@ -55,6 +57,9 @@ end;
procedure TWsServerModule.DataModuleDestroy(Sender: TObject);
begin
FDataModel.Free;
FDataModel := nil;
if Assigned(FServer) then
begin
FServer.Active := False;
......@@ -97,6 +102,15 @@ begin
FServer.DefaultPort := WS_PORT;
FServer.Active := True;
Logger.Log(1, Format('WebSocket server listening on ws://0.0.0.0:%d/', [WS_PORT]));
FDataModel := TWsDataModel.Create(
procedure(const AMessage: string)
begin
Broadcast(AMessage);
end,
30000 // broadcast interval in ms
);
Logger.Log(1, 'WsDataModel started (30 s broadcast interval)');
end;
procedure TWsServerModule.Broadcast(const AMessage: string);
......
emiMobileServer/Source/shared/WsMessages.pas 0 → 100644
unit WsMessages;
// WebSocket push message types.
// Each constant is the value of RequestId that identifies the message kind.
// Server builds and broadcasts; client dispatches on RequestId.
interface
uses
BaseRequest, Pkg.Json.DTO, REST.Json.Types;
{$M+}
const
WS_MSG_BADGE_COUNTS = 'BADGE_COUNTS';
WS_MSG_UNIT_MAP = 'UNIT_MAP';
WS_MSG_COMPLAINT_MAP = 'COMPLAINT_MAP';
WS_MSG_UNIT_LIST = 'UNIT_LIST';
WS_MSG_COMPLAINT_LIST = 'COMPLAINT_LIST';
type
// Simple typed DTO — serialized directly via AsJson for broadcast.
TWsBadgeCountsMessage = class(TRequest)
private
FBadgeComplaints: Integer;
FBadgeUnits: Integer;
published
property BadgeComplaints: Integer read FBadgeComplaints write FBadgeComplaints;
property BadgeUnits: Integer read FBadgeUnits write FBadgeUnits;
public
constructor Create;
end;
// Array-payload messages: server adds RequestId to the existing TJSONObject
// produced by the DB query methods, then broadcasts as a plain JSON string.
// These classes exist for requestId-based type identification and future
// client→server use (cast a received TRequest to the appropriate type).
TWsUnitMapMessage = class(TRequest) public constructor Create; end;
TWsComplaintMapMessage = class(TRequest) public constructor Create; end;
TWsUnitListMessage = class(TRequest) public constructor Create; end;
TWsComplaintListMessage = class(TRequest) public constructor Create; end;
implementation
constructor TWsBadgeCountsMessage.Create;
begin
inherited;
RequestId := WS_MSG_BADGE_COUNTS;
end;
constructor TWsUnitMapMessage.Create;
begin
inherited;
RequestId := WS_MSG_UNIT_MAP;
end;
constructor TWsComplaintMapMessage.Create;
begin
inherited;
RequestId := WS_MSG_COMPLAINT_MAP;
end;
constructor TWsUnitListMessage.Create;
begin
inherited;
RequestId := WS_MSG_UNIT_LIST;
end;
constructor TWsComplaintListMessage.Create;
begin
inherited;
RequestId := WS_MSG_COMPLAINT_LIST;
end;
end.
webEMIMobile/Module.Websocket.pas
......@@ -4,9 +4,12 @@ interface
uses
System.SysUtils, System.Classes, WEBLib.WebSocketClient, Web, WEBLib.Controls, WEBLib.Modules,
Auth.Service;
Auth.Service, JS;
type
// Handler signature: receives the fully parsed JSON object for one push message.
TWsDataHandler = procedure(aData: TJSObject) of object;
TdmWebsocket = class(TWebDataModule)
private
......@@ -19,11 +22,26 @@ type
procedure EMiMobileWebSocketClientBinaryDataReceived(Sender: TObject;
AData: TBytes);
procedure DispatchMessage(const AMessage: string);
FOnBadgeCounts: TWsDataHandler;
FOnUnitMap: TWsDataHandler;
FOnComplaintMap: TWsDataHandler;
FOnUnitList: TWsDataHandler;
FOnComplaintList: TWsDataHandler;
public
EMiMobileWebSocketClient: TWebSocketClient;
procedure DataModuleCreate(Sender: TObject);
procedure Connect(const AWsUrl: string);
// Assign these before calling Connect so that pushes are routed immediately.
property OnBadgeCounts: TWsDataHandler read FOnBadgeCounts write FOnBadgeCounts;
property OnUnitMap: TWsDataHandler read FOnUnitMap write FOnUnitMap;
property OnComplaintMap: TWsDataHandler read FOnComplaintMap write FOnComplaintMap;
property OnUnitList: TWsDataHandler read FOnUnitList write FOnUnitList;
property OnComplaintList: TWsDataHandler read FOnComplaintList write FOnComplaintList;
end;
var
......@@ -102,32 +120,80 @@ begin
EMiMobileWebSocketClient.Active := True;
end;
procedure TdmWebsocket.DispatchMessage(const AMessage: string);
var
obj: TJSObject;
requestId: string;
begin
if AMessage = '' then
Exit;
asm
try {
obj = JSON.parse(AMessage);
} catch(e) {
obj = null;
}
end;
if obj = nil then
begin
console.log('WS: could not parse message');
Exit;
end;
requestId := string(obj['RequestId']);
if SameText(requestId, 'BADGE_COUNTS') then
begin
if Assigned(FOnBadgeCounts) then FOnBadgeCounts(obj);
end
else if SameText(requestId, 'UNIT_MAP') then
begin
if Assigned(FOnUnitMap) then FOnUnitMap(obj);
end
else if SameText(requestId, 'COMPLAINT_MAP') then
begin
if Assigned(FOnComplaintMap) then FOnComplaintMap(obj);
end
else if SameText(requestId, 'UNIT_LIST') then
begin
if Assigned(FOnUnitList) then FOnUnitList(obj);
end
else if SameText(requestId, 'COMPLAINT_LIST') then
begin
if Assigned(FOnComplaintList) then FOnComplaintList(obj);
end
else
console.log('WS: unknown RequestId: ' + requestId);
end;
procedure TdmWebsocket.EMiMobileWebSocketClientBinaryDataReceived(
Sender: TObject; AData: TBytes);
begin
console.log('EMiMobileWebSocketClientBinaryDataReceived');
console.log('WS: binary data received (ignored)');
end;
procedure TdmWebsocket.EMiMobileWebSocketClientConnect(Sender: TObject);
begin
console.log('EMiMobileWebSocketClientConnect');
console.log('WS: connected');
end;
procedure TdmWebsocket.EMiMobileWebSocketClientDataReceived(Sender: TObject;
Origin: string; SocketData: TJSObjectRecord);
begin
console.log('EMiMobileWebSocketClientDataReceived');
// Text messages arrive via EMiMobileWebSocketClientMessageReceived.
end;
procedure TdmWebsocket.EMiMobileWebSocketClientDisconnect(Sender: TObject);
begin
console.log('EMiMobileWebSocketClientDisconnect');
console.log('WS: disconnected');
end;
procedure TdmWebsocket.EMiMobileWebSocketClientMessageReceived(Sender: TObject;
AMessage: string);
begin
console.log('EMiMobileWebSocketClientMessageReceived');
DispatchMessage(AMessage);
end;
end.
webEMIMobile/View.Complaints.pas
......@@ -45,6 +45,7 @@ type
public
property OnShowDetails: TSelectProc read FSelectProc write FSelectProc;
procedure RefreshData;
procedure ApplyWsData(aRespObj: TJSObject);
end;
var
......@@ -186,5 +187,22 @@ begin
GetComplaints;
end;
procedure TFViewComplaints.ApplyWsData(aRespObj: TJSObject);
var
complaintsCount: Integer;
begin
if FLoading then
Exit;
xdwdsComplaints.Close;
xdwdsComplaints.SetJsonData(aRespObj['data']);
xdwdsComplaints.Open;
ShowHideBusinessRows;
complaintsCount := Integer(aRespObj['count']);
lblEntries.Caption := Format('%d active complaints', [complaintsCount]);
end;
end.
webEMIMobile/View.Main.pas
......@@ -55,7 +55,6 @@ type
FDetailsForm: TWebForm;
FArchiveForm: TWebForm;
FLogoutProc: TLogoutProc;
//WebSocketModule: Module.Websocket;
[async] procedure RefreshBadgesAsync;
procedure ShowUnitDetails(UnitId: string);
procedure SetHeaderTitle(const title: string);
......@@ -64,6 +63,13 @@ type
procedure HideArchiveModal;
procedure ShowArchiveModal(const titleText: string);
// WebSocket push handlers — called by Module.Websocket when the server broadcasts
procedure HandleWsBadgeCounts(aData: TJSObject);
procedure HandleWsUnitMap(aData: TJSObject);
procedure HandleWsComplaintMap(aData: TJSObject);
procedure HandleWsUnitList(aData: TJSObject);
procedure HandleWsComplaintList(aData: TJSObject);
type TActivePanel = (apNone, apMap, apUnits, apComplaints);
var
FActivePanel: TActivePanel;
......@@ -151,9 +157,19 @@ begin
SetActiveNavButton('view.main.btnmap');
SetActivePanel(apMap);
// Initial badge counts still loaded via HTTP so the UI is populated immediately.
RefreshBadgesAsync;
// Polling timers are replaced by WebSocket server-push broadcasts.
tmrBadgeCounts.Enabled := False;
tmrGlobalRefresh.Enabled := False;
dmWebsocket := TdmWebsocket.Create(Self);
dmWebsocket.OnBadgeCounts := HandleWsBadgeCounts;
dmWebsocket.OnUnitMap := HandleWsUnitMap;
dmWebsocket.OnComplaintMap := HandleWsComplaintMap;
dmWebsocket.OnUnitList := HandleWsUnitList;
dmWebsocket.OnComplaintList := HandleWsComplaintList;
dmWebsocket.Connect(DMConnection.WsUrl);
end;
......@@ -444,6 +460,49 @@ begin
end;
// ---------------------------------------------------------------------------
// WebSocket push handlers
// ---------------------------------------------------------------------------
procedure TFViewMain.HandleWsBadgeCounts(aData: TJSObject);
var
el: TJSElement;
begin
el := Document.getElementById('view.main.badgecomplaints');
if Assigned(el) then
TJSHtmlElement(el).innerText := string(aData['BadgeComplaints']);
el := Document.getElementById('view.main.badgeunits');
if Assigned(el) then
TJSHtmlElement(el).innerText := string(aData['BadgeUnits']);
end;
procedure TFViewMain.HandleWsUnitMap(aData: TJSObject);
begin
if Assigned(FMapForm) then
FMapForm.ApplyWsUnitMapData(TJSArray(aData['data']));
end;
procedure TFViewMain.HandleWsComplaintMap(aData: TJSObject);
begin
if Assigned(FMapForm) then
FMapForm.ApplyWsComplaintMapData(TJSArray(aData['data']));
end;
procedure TFViewMain.HandleWsUnitList(aData: TJSObject);
begin
if Assigned(FUnitsForm) then
FUnitsForm.ApplyWsData(aData);
end;
procedure TFViewMain.HandleWsComplaintList(aData: TJSObject);
begin
if Assigned(FComplaintsForm) then
FComplaintsForm.ApplyWsData(aData);
end;
// ---------------------------------------------------------------------------
procedure TFViewMain.tmrBadgeCountsTimer(Sender: TObject);
begin
console.log('Badges Refreshed');
......
webEMIMobile/View.Map.pas
......@@ -40,6 +40,8 @@ type
FGeoJsonLoadStep: Integer;
[async] procedure LoadPointsAsync(showBusy: Boolean);
procedure PlaceUnitMarkers(aData: TJSArray);
procedure PlaceComplaintMarkers(aData: TJSArray);
procedure UpdateDeviceLocation(lat, lng: Double);
procedure StartDeviceLocation;
procedure ApplyPendingUnitFocus;
......@@ -52,6 +54,9 @@ type
procedure FocusUnit(const unitId: string);
procedure FocusComplaint(const complaintId: string);
procedure RefreshData;
// Called by View.Main when the server broadcasts a WebSocket push.
procedure ApplyWsUnitMapData(aData: TJSArray);
procedure ApplyWsComplaintMapData(aData: TJSArray);
end;
var
......@@ -262,22 +267,7 @@ end;
[async] procedure TFViewMap.LoadPointsAsync(showBusy: Boolean);
var
resp: TXDataClientResponse;
root, item, uo: TJSObject;
units: TJSArray;
i, ui: Integer;
m: TTMSFNCMapsMarker;
lat, lng: Double;
uName, unitBadge, agencyType, agencyId, agencyName, agency: string;
unitId, callType, priorityText, statusText: string;
complaintId, codeDesc, priority, priorityBadge, complaintStatusKey, business, address: string;
pngName, iconUrl, rowsHtml: string;
officer1Lname, officer1Fname, officer1Empnum: string;
officer2Lname, officer2Fname, officer2Empnum: string;
officer1Display, officer2Display: string;
updateTimeText: string;
canShowDetails: Boolean;
canShowDetailsText: string;
detailsBtnHtml: string;
root: TJSObject;
unitsData: TJSArray;
complaintsData: TJSArray;
begin
......@@ -317,277 +307,11 @@ begin
Console.Log('Complaints XData error: ' + E.ErrorResult.ErrorMessage);
end;
// --- Swap Markers (no blank map while loading) ---------------------------
// --- Place markers (BeginUpdate wraps both so the map redraws once) ------
lfMap.BeginUpdate;
try
for i := lfMap.Markers.Count - 1 downto 0 do
begin
m := lfMap.Markers[i];
if StartsText('unit|', m.DataString) or StartsText('complaint|', m.DataString) then
lfMap.Markers.Delete(i);
end;
// Unit markers
if unitsData <> nil then
begin
for i := 0 to unitsData.Length - 1 do
begin
item := TJSObject(unitsData[i]);
lat := Double(item['Lat']);
lng := Double(item['Lng']);
uName := GetJsonString(item, 'UnitName');
unitId := GetJsonString(item, 'UnitId');
unitBadge := GetJsonString(item, 'UnitBadge');
if Trim(unitBadge) = '' then
unitBadge := uName;
if Trim(unitBadge) = '' then
unitBadge := unitId;
agencyId := GetJsonString(item, 'Agency');
agencyName := GetJsonString(item, 'AgencyName');
agency := agencyName;
if Trim(agency) = '' then
agency := agencyId;
agencyType := UpperCase(Trim(GetJsonString(item, 'AgencyType')));
if agencyType = 'FIR' then
iconUrl := 'assets/markers/car_fire.png'
else if agencyType = 'EMS' then
iconUrl := 'assets/markers/car_ems.png'
else if agencyType = 'POL' then
iconUrl := 'assets/markers/car_police.png'
else
iconUrl := 'assets/markers/car_police.png';
callType := GetJsonString(item, 'CallType');
priorityText := GetJsonString(item, 'Priority');
statusText := GetJsonString(item, 'Status');
updateTimeText := GetJsonString(item, 'UpdateTime');
officer1Lname := GetJsonString(item, 'Officer1Lname');
officer1Fname := GetJsonString(item, 'Officer1Fname');
officer1Empnum := GetJsonString(item, 'Officer1Empnum');
officer2Lname := GetJsonString(item, 'Officer2Lname');
officer2Fname := GetJsonString(item, 'Officer2Fname');
officer2Empnum := GetJsonString(item, 'Officer2Empnum');
canShowDetailsText := '';
if item['CanShowDetails'] <> nil then
canShowDetailsText := string(item['CanShowDetails']);
canShowDetails := SameText(Trim(canShowDetailsText), 'true');
if canShowDetails then
begin
detailsBtnHtml :=
'<button type="button" class="btn btn-primary btn-sm px-2 py-1" ' +
'onclick="window.showUnitDetails(''' + unitId + ''')">' +
'Details' +
'</button>';
end
else
detailsBtnHtml := '';
officer1Display := '';
if Trim(officer1Lname + officer1Fname + officer1Empnum) <> '' then
begin
officer1Display := Trim(officer1Lname);
if Trim(officer1Fname) <> '' then
officer1Display := officer1Display + ', ' + Trim(officer1Fname);
if Trim(officer1Empnum) <> '' then
officer1Display := officer1Display + ' (' + Trim(officer1Empnum) + ')';
end;
officer2Display := '';
if Trim(officer2Lname + officer2Fname + officer2Empnum) <> '' then
begin
officer2Display := Trim(officer2Lname);
if Trim(officer2Fname) <> '' then
officer2Display := officer2Display + ', ' + Trim(officer2Fname);
if Trim(officer2Empnum) <> '' then
officer2Display := officer2Display + ' (' + Trim(officer2Empnum) + ')';
end;
m := lfMap.Markers.Add;
m.Latitude := lat;
m.Longitude := lng;
m.Title :=
'<span class="emi-marker-meta" data-marker-type="unit" data-unit-badge="' +
HtmlAttrEncode(unitBadge) +
'" data-picker-label="' +
HtmlAttrEncode('Unit ' + unitBadge) +
'" style="display:none"></span>' +
'<div class="d-flex flex-column gap-1 px-1 py-1" style="width:260px;">' +
'<div class="fw-semibold small">' +
'<span class="fw-bold">Unit:</span> ' + uName +
'</div>' +
IfThen(agency <> '',
'<div class="small"><span class="fw-bold">Agency:</span> ' + agency + '</div>',
''
) +
IfThen(Trim(callType) <> '',
'<div class="small"><span class="fw-bold">Call Type:</span> ' + callType + '</div>',
''
) +
IfThen(Trim(priorityText) <> '',
'<div class="small"><span class="fw-bold">Priority:</span> ' + priorityText + '</div>',
''
) +
IfThen(Trim(statusText) <> '',
'<div class="small"><span class="fw-bold">Status:</span> ' + statusText + '</div>',
''
) +
IfThen(Trim(officer1Display) <> '',
'<div class="small"><span class="fw-bold">Officer 1:</span> ' + officer1Display + '</div>',
''
) +
IfThen(Trim(officer2Display) <> '',
'<div class="small"><span class="fw-bold">Officer 2:</span> ' + officer2Display + '</div>',
''
) +
IfThen(Trim(updateTimeText) <> '',
'<div class="small mb-1"><span class="fw-bold">Updated:</span> ' + updateTimeText + '</div>',
'<div class="small mb-1"></div>'
) +
IfThen(detailsBtnHtml <> '',
'<div class="d-flex justify-content-end mt-0">' + detailsBtnHtml + '</div>',
''
) +
'</div>';
m.DataString := 'unit|' + unitId + '|' + StringReplace(unitBadge, '|', '/', [rfReplaceAll]);
m.IconURL := iconUrl;
end;
end;
// Complaint markers
if complaintsData <> nil then
begin
for i := 0 to complaintsData.Length - 1 do
begin
item := TJSObject(complaintsData[i]);
complaintId := GetJsonString(item, 'ComplaintId');
codeDesc := GetJsonString(item, 'DispatchCodeDesc');
agencyId := GetJsonString(item, 'Agency');
agencyName := GetJsonString(item, 'AgencyName');
agency := agencyName;
if Trim(agency) = '' then
agency := agencyId;
priority := GetJsonString(item, 'Priority');
priorityBadge := GetJsonString(item, 'PriorityBadge');
if Trim(priorityBadge) = '' then
priorityBadge := '?';
complaintStatusKey := LowerCase(Trim(GetJsonString(item, 'ComplaintStatusKey')));
if complaintStatusKey = '' then
complaintStatusKey := 'notattached';
business := GetJsonString(item, 'Business');
address := GetJsonString(item, 'Address');
lat := Double(item['Lat']);
lng := Double(item['Lng']);
if ((lat = 0) and (lng = 0)) or (Abs(lat) > 90) or (Abs(lng) > 180) then
Continue;
pngName := GetJsonString(item, 'pngName');
if Trim(pngName) <> '' then
iconUrl := 'assets/markers/' + pngName
else
iconUrl := 'assets/markers/default_notattached.png';
rowsHtml := '';
units := TJSArray(item['Units']);
if Assigned(units) and (units.Length > 0) then
begin
for ui := 0 to units.Length - 1 do
begin
uo := TJSObject(units[ui]);
rowsHtml := rowsHtml +
'<tr>' +
'<td>' + GetJsonString(uo, 'Unit') + '</td>' +
'<td>' + GetJsonString(uo, 'Status') + '</td>' +
'<td>' + GetJsonString(uo, 'Updated') + '</td>' +
'</tr>';
end;
end
else
rowsHtml := '<tr><td colspan="3" class="text-muted">No units</td></tr>';
m := lfMap.Markers.Add;
m.Latitude := lat;
m.Longitude := lng;
m.DataString := 'complaint|' + complaintId;
m.IconURL := iconUrl;
m.Title :=
'<span class="emi-marker-meta" data-marker-type="complaint" data-priority-badge="' +
HtmlAttrEncode(priorityBadge) +
'" data-complaint-status="' +
HtmlAttrEncode(complaintStatusKey) +
'" data-picker-label="' +
HtmlAttrEncode('Complaint ' + complaintId + IfThen(Trim(codeDesc) <> '', ' - ' + codeDesc, '')) +
'" style="display:none"></span>' +
'<div class="d-flex flex-column gap-1 px-1 py-1" style="width:260px;">' +
'<div class="fw-semibold small">' +
'<span class="fw-bold">Complaint:</span> ' + complaintId +
'</div>' +
'<div class="small">' +
'<span class="fw-bold">Priority:</span> ' + priority +
'</div>' +
'<div class="small">' +
'<span class="fw-bold">Dispatch Code:</span> ' + codeDesc +
'</div>' +
'<div class="small">' +
'<span class="fw-bold">Agency:</span> ' + agency +
'</div>' +
IfThen(Trim(business) <> '',
'<div class="small">' +
'<span class="fw-bold">Business:</span> ' + business +
'</div>',
''
) +
'<div class="small mb-1">' +
'<span class="fw-bold">Address:</span> ' + address +
'</div>' +
'<table class="table table-sm table-bordered mb-1 emi-tip-table">' +
'<colgroup>' +
'<col style="width:34%">' +
'<col style="width:33%">' +
'<col style="width:33%">' +
'</colgroup>' +
'<thead class="table-light">' +
'<tr>' +
'<th>Unit</th>' +
'<th>Status</th>' +
'<th>Updated</th>' +
'</tr>' +
'</thead>' +
'<tbody>' + rowsHtml + '</tbody>' +
'</table>' +
'<div class="d-flex justify-content-end mt-0">' +
'<button type="button" class="btn btn-primary btn-sm px-2 py-1" ' +
'onclick="window.showComplaintDetails(''' + complaintId + ''')">' +
'Details' +
'</button>' +
'</div>' +
'</div>';
end;
end;
PlaceUnitMarkers(unitsData);
PlaceComplaintMarkers(complaintsData);
finally
lfMap.EndUpdate;
end;
......@@ -600,10 +324,264 @@ begin
finally
if showBusy then
HideSpinner('spinner');
FLoadingPoints := False;
FLoadingPoints := False;
end;
end;
procedure TFViewMap.PlaceUnitMarkers(aData: TJSArray);
var
item: TJSObject;
i: Integer;
m: TTMSFNCMapsMarker;
lat, lng: Double;
uName, unitBadge, agencyType, agencyId, agencyName, agency: string;
unitId, callType, priorityText, statusText, updateTimeText: string;
officer1Lname, officer1Fname, officer1Empnum: string;
officer2Lname, officer2Fname, officer2Empnum: string;
officer1Display, officer2Display: string;
iconUrl, canShowDetailsText, detailsBtnHtml: string;
canShowDetails: Boolean;
begin
// Remove stale unit markers
for i := lfMap.Markers.Count - 1 downto 0 do
if StartsText('unit|', lfMap.Markers[i].DataString) then
lfMap.Markers.Delete(i);
if aData = nil then
Exit;
for i := 0 to aData.Length - 1 do
begin
item := TJSObject(aData[i]);
lat := Double(item['Lat']);
lng := Double(item['Lng']);
uName := GetJsonString(item, 'UnitName');
unitId := GetJsonString(item, 'UnitId');
unitBadge := GetJsonString(item, 'UnitBadge');
if Trim(unitBadge) = '' then unitBadge := uName;
if Trim(unitBadge) = '' then unitBadge := unitId;
agencyId := GetJsonString(item, 'Agency');
agencyName := GetJsonString(item, 'AgencyName');
agency := agencyName;
if Trim(agency) = '' then agency := agencyId;
agencyType := UpperCase(Trim(GetJsonString(item, 'AgencyType')));
if agencyType = 'FIR' then iconUrl := 'assets/markers/car_fire.png'
else if agencyType = 'EMS' then iconUrl := 'assets/markers/car_ems.png'
else iconUrl := 'assets/markers/car_police.png';
callType := GetJsonString(item, 'CallType');
priorityText := GetJsonString(item, 'Priority');
statusText := GetJsonString(item, 'Status');
updateTimeText := GetJsonString(item, 'UpdateTime');
officer1Lname := GetJsonString(item, 'Officer1Lname');
officer1Fname := GetJsonString(item, 'Officer1Fname');
officer1Empnum := GetJsonString(item, 'Officer1Empnum');
officer2Lname := GetJsonString(item, 'Officer2Lname');
officer2Fname := GetJsonString(item, 'Officer2Fname');
officer2Empnum := GetJsonString(item, 'Officer2Empnum');
canShowDetailsText := '';
if item['CanShowDetails'] <> nil then
canShowDetailsText := string(item['CanShowDetails']);
canShowDetails := SameText(Trim(canShowDetailsText), 'true');
if canShowDetails then
detailsBtnHtml :=
'<button type="button" class="btn btn-primary btn-sm px-2 py-1" ' +
'onclick="window.showUnitDetails(''' + unitId + ''')">' +
'Details' +
'</button>'
else
detailsBtnHtml := '';
officer1Display := '';
if Trim(officer1Lname + officer1Fname + officer1Empnum) <> '' then
begin
officer1Display := Trim(officer1Lname);
if Trim(officer1Fname) <> '' then officer1Display := officer1Display + ', ' + Trim(officer1Fname);
if Trim(officer1Empnum) <> '' then officer1Display := officer1Display + ' (' + Trim(officer1Empnum) + ')';
end;
officer2Display := '';
if Trim(officer2Lname + officer2Fname + officer2Empnum) <> '' then
begin
officer2Display := Trim(officer2Lname);
if Trim(officer2Fname) <> '' then officer2Display := officer2Display + ', ' + Trim(officer2Fname);
if Trim(officer2Empnum) <> '' then officer2Display := officer2Display + ' (' + Trim(officer2Empnum) + ')';
end;
m := lfMap.Markers.Add;
m.Latitude := lat;
m.Longitude := lng;
m.DataString := 'unit|' + unitId + '|' + StringReplace(unitBadge, '|', '/', [rfReplaceAll]);
m.IconURL := iconUrl;
m.Title :=
'<span class="emi-marker-meta" data-marker-type="unit" data-unit-badge="' +
HtmlAttrEncode(unitBadge) +
'" data-picker-label="' +
HtmlAttrEncode('Unit ' + unitBadge) +
'" style="display:none"></span>' +
'<div class="d-flex flex-column gap-1 px-1 py-1" style="width:260px;">' +
'<div class="fw-semibold small"><span class="fw-bold">Unit:</span> ' + uName + '</div>' +
IfThen(agency <> '', '<div class="small"><span class="fw-bold">Agency:</span> ' + agency + '</div>', '') +
IfThen(Trim(callType) <> '', '<div class="small"><span class="fw-bold">Call Type:</span> ' + callType + '</div>', '') +
IfThen(Trim(priorityText) <> '', '<div class="small"><span class="fw-bold">Priority:</span> ' + priorityText + '</div>', '') +
IfThen(Trim(statusText) <> '', '<div class="small"><span class="fw-bold">Status:</span> ' + statusText + '</div>', '') +
IfThen(Trim(officer1Display) <> '', '<div class="small"><span class="fw-bold">Officer 1:</span> ' + officer1Display + '</div>', '') +
IfThen(Trim(officer2Display) <> '', '<div class="small"><span class="fw-bold">Officer 2:</span> ' + officer2Display + '</div>', '') +
IfThen(Trim(updateTimeText) <> '',
'<div class="small mb-1"><span class="fw-bold">Updated:</span> ' + updateTimeText + '</div>',
'<div class="small mb-1"></div>') +
IfThen(detailsBtnHtml <> '', '<div class="d-flex justify-content-end mt-0">' + detailsBtnHtml + '</div>', '') +
'</div>';
end;
end;
procedure TFViewMap.PlaceComplaintMarkers(aData: TJSArray);
var
item, uo: TJSObject;
units: TJSArray;
i, ui: Integer;
m: TTMSFNCMapsMarker;
lat, lng: Double;
complaintId, codeDesc, priority, priorityBadge, complaintStatusKey: string;
agencyId, agencyName, agency, business, address: string;
pngName, iconUrl, rowsHtml: string;
begin
// Remove stale complaint markers
for i := lfMap.Markers.Count - 1 downto 0 do
if StartsText('complaint|', lfMap.Markers[i].DataString) then
lfMap.Markers.Delete(i);
if aData = nil then
Exit;
for i := 0 to aData.Length - 1 do
begin
item := TJSObject(aData[i]);
complaintId := GetJsonString(item, 'ComplaintId');
codeDesc := GetJsonString(item, 'DispatchCodeDesc');
agencyId := GetJsonString(item, 'Agency');
agencyName := GetJsonString(item, 'AgencyName');
agency := agencyName;
if Trim(agency) = '' then agency := agencyId;
priority := GetJsonString(item, 'Priority');
priorityBadge := GetJsonString(item, 'PriorityBadge');
if Trim(priorityBadge) = '' then priorityBadge := '?';
complaintStatusKey := LowerCase(Trim(GetJsonString(item, 'ComplaintStatusKey')));
if complaintStatusKey = '' then complaintStatusKey := 'notattached';
business := GetJsonString(item, 'Business');
address := GetJsonString(item, 'Address');
lat := Double(item['Lat']);
lng := Double(item['Lng']);
if ((lat = 0) and (lng = 0)) or (Abs(lat) > 90) or (Abs(lng) > 180) then
Continue;
pngName := GetJsonString(item, 'pngName');
if Trim(pngName) <> '' then
iconUrl := 'assets/markers/' + pngName
else
iconUrl := 'assets/markers/default_notattached.png';
rowsHtml := '';
units := TJSArray(item['Units']);
if Assigned(units) and (units.Length > 0) then
begin
for ui := 0 to units.Length - 1 do
begin
uo := TJSObject(units[ui]);
rowsHtml := rowsHtml +
'<tr>' +
'<td>' + GetJsonString(uo, 'Unit') + '</td>' +
'<td>' + GetJsonString(uo, 'Status') + '</td>' +
'<td>' + GetJsonString(uo, 'Updated') + '</td>' +
'</tr>';
end;
end
else
rowsHtml := '<tr><td colspan="3" class="text-muted">No units</td></tr>';
m := lfMap.Markers.Add;
m.Latitude := lat;
m.Longitude := lng;
m.DataString := 'complaint|' + complaintId;
m.IconURL := iconUrl;
m.Title :=
'<span class="emi-marker-meta" data-marker-type="complaint" data-priority-badge="' +
HtmlAttrEncode(priorityBadge) +
'" data-complaint-status="' +
HtmlAttrEncode(complaintStatusKey) +
'" data-picker-label="' +
HtmlAttrEncode('Complaint ' + complaintId + IfThen(Trim(codeDesc) <> '', ' - ' + codeDesc, '')) +
'" style="display:none"></span>' +
'<div class="d-flex flex-column gap-1 px-1 py-1" style="width:260px;">' +
'<div class="fw-semibold small"><span class="fw-bold">Complaint:</span> ' + complaintId + '</div>' +
'<div class="small"><span class="fw-bold">Priority:</span> ' + priority + '</div>' +
'<div class="small"><span class="fw-bold">Dispatch Code:</span> ' + codeDesc + '</div>' +
'<div class="small"><span class="fw-bold">Agency:</span> ' + agency + '</div>' +
IfThen(Trim(business) <> '', '<div class="small"><span class="fw-bold">Business:</span> ' + business + '</div>', '') +
'<div class="small mb-1"><span class="fw-bold">Address:</span> ' + address + '</div>' +
'<table class="table table-sm table-bordered mb-1 emi-tip-table">' +
'<colgroup>' +
'<col style="width:34%"><col style="width:33%"><col style="width:33%">' +
'</colgroup>' +
'<thead class="table-light"><tr><th>Unit</th><th>Status</th><th>Updated</th></tr></thead>' +
'<tbody>' + rowsHtml + '</tbody>' +
'</table>' +
'<div class="d-flex justify-content-end mt-0">' +
'<button type="button" class="btn btn-primary btn-sm px-2 py-1" ' +
'onclick="window.showComplaintDetails(''' + complaintId + ''')">' +
'Details' +
'</button>' +
'</div>' +
'</div>';
end;
end;
// --- WebSocket push entry points -------------------------------------------
procedure TFViewMap.ApplyWsUnitMapData(aData: TJSArray);
begin
// Skip if the map is still initialising or an HTTP load is in flight.
if (not Assigned(mapFilters)) or FLoadingPoints then
Exit;
lfMap.BeginUpdate;
try
PlaceUnitMarkers(aData);
finally
lfMap.EndUpdate;
end;
mapFilters.Apply;
ApplyPendingUnitFocus;
end;
procedure TFViewMap.ApplyWsComplaintMapData(aData: TJSArray);
begin
if (not Assigned(mapFilters)) or FLoadingPoints then
Exit;
lfMap.BeginUpdate;
try
PlaceComplaintMarkers(aData);
finally
lfMap.EndUpdate;
end;
mapFilters.Apply;
ApplyPendingComplaintFocus;
end;
procedure TFViewMap.lfMapCustomizeMarker(Sender: TObject; var ACustomizeMarker: string);
begin
......
webEMIMobile/View.Units.pas
......@@ -41,6 +41,7 @@ type
procedure HandleListClick(e: TJSMouseEvent);
public
procedure RefreshData;
procedure ApplyWsData(aRespObj: TJSObject);
end;
var
......@@ -166,5 +167,19 @@ begin
GetUnits;
end;
procedure TFViewUnits.ApplyWsData(aRespObj: TJSObject);
var
unitCount: Integer;
begin
if FLoading then
Exit;
xdwdsUnits.Close;
xdwdsUnits.SetJsonData(aRespObj['data']);
xdwdsUnits.Open;
unitCount := Integer(aRespObj['count']);
lblEntries.Caption := Format('%d units', [unitCount]);
end;
end.
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment