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