pas2js/demo/websockets/demowebsocket.lpr

program demowebsocket;

{$mode objfpc}
{$modeswitch externalclass}

uses
  browserconsole, browserapp, JS, Classes, SysUtils, Web, strutils;



type
  TServerConfig = Class External name 'Object' (TJSObject)
    url : string;
  end;

Var
  ServerConfig : TServerConfig; external name 'serverConfig';


Type
  { TMyApplication }
  TMsgKind = (mkIncoming,mkOutgoing,mkSystem);

  TMyApplication = class(TBrowserApplication)
    btnSend: TJSHTMLButtonElement;
    EdtSender : TJSHTMLInputElement;
    EdtMessage : TJSHTMLInputElement;
    EdtRecipient : TJSHTMLInputElement;
    divMessages : TJSHTMLDivElement;
    btnConnect : TJSHTMLButtonElement;
    WS : TJSWebSocket;
    procedure doRun; override;
  private
    function AppendIcon(aParent: TJSHTMLElement; aName: String): TJSHTMLElement;
    function CreateMessageEl(aKind : TMsgKind): TJSHTMLElement;
    procedure DisplayClose;
    procedure DisplayOpen;
    function DoClosed(Event: TEventListenerEvent): boolean;
    procedure doConnect;
    function DoIncomingMessage(Event: TEventListenerEvent): boolean;
    procedure DisplayMessage(Sender, Msg: String; Incoming: Boolean=True);
    function DoOpen(Event: TEventListenerEvent): boolean;
    function DoReconnect(aEvent: TJSMouseEvent): boolean;
    function DoSendClick(aEvent: TJSMouseEvent): boolean;
    function DoToggleConnectClick(aEvent: TJSMouseEvent): boolean;
    procedure SendMessage(const aRecipient, aMessage: String);
  end;



procedure TMyApplication.doRun;

begin
  edtRecipient:=TJSHTMLInputElement(GetHTMLElement('edtRecipient'));
  edtSender:=TJSHTMLInputElement(GetHTMLElement('edtSender'));
  edtMessage:=TJSHTMLInputElement(GetHTMLElement('edtMessage'));
  btnConnect:=TJSHTMLButtonElement(GetHTMLElement('btnConnect'));
  btnConnect.onclick:=@DoToggleConnectClick;
  btnSend:=TJSHTMLButtonElement(GetHTMLElement('btnSend'));
  btnSend.onclick:=@DoSendClick;
  divMessages:=TJSHTMLDivElement(GetHTMLElement('messages'));
  DoConnect;
  Terminate;
end;

procedure TMyApplication.doConnect;

Var
  URL,aHost : string;

begin
  URL:='';
  if Assigned(ServerConfig) and isString(serverConfig.URL) then
    URL:=serverConfig.URL;
  if URL='' then
    begin
    aHost:=window.location.host;
    aHost:=ExtractWord(1,aHost,[':']);
    URL:='ws://'+aHost+':8080/';
    end;
  try
    WS:=TJSWebsocket.New(url);
    WS.onmessage:=@DoIncomingMessage;
    WS.onclose:=@DoClosed;
    WS.onopen:=@DoOpen;
  except
    on TJSError do
      Window.Alert('Could not connect to websocket server at '+URL);
  end;
end;

function TMyApplication.DoOpen(Event: TEventListenerEvent): boolean;
begin
  btnSend.disabled:=False;
  DisplayOpen;
  btnConnect.InnerText:='Disconnect';
end;

function TMyApplication.DoClosed(Event: TEventListenerEvent): boolean;
begin
  btnSend.disabled:=true;
  btnConnect.InnerText:='Connect';
  DisplayClose;
end;

function TMyApplication.DoIncomingMessage(Event: TEventListenerEvent): boolean;

Var
  Msg: TJSMessageEvent absolute Event;
  JS : TJSObject;

begin
   if isString(Msg.Data) then
     begin
     JS:=TJSJSON.parseObject(String(Msg.Data));
     DisplayMessage(String(JS['from']),String(JS['msg']),True)
     end
   else
     DisplayMessage('','<<unknown data arrived>>',True);
end;

function TMyApplication.CreateMessageEl(aKind : TMsgKind): TJSHTMLElement;

Var
  ImgDiv,ImgEl,msgEl : TJSHTMLElement;

begin
  MsgEl:=TJSHTMLElement(Document.createElement('DIV'));
  if aKind=mkSystem then
    begin
    MsgEl.className:='text-center my-2';
    end
  else
    begin
    msgEl.className:='d-flex align-items-center'+Ifthen(aKind=mkIncoming,'',' text-right justify-content-end');
    ImgDiv:=TJSHTMLElement(Document.createElement('DIV'));
    ImgDiv.ClassName:='text-left pr-1';
    ImgEl:=TJSHTMLElement(Document.createElement('IMG'));
    ImgEl['Src']:=IfThen(aKind=mkIncoming,'guest','you')+'.png';
    ImgDiv.AppendChild(ImgEl);
    if aKind=mkIncoming then
      msgEl.AppendChild(ImgDiv);
    end;
  Result:=TJSHTMLElement(Document.createElement(IfThen(aKind=mkSystem,'span','div')));
  if aKind=mkSystem then
    Result.className:='between'
  else
    Result.className:='pr-2'+IfThen(aKind=mkIncoming,' pl-1','');
  msgEl.AppendChild(Result);
  if aKind=mkOutgoing then
    msgEl.AppendChild(ImgDiv);
  divMessages.appendChild(msgEl);
  msgEl.scrollIntoView;
end;

function TMyApplication.AppendIcon(aParent: TJSHTMLElement; aName: String
  ): TJSHTMLElement;

begin
  Result:=TJSHTMLElement(Document.createElement('i'));
  Result.className:='fas fa-'+aName+' mr-3';
  aParent.AppendChild(Result);
end;

procedure TMyApplication.DisplayClose;

Var
  iEl,pEl : TJSHTMLElement;

begin
  Pel:=CreateMessageEl(mkSystem);
  iEl:=AppendIcon(Pel,'plug');
  iEl.onclick:=@DoReconnect;
  pEl.AppendChild(Document.createTextNode('Connection closed, click icon to reconnect'));
end;

procedure TMyApplication.DisplayOpen;

Var
  pEl : TJSHTMLElement;

begin
  Pel:=CreateMessageEl(mkSystem);
  AppendIcon(Pel,'link');
  pEl.AppendChild(Document.createTextNode('Connection open, you can start messaging'));
end;



procedure TMyApplication.DisplayMessage(Sender,Msg: String; Incoming: Boolean = True);

Const
   kinds : Array[Boolean] of TMsgKind = (mkOutgoing,mkIncoming);

Var
  pEl,pEl2 : TJSHTMLElement;

begin
  pEl:=CreateMessageEl(Kinds[Incoming]);
  if (Sender<>'') then
    begin
    pEl2:=TJSHTMLElement(Document.createElement('span'));
    pEl2.className:='name';
    pEl2.innerText:=Sender;
    pEl.appendChild(pEl2);
    end;
  pEl2:=TJSHTMLElement(Document.createElement('p'));
  PEL2.className:='msg';
  PEL2.AppendChild(Document.createTextNode(Msg));
  pEl.AppendChild(pEL2);
end;

function TMyApplication.DoReconnect(aEvent: TJSMouseEvent): boolean;
begin
  DoConnect;
end;

procedure TMyApplication.SendMessage(const aRecipient,aMessage: String);

Var
  JS : TJSObject;

begin
  JS:=New(['from',EdtSender.Value,'msg',aMessage,'to',aRecipient]);
  WS.send(TJSJSON.Stringify(JS));
  DisplayMessage('you',aMessage,False);
end;

function TMyApplication.DoSendClick(aEvent: TJSMouseEvent): boolean;
begin
  SendMessage(EDTRecipient.Value, EdtMessage.Value);
end;

function TMyApplication.DoToggleConnectClick(aEvent: TJSMouseEvent): boolean;
begin
  if btnConnect.InnerText='Connect' then
    doConnect
  else
    begin
    WS.close;
    WS:=nil;
    end;
end;

var
  Application : TMyApplication;

begin
  Application:=TMyApplication.Create(nil);
  Application.Initialize;
  Application.Run;
end.