DEADSOFTWARE

implement SDL1.2 system driver
[d2df-sdl.git] / src / game / g_netmaster.pas
index b413486f610d0276c9d82ca515efdb2a649c41ea..2ecad14c74378d27d7f666bf9c7dc01c39d792d8 100644 (file)
@@ -2,8 +2,7 @@
  *
  * This program is free software: you can redistribute it and/or modify
  * it under the terms of the GNU General Public License as published by
- * the Free Software Foundation, either version 3 of the License, or
- * (at your option) any later version.
+ * the Free Software Foundation, version 3 of the License ONLY.
  *
  * This program is distributed in the hope that it will be useful,
  * but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -55,9 +54,6 @@ type
   TNetServerTable = array of TNetServerRow;
 
 var
-  NetMHost:       pENetHost = nil;
-  NetMPeer:       pENetPeer = nil;
-
   slCurrent:       TNetServerList = nil;
   slTable:         TNetServerTable = nil;
   slWaitStr:       string = '';
@@ -68,36 +64,106 @@ var
 
 procedure g_Net_Slist_Set(IP: string; Port: Word);
 function  g_Net_Slist_Fetch(var SL: TNetServerList): Boolean;
-procedure g_Net_Slist_Update();
+procedure g_Net_Slist_Update (immediateSend: Boolean=true);
 procedure g_Net_Slist_Remove();
-function  g_Net_Slist_Connect(): Boolean;
+function  g_Net_Slist_Connect(blocking: Boolean=True): Boolean;
 procedure g_Net_Slist_Check();
-procedure g_Net_Slist_Disconnect();
+procedure g_Net_Slist_Disconnect (spamConsole: Boolean=true);
 procedure g_Net_Slist_WriteInfo();
 
+function g_Net_Slist_IsConnectionActive (): Boolean; // returns `false` if totally disconnected
+function g_Net_Slist_IsConnectionInProgress (): Boolean;
+
 procedure g_Serverlist_GenerateTable(SL: TNetServerList; var ST: TNetServerTable);
 procedure g_Serverlist_Draw(var SL: TNetServerList; var ST: TNetServerTable);
 procedure g_Serverlist_Control(var SL: TNetServerList; var ST: TNetServerTable);
 
+function GetTimerMS(): Int64;
+
+
 implementation
 
 uses
   SysUtils, e_msg, e_input, e_graphics, e_log, g_window, g_net, g_console,
   g_map, g_game, g_sound, g_gui, g_menu, g_options, g_language, g_basic,
-  wadreader;
+  wadreader, g_system;
 
 var
-  NetMEvent:      ENetEvent;
-  slSelection:    Byte = 0;
-  slFetched:      Boolean = False;
-  slDirPressed:   Boolean = False;
-  slReadUrgent:   Boolean = False;
+  NetMHost: pENetHost = nil;
+  NetMPeer: pENetPeer = nil;
+  NetMEvent: ENetEvent;
+  slSelection: Byte = 0;
+  slFetched: Boolean = False;
+  slDirPressed: Boolean = False;
+  slReadUrgent: Boolean = False;
+  // inside the game, calling `g_Net_Slist_Connect()` is disasterous, as it is blocking.
+  // so we'll use this variable to indicate if "connected" event is received.
+  NetHostConnected: Boolean = false;
+  NetHostConReqTime: Int64 = 0; // to timeout `connect`
+  NetUpdatePending: Boolean = false;
+
+
+function GetTimerMS (): Int64;
+begin
+  Result := sys_GetTicks() {div 1000};
+end;
 
-function GetTimerMS(): Int64;
+
+// returns `false` if totally disconnected
+function g_Net_Slist_IsConnectionActive (): Boolean;
+begin
+  result := (NetMHost <> nil) and (NetMPeer <> nil);
+end;
+
+
+function g_Net_Slist_IsConnectionInProgress (): Boolean;
 begin
-  Result := GetTimer() {div 1000};
+  if (NetMHost = nil) or (NetMPeer = nil) then begin result := false; exit; end;
+  result := (not NetHostConnected);
+end;
+
+
+// should be called only if host/peer is here
+// returns `false` if not connected/dead
+function ProcessPendingConnection (): Boolean;
+var
+  ct: Int64;
+begin
+  result := false;
+  if (NetMHost = nil) or (NetMPeer = nil) then exit;
+  // are we waiting for connection?
+  if (not NetHostConnected) then
+  begin
+    // check for connection event
+    if (enet_host_service(NetMHost, @NetMEvent, 0) > 0) then
+    begin
+      if (NetMEvent.kind = ENET_EVENT_TYPE_CONNECT) then
+      begin
+        NetHostConnected := true;
+        if NetUpdatePending then g_Net_Slist_Update(false);
+        g_Console_Add(_lc[I_NET_MSG]+_lc[I_NET_SLIST_CONN]);
+        result := true;
+        exit;
+      end;
+      if (NetMEvent.kind = ENET_EVENT_TYPE_RECEIVE) then enet_packet_destroy(NetMEvent.packet);
+    end;
+    // check for connection timeout
+    if (not NetHostConnected) then
+    begin
+      ct := GetTimerMS();
+      if (ct < NetHostConReqTime) or (ct-NetHostConReqTime >= 3000) then
+      begin
+        // do not spam with error messages, it looks like the master is down
+        //g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_SLIST_ERROR], True);
+        g_Net_Slist_Disconnect(false);
+      end;
+      exit;
+    end;
+  end;
+  result := true;
 end;
 
+
 procedure PingServer(var S: TNetServer; Sock: ENetSocket);
 var
   Buf: ENetBuffer;
@@ -381,13 +447,18 @@ begin
   NetOut.Write(Byte(NetPassword <> ''));
 end;
 
-procedure g_Net_Slist_Update;
-var
 
+procedure g_Net_Slist_Update (immediateSend: Boolean=true);
+var
   P: pENetPacket;
-
 begin
-  if (NetMHost = nil) or (NetMPeer = nil) then Exit;
+  if not ProcessPendingConnection() then
+  begin
+    NetUpdatePending := g_Net_Slist_IsConnectionInProgress();
+    exit;
+  end;
+
+  NetUpdatePending := false;
 
   NetOut.Clear();
   NetOut.Write(Byte(NET_MMSG_UPD));
@@ -398,7 +469,7 @@ begin
   P := enet_packet_create(NetOut.Data, NetOut.CurSize, Cardinal(ENET_PACKET_FLAG_RELIABLE));
   enet_peer_send(NetMPeer, NET_MCHAN_UPD, P);
 
-  enet_host_flush(NetMHost);
+  if (immediateSend) then enet_host_flush(NetMHost);
   NetOut.Clear();
 end;
 
@@ -406,7 +477,8 @@ procedure g_Net_Slist_Remove;
 var
   P: pENetPacket;
 begin
-  if (NetMHost = nil) or (NetMPeer = nil) then Exit;
+  if not ProcessPendingConnection() then exit;
+
   NetOut.Clear();
   NetOut.Write(Byte(NET_MMSG_DEL));
   NetOut.Write(NetAddr.port);
@@ -418,10 +490,22 @@ begin
   NetOut.Clear();
 end;
 
-function g_Net_Slist_Connect: Boolean;
+function g_Net_Slist_Connect (blocking: Boolean=True): Boolean;
+var
+  delay: Integer;
 begin
   Result := False;
 
+  if g_Net_Slist_IsConnectionActive then
+  begin
+    if not blocking then exit;
+    g_Net_Slist_Disconnect(false);
+  end;
+
+  NetHostConnected := False; // just in case
+  NetHostConReqTime := 0; // just in case
+  NetUpdatePending := false;
+
   NetMHost := enet_host_create(nil, 1, NET_MCHANS, 0, 0);
   if (NetMHost = nil) then
   begin
@@ -438,10 +522,12 @@ begin
     Exit;
   end;
 
-  if (enet_host_service(NetMHost, @NetMEvent, 3000) > 0) then
+  if (blocking) then delay := 3000 else delay := 0;
+  if (enet_host_service(NetMHost, @NetMEvent, delay) > 0) then
     if NetMEvent.kind = ENET_EVENT_TYPE_CONNECT then
     begin
       Result := True;
+      NetHostConnected := True;
       g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_SLIST_CONN]);
       Exit;
     end
@@ -449,17 +535,30 @@ begin
       if NetMEvent.kind = ENET_EVENT_TYPE_RECEIVE then
         enet_packet_destroy(NetMEvent.packet);
 
-  g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_SLIST_ERROR], True);
+  if (blocking) then
+  begin
+    g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_SLIST_ERROR], True);
 
-  NetMHost := nil;
-  NetMPeer := nil;
+    if NetMPeer <> nil then enet_peer_reset(NetMPeer);
+    if NetMHost <> nil then enet_host_destroy(NetMHost);
+    NetMPeer := nil;
+    NetMHost := nil;
+    NetHostConnected := False;
+    NetHostConReqTime := 0;
+    NetUpdatePending := false;
+  end
+  else
+  begin
+    NetHostConReqTime := GetTimerMS();
+    g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_SLIST_WCONN]);
+  end;
 end;
 
-procedure g_Net_Slist_Disconnect;
+procedure g_Net_Slist_Disconnect (spamConsole: Boolean=true);
 begin
   if (NetMHost = nil) and (NetMPeer = nil) then Exit;
 
-  if NetMode = NET_SERVER then g_Net_Slist_Remove;
+  if (NetMode = NET_SERVER) and (NetHostConnected) then g_Net_Slist_Remove;
 
   enet_peer_disconnect(NetMPeer, 0);
   enet_host_flush(NetMHost);
@@ -469,13 +568,18 @@ begin
 
   NetMPeer := nil;
   NetMHost := nil;
+  NetHostConnected := False;
+  NetHostConReqTime := 0;
+  NetUpdatePending := false;
 
-  g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_SLIST_DISC]);
+  if (spamConsole) then g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_SLIST_DISC]);
 end;
 
 procedure g_Net_Slist_Check;
 begin
-  if (NetMHost = nil) or (NetMPeer = nil) then Exit;
+  if not ProcessPendingConnection() then exit;
+
+  if (NetUpdatePending) then g_Net_Slist_Update(false);
 
   while (enet_host_service(NetMHost, @NetMEvent, 0) > 0) do
   begin
@@ -486,6 +590,9 @@ begin
       if NetMHost <> nil then enet_host_destroy(NetMHost);
       NetMPeer := nil;
       NetMHost := nil;
+      NetHostConnected := False;
+      NetHostConReqTime := 0;
+      NetUpdatePending := false;
       Break;
     end
     else
@@ -530,7 +637,7 @@ end;
 procedure g_Serverlist_Draw(var SL: TNetServerList; var ST: TNetServerTable);
 var
   Srv: TNetServer;
-  sy, i, y, mw, mx, l: Integer;
+  sy, i, y, mw, mx, l, motdh: Integer;
   cw: Byte = 0;
   ch: Byte = 0;
   ww: Word = 0;
@@ -548,23 +655,25 @@ begin
   ip := _lc[I_NET_SLIST_HELP];
   mw := (Length(ip) * cw) div 2;
 
-  e_DrawFillQuad(16, 64, gScreenWidth-16, gScreenHeight-84, 64, 64, 64, 110);
-  e_DrawQuad(16, 64, gScreenWidth-16, gScreenHeight-84, 255, 127, 0);
+  motdh := gScreenHeight - 49 - ch * b_Text_LineCount(slMOTD);
+
+  e_DrawFillQuad(16, 64, gScreenWidth-16, motdh, 64, 64, 64, 110);
+  e_DrawQuad(16, 64, gScreenWidth-16, motdh, 255, 127, 0);
 
   e_TextureFontPrintEx(gScreenWidth div 2 - mw, gScreenHeight-24, ip, gStdFont, 225, 225, 225, 1);
 
   // MOTD
   if slMOTD <> '' then
   begin
-    e_DrawFillQuad(16, gScreenHeight-84, gScreenWidth-16, gScreenHeight-44, 64, 64, 64, 110);
-    e_DrawQuad(16, gScreenHeight-84, gScreenWidth-16, gScreenHeight-44, 255, 127, 0);
-    e_TextureFontPrintFmt(20, gScreenHeight-81, slMOTD, gStdFont, False, True);
+    e_DrawFillQuad(16, motdh, gScreenWidth-16, gScreenHeight-44, 64, 64, 64, 110);
+    e_DrawQuad(16, motdh, gScreenWidth-16, gScreenHeight-44, 255, 127, 0);
+    e_TextureFontPrintFmt(20, motdh + 3, slMOTD, gStdFont, False, True);
   end;
 
   // Urgent message
   if not slReadUrgent and (slUrgent <> '') then
   begin
-    e_DrawFillQuad(17, 65, gScreenWidth-17, gScreenHeight-85, 64, 64, 64, 128);
+    e_DrawFillQuad(17, 65, gScreenWidth-17, motdh-1, 64, 64, 64, 128);
     e_DrawFillQuad(gScreenWidth div 2 - 256, gScreenHeight div 2 - 60,
       gScreenWidth div 2 + 256, gScreenHeight div 2 + 60, 64, 64, 64, 128);
     e_DrawQuad(gScreenWidth div 2 - 256, gScreenHeight div 2 - 60,
@@ -588,7 +697,7 @@ begin
   if SL = nil then
   begin
     l := Length(slWaitStr) div 2;
-    e_DrawFillQuad(17, 65, gScreenWidth-17, gScreenHeight-85, 64, 64, 64, 128);
+    e_DrawFillQuad(17, 65, gScreenWidth-17, motdh-1, 64, 64, 64, 128);
     e_DrawQuad(gScreenWidth div 2 - 192, gScreenHeight div 2 - 10,
       gScreenWidth div 2 + 192, gScreenHeight div 2 + 11, 255, 127, 0);
     e_TextureFontPrint(gScreenWidth div 2 - cw * l, gScreenHeight div 2 - ch div 2,
@@ -619,12 +728,12 @@ begin
   e_DrawLine(1, 16 + 1, sy + 41, gScreenWidth - 16 - 1, sy + 41, 255, 255, 255);
 
   e_DrawLine(1, 16, 85, gScreenWidth - 16, 85, 255, 127, 0);
-  e_DrawLine(1, 16, gScreenHeight-104, gScreenWidth-16, gScreenHeight-104, 255, 127, 0);
+  e_DrawLine(1, 16, motdh-20, gScreenWidth-16, motdh-20, 255, 127, 0);
 
-  e_DrawLine(1, mx - 70, 64, mx - 70, gScreenHeight-84, 255, 127, 0);
-  e_DrawLine(1, mx, 64, mx, gScreenHeight-104, 255, 127, 0);
-  e_DrawLine(1, mx + 52, 64, mx + 52, gScreenHeight-104, 255, 127, 0);
-  e_DrawLine(1, mx + 104, 64, mx + 104, gScreenHeight-104, 255, 127, 0);
+  e_DrawLine(1, mx - 70, 64, mx - 70, motdh, 255, 127, 0);
+  e_DrawLine(1, mx, 64, mx, motdh-20, 255, 127, 0);
+  e_DrawLine(1, mx + 52, 64, mx + 52, motdh-20, 255, 127, 0);
+  e_DrawLine(1, mx + 104, 64, mx + 104, motdh-20, 255, 127, 0);
 
   e_TextureFontPrintEx(18, 68, 'NAME/MAP', gStdFont, 255, 127, 0, 1);
   e_TextureFontPrintEx(mx - 68, 68, 'PING', gStdFont, 255, 127, 0, 1);
@@ -665,10 +774,10 @@ begin
     y := y + 42;
   end;
 
-  e_TextureFontPrintEx(20, gScreenHeight-101, ip, gStdFont, 205, 205, 205, 1);
+  e_TextureFontPrintEx(20, motdh-20+3, ip, gStdFont, 205, 205, 205, 1);
   ip := IntToStr(Length(ST)) + _lc[I_NET_SLIST_SERVERS];
   e_TextureFontPrintEx(gScreenWidth - 48 - (Length(ip) + 1)*cw,
-    gScreenHeight-101, ip, gStdFont, 205, 205, 205, 1);
+    motdh-20+3, ip, gStdFont, 205, 205, 205, 1);
 end;
 
 procedure g_Serverlist_GenerateTable(SL: TNetServerList; var ST: TNetServerTable);
@@ -767,7 +876,7 @@ begin
   if gConsoleShow or gChatShow then
     Exit;
 
-  qm := g_ProcessMessages(); // this updates kbd
+  qm := sys_HandleInput(); // this updates kbd
 
   if qm or e_KeyPressed(IK_ESCAPE) or e_KeyPressed(VK_ESCAPE) or
      e_KeyPressed(JOY0_JUMP) or e_KeyPressed(JOY1_JUMP) or
@@ -783,7 +892,7 @@ begin
     Exit;
   end;
 
-  // if there's a message on the screen, 
+  // if there's a message on the screen,
   if not slReadUrgent and (slUrgent <> '') then
   begin
     if e_KeyPressed(IK_RETURN) or e_KeyPressed(IK_KPRETURN) or e_KeyPressed(VK_FIRE) or e_KeyPressed(VK_OPEN) or
@@ -800,7 +909,7 @@ begin
       slWaitStr := _lc[I_NET_SLIST_WAIT];
 
       g_Game_Draw;
-      g_window.ReDrawWindow;
+      sys_Repaint;
 
       if g_Net_Slist_Fetch(SL) then
       begin