src/engine/e_msg.pas

   1 (* Copyright (C)  Doom 2D: Forever Developers
   2  *
   3  * This program is free software: you can redistribute it and/or modify
   4  * it under the terms of the GNU General Public License as published by
   5  * the Free Software Foundation, version 3 of the License ONLY.
   6  *
   7  * This program is distributed in the hope that it will be useful,
   8  * but WITHOUT ANY WARRANTY; without even the implied warranty of
   9  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  10  * GNU General Public License for more details.
  11  *
  12  * You should have received a copy of the GNU General Public License
  13  * along with this program.  If not, see <http://www.gnu.org/licenses/>.
  14  *)
  15 {$INCLUDE ../shared/a_modes.inc}
  16 unit e_msg;
  17
  18 interface
  19
  20 uses md5;
  21
  22 type
  23   TMsg = record
  24     Data: Pointer;
  25     Overflow: Boolean;
  26     MaxSize: Integer;
  27     CurSize: Integer;
  28     ReadCount: Integer;
  29     Bit: Integer;
  30     AllocStep: Integer;
  31     OwnMemory: Boolean;
  32
  33     function Init(V: Pointer; N: Integer; Full: Boolean = False): Boolean;
  34     procedure Alloc(N: Integer);
  35     procedure Clear();
  36     procedure Free();
  37     procedure CopyFrom(var From: TMsg; V: Pointer; N: Integer);
  38     function Allocated(): Boolean;
  39     function AssignBuffer(P: Pointer; N: Integer; Full: Boolean = False): Boolean;
  40
  41     procedure BeginReading();
  42     procedure Seek(Pos: Integer);
  43     procedure Skip(Size: Integer);
  44     function BytesLeft(): Integer;
  45     function ReadData(V: Pointer; N: Integer): Integer;
  46     function ReadChar(): Char;
  47     function ReadByte(): Byte;
  48     function ReadWord(): Word;
  49     function ReadLongWord(): LongWord;
  50     function ReadShortInt(): ShortInt;
  51     function ReadSmallInt(): SmallInt;
  52     function ReadLongInt(): LongInt;
  53     function ReadInt64(): Int64;
  54     function ReadString(): String;
  55     function ReadMD5(): TMD5Digest;
  56
  57     procedure WriteData(V: Pointer; N: Integer);
  58     procedure Write(V: Byte); overload;
  59     procedure Write(V: Word); overload;
  60     procedure Write(V: LongWord); overload;
  61     procedure Write(V: ShortInt); overload;
  62     procedure Write(V: SmallInt); overload;
  63     procedure Write(V: LongInt); overload;
  64     procedure Write(V: Int64); overload;
  65     procedure Write(V: String); overload;
  66     procedure Write(V: TMD5Digest); overload;
  67     procedure Write(V: TMsg);
  68   end;
  69
  70 type
  71   pTMsg = ^TMsg;
  72
  73 implementation
  74
  75 uses SysUtils, e_log;
  76
  77 function TMsg.Init(V: Pointer; N: Integer; Full: Boolean = False): Boolean;
  78 begin
  79   Overflow := False;
  80   if Full then CurSize := N else CurSize := 0;
  81   ReadCount := 0;
  82   Bit := 0;
  83   MaxSize := N;
  84   Data := V;
  85   OwnMemory := False;
  86   Result := (N > 0) and (V <> nil);
  87 end;
  88
  89 procedure TMsg.Alloc(N: Integer);
  90 var
  91   P: Pointer;
  92 begin
  93   P := GetMem(N);
  94   if P = nil then
  95     raise Exception.Create('TMsg.Alloc: no mem');
  96   Init(P, N);
  97   AllocStep := N;
  98   OwnMemory := True;
  99 end;
 100
 101 procedure TMsg.Free();
 102 begin
 103   if not OwnMemory then
 104     raise Exception.Create('TMsg.Free: called on borrowed memory');
 105   Clear();
 106   OwnMemory := False;
 107   FreeMem(Data);
 108   Data := nil;
 109   MaxSize := 0;
 110 end;
 111
 112 procedure TMsg.Clear();
 113 begin
 114   CurSize := 0;
 115   ReadCount := 0;
 116   Overflow := False;
 117   Bit := 0;
 118 end;
 119
 120 function TMsg.Allocated(): Boolean;
 121 begin
 122   Result := OwnMemory;
 123 end;
 124
 125 procedure TMsg.CopyFrom(var From: TMsg; V: Pointer; N: Integer);
 126 begin
 127   if N < From.CurSize then
 128     raise Exception.Create('TMsg.Copy: can''t copy into a smaller TMsg');
 129   Move(From, Self, SizeOf(TMsg));
 130   Data := V;
 131   Move(From.Data^, Data^, From.CurSize);
 132 end;
 133
 134 function TMsg.AssignBuffer(P: Pointer; N: Integer; Full: Boolean = False): Boolean;
 135 begin
 136   if OwnMemory then Self.Free();
 137   Clear();
 138   Data := P;
 139   MaxSize := N;
 140   if Full then CurSize := N;
 141   Result := (N > 0) and (P <> nil);
 142 end;
 143
 144 procedure TMsg.WriteData(V: Pointer; N: Integer);
 145 var
 146   NewSize: Integer;
 147 begin
 148   if CurSize + N > MaxSize then
 149   begin
 150     if OwnMemory then
 151     begin
 152       NewSize := MaxSize + ((N + AllocStep - 1) div AllocStep) * AllocStep; // round up
 153       if ReAllocMem(Data, NewSize) = nil then
 154         raise Exception.Create('TMsg.WriteData: out of memory on realloc');
 155       MaxSize := NewSize;
 156     end
 157     else
 158     begin
 159       Overflow := True;
 160       raise Exception.Create('TMsg.WriteData: buffer overrun on borrowed memory!');
 161     end;
 162   end;
 163
 164   Move(V^, (Data + CurSize)^, N);
 165   CurSize := CurSize + N;
 166 end;
 167
 168 procedure TMsg.Write(V: TMsg);
 169 begin
 170   WriteData(V.Data, V.CurSize);
 171 end;
 172
 173 procedure TMsg.Write(V: Byte); overload;
 174 begin
 175   WriteData(@V, 1);
 176 end;
 177
 178 procedure TMsg.Write(V: Word); overload;
 179 begin
 180   V := NtoLE(V);
 181   WriteData(@V, 2);
 182 end;
 183
 184 procedure TMsg.Write(V: LongWord); overload;
 185 begin
 186   V := NtoLE(V);
 187   WriteData(@V, 4);
 188 end;
 189
 190 procedure TMsg.Write(V: ShortInt); overload;
 191 begin
 192   V := NtoLE(V);
 193   WriteData(@V, 1);
 194 end;
 195
 196 procedure TMsg.Write(V: SmallInt); overload;
 197 begin
 198   V := NtoLE(V);
 199   WriteData(@V, 2);
 200 end;
 201
 202 procedure TMsg.Write(V: LongInt); overload;
 203 begin
 204   V := NtoLE(V);
 205   WriteData(@V, 4);
 206 end;
 207
 208 procedure TMsg.Write(V: Int64); overload;
 209 begin
 210   V := NtoLE(V);
 211   WriteData(@V, 8);
 212 end;
 213
 214 procedure TMsg.Write(V: AnsiString); overload;
 215 var
 216   I: Integer;
 217 begin
 218   // TODO: Write(Word(Length(V)));
 219   Write(Byte(Length(V)));
 220   for I := 1 to High(V) do
 221     Write(Byte(V[I]));
 222 end;
 223
 224 procedure TMsg.Write(V: TMD5Digest); overload;
 225 var
 226   I: Integer;
 227 begin
 228   for I := 0 to 15 do
 229     Write(V[I]);
 230 end;
 231
 232 procedure TMsg.BeginReading();
 233 begin
 234   ReadCount := 0;
 235   Bit := 0;
 236 end;
 237
 238 procedure TMsg.Seek(Pos: Integer);
 239 begin
 240   if Pos > CurSize then
 241     raise Exception.Create('TMsg.Seek: buffer overrun!');
 242   ReadCount := Pos;
 243 end;
 244
 245 procedure TMsg.Skip(Size: Integer);
 246 begin
 247   if ReadCount + Size > CurSize then
 248     raise Exception.Create('TMsg.Skip: buffer overrun!');
 249   ReadCount := ReadCount + Size;
 250 end;
 251
 252 function TMsg.BytesLeft(): Integer;
 253 begin
 254   Result := CurSize - ReadCount;
 255 end;
 256
 257 function TMsg.ReadData(V: Pointer; N: Integer): Integer;
 258 begin
 259   Result := 0;
 260   if ReadCount + N > CurSize then
 261   begin
 262     // TODO: maybe partial reads?
 263     ReadCount := CurSize + 1;
 264     raise Exception.Create('TMsg.ReadData: buffer overrun!');
 265     Exit;
 266   end;
 267   Move((Data + ReadCount)^, V^, N);
 268   ReadCount := ReadCount + N;
 269   Result := N;
 270 end;
 271
 272 function TMsg.ReadChar(): Char;
 273 begin
 274   Result := #0;
 275   ReadData(@Result, 1);
 276 end;
 277
 278 function TMsg.ReadByte(): Byte;
 279 begin
 280   Result := 0;
 281   ReadData(@Result, 1);
 282 end;
 283
 284 function TMsg.ReadWord(): Word;
 285 begin
 286   Result := 0;
 287   ReadData(@Result, 2);
 288   Result := LEtoN(Result);
 289 end;
 290
 291 function TMsg.ReadLongWord(): LongWord;
 292 begin
 293   Result := 0;
 294   ReadData(@Result, 4);
 295   Result := LEtoN(Result);
 296 end;
 297
 298 function TMsg.ReadShortInt(): ShortInt;
 299 begin
 300   Result := 0;
 301   ReadData(@Result, 1);
 302   Result := LEtoN(Result);
 303 end;
 304
 305 function TMsg.ReadSmallInt(): SmallInt;
 306 begin
 307   Result := 0;
 308   ReadData(@Result, 2);
 309   Result := LEtoN(Result);
 310 end;
 311
 312 function TMsg.ReadLongInt(): LongInt;
 313 begin
 314   Result := 0;
 315   ReadData(@Result, 4);
 316   Result := LEtoN(Result);
 317 end;
 318
 319 function TMsg.ReadInt64(): Int64;
 320 begin
 321   Result := 0;
 322   ReadData(@Result, 8);
 323   Result := LEtoN(Result);
 324 end;
 325
 326 function TMsg.ReadString(): string;
 327 var
 328   I: Integer;
 329   L: Byte;
 330 begin
 331   Result := '';
 332   // TODO: L := ReadWord();
 333   L := ReadByte();
 334   if (L > 0) and (L <> Byte(-1)) then
 335   begin
 336     SetLength(Result, L);
 337     for I := 1 to L do
 338       Result[I] := ReadChar();
 339   end;
 340 end;
 341
 342 function TMsg.ReadMD5(): TMD5Digest;
 343 var
 344   I: Integer;
 345 begin
 346   for I := 0 to 15 do
 347     Result[I] := ReadByte();
 348 end;
 349
 350 end.