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   WriteData(@V, 2);
 181 end;
 182
 183 procedure TMsg.Write(V: LongWord); overload;
 184 begin
 185   WriteData(@V, 4);
 186 end;
 187
 188 procedure TMsg.Write(V: ShortInt); overload;
 189 begin
 190   WriteData(@V, 1);
 191 end;
 192
 193 procedure TMsg.Write(V: SmallInt); overload;
 194 begin
 195   WriteData(@V, 2);
 196 end;
 197
 198 procedure TMsg.Write(V: LongInt); overload;
 199 begin
 200   WriteData(@V, 4);
 201 end;
 202
 203 procedure TMsg.Write(V: Int64); overload;
 204 begin
 205   WriteData(@V, 8);
 206 end;
 207
 208 procedure TMsg.Write(V: AnsiString); overload;
 209 var
 210   I: Integer;
 211 begin
 212   // TODO: Write(Word(Length(V)));
 213   Write(Byte(Length(V)));
 214   for I := 1 to High(V) do
 215     Write(Byte(V[I]));
 216 end;
 217
 218 procedure TMsg.Write(V: TMD5Digest); overload;
 219 var
 220   I: Integer;
 221 begin
 222   for I := 0 to 15 do
 223     Write(V[I]);
 224 end;
 225
 226 procedure TMsg.BeginReading();
 227 begin
 228   ReadCount := 0;
 229   Bit := 0;
 230 end;
 231
 232 procedure TMsg.Seek(Pos: Integer);
 233 begin
 234   if Pos > CurSize then
 235     raise Exception.Create('TMsg.Seek: buffer overrun!');
 236   ReadCount := Pos;
 237 end;
 238
 239 procedure TMsg.Skip(Size: Integer);
 240 begin
 241   if ReadCount + Size > CurSize then
 242     raise Exception.Create('TMsg.Skip: buffer overrun!');
 243   ReadCount := ReadCount + Size;
 244 end;
 245
 246 function TMsg.BytesLeft(): Integer;
 247 begin
 248   Result := CurSize - ReadCount;
 249 end;
 250
 251 function TMsg.ReadData(V: Pointer; N: Integer): Integer;
 252 begin
 253   Result := 0;
 254   if ReadCount + N > CurSize then
 255   begin
 256     // TODO: maybe partial reads?
 257     ReadCount := CurSize + 1;
 258     raise Exception.Create('TMsg.ReadData: buffer overrun!');
 259     Exit;
 260   end;
 261   Move((Data + ReadCount)^, V^, N);
 262   ReadCount := ReadCount + N;
 263   Result := N;
 264 end;
 265
 266 function TMsg.ReadChar(): Char;
 267 begin
 268   Result := #0;
 269   ReadData(@Result, 1);
 270 end;
 271
 272 function TMsg.ReadByte(): Byte;
 273 begin
 274   Result := 0;
 275   ReadData(@Result, 1);
 276 end;
 277
 278 function TMsg.ReadWord(): Word;
 279 begin
 280   Result := 0;
 281   ReadData(@Result, 2);
 282 end;
 283
 284 function TMsg.ReadLongWord(): LongWord;
 285 begin
 286   Result := 0;
 287   ReadData(@Result, 4);
 288 end;
 289
 290 function TMsg.ReadShortInt(): ShortInt;
 291 begin
 292   Result := 0;
 293   ReadData(@Result, 1);
 294 end;
 295
 296 function TMsg.ReadSmallInt(): SmallInt;
 297 begin
 298   Result := 0;
 299   ReadData(@Result, 2);
 300 end;
 301
 302 function TMsg.ReadLongInt(): LongInt;
 303 begin
 304   Result := 0;
 305   ReadData(@Result, 4);
 306 end;
 307
 308 function TMsg.ReadInt64(): Int64;
 309 begin
 310   Result := 0;
 311   ReadData(@Result, 8);
 312 end;
 313
 314 function TMsg.ReadString(): string;
 315 var
 316   I: Integer;
 317   L: Byte;
 318 begin
 319   Result := '';
 320   // TODO: L := ReadWord();
 321   L := ReadByte();
 322   if (L > 0) and (L <> Byte(-1)) then
 323   begin
 324     SetLength(Result, L);
 325     for I := 1 to L do
 326       Result[I] := ReadChar();
 327   end;
 328 end;
 329
 330 function TMsg.ReadMD5(): TMD5Digest;
 331 var
 332   I: Integer;
 333 begin
 334   for I := 0 to 15 do
 335     Result[I] := ReadByte();
 336 end;
 337
 338 end.