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     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   OwnMemory := True;
  98 end;
  99
 100 procedure TMsg.Free();
 101 begin
 102   if not OwnMemory then
 103     raise Exception.Create('TMsg.Free: called on borrowed memory');
 104   Clear();
 105   OwnMemory := False;
 106   FreeMem(Data);
 107   Data := nil;
 108   MaxSize := 0;
 109 end;
 110
 111 procedure TMsg.Clear();
 112 begin
 113   CurSize := 0;
 114   ReadCount := 0;
 115   Overflow := False;
 116   Bit := 0;
 117 end;
 118
 119 function TMsg.Allocated(): Boolean;
 120 begin
 121   Result := OwnMemory;
 122 end;
 123
 124 procedure TMsg.CopyFrom(var From: TMsg; V: Pointer; N: Integer);
 125 begin
 126   if N < From.CurSize then
 127     raise Exception.Create('TMsg.Copy: can''t copy into a smaller TMsg');
 128   Move(From, Self, SizeOf(TMsg));
 129   Data := V;
 130   Move(From.Data^, Data^, From.CurSize);
 131 end;
 132
 133 function TMsg.AssignBuffer(P: Pointer; N: Integer; Full: Boolean = False): Boolean;
 134 begin
 135   if OwnMemory then Self.Free();
 136   Clear();
 137   Data := P;
 138   MaxSize := N;
 139   if Full then CurSize := N;
 140   Result := (N > 0) and (P <> nil);
 141 end;
 142
 143 procedure TMsg.WriteData(V: Pointer; N: Integer);
 144 begin
 145   if CurSize + N > MaxSize then
 146   begin
 147     Overflow := True;
 148     raise Exception.Create('TMsg.WriteData: buffer overrun!');
 149     Exit;
 150   end;
 151   Move(V^, (Data + CurSize)^, N);
 152   CurSize := CurSize + N;
 153 end;
 154
 155 procedure TMsg.Write(V: TMsg);
 156 begin
 157   if CurSize + V.CurSize > MaxSize then
 158   begin
 159     Overflow := True;
 160     raise Exception.Create('TMsg.WriteData: buffer overrun!');
 161     Exit;
 162   end;
 163   Move(V.Data^, (Data + CurSize)^, V.CurSize);
 164   CurSize := CurSize + V.CurSize;
 165 end;
 166
 167 procedure TMsg.Write(V: Byte); overload;
 168 begin
 169   WriteData(@V, 1);
 170 end;
 171
 172 procedure TMsg.Write(V: Word); overload;
 173 begin
 174   WriteData(@V, 2);
 175 end;
 176
 177 procedure TMsg.Write(V: LongWord); overload;
 178 begin
 179   WriteData(@V, 4);
 180 end;
 181
 182 procedure TMsg.Write(V: ShortInt); overload;
 183 begin
 184   WriteData(@V, 1);
 185 end;
 186
 187 procedure TMsg.Write(V: SmallInt); overload;
 188 begin
 189   WriteData(@V, 2);
 190 end;
 191
 192 procedure TMsg.Write(V: LongInt); overload;
 193 begin
 194   WriteData(@V, 4);
 195 end;
 196
 197 procedure TMsg.Write(V: Int64); overload;
 198 begin
 199   WriteData(@V, 8);
 200 end;
 201
 202 procedure TMsg.Write(V: AnsiString); overload;
 203 var
 204   I: Integer;
 205 begin
 206   // TODO: Write(Word(Length(V)));
 207   Write(Byte(Length(V)));
 208   for I := 1 to High(V) do
 209     Write(Byte(V[I]));
 210 end;
 211
 212 procedure TMsg.Write(V: TMD5Digest); overload;
 213 var
 214   I: Integer;
 215 begin
 216   for I := 0 to 15 do
 217     Write(V[I]);
 218 end;
 219
 220 procedure TMsg.BeginReading();
 221 begin
 222   ReadCount := 0;
 223   Bit := 0;
 224 end;
 225
 226 procedure TMsg.Seek(Pos: Integer);
 227 begin
 228   if Pos > CurSize then
 229     raise Exception.Create('TMsg.Seek: buffer overrun!');
 230   ReadCount := Pos;
 231 end;
 232
 233 procedure TMsg.Skip(Size: Integer);
 234 begin
 235   if ReadCount + Size > CurSize then
 236     raise Exception.Create('TMsg.Skip: buffer overrun!');
 237   ReadCount := ReadCount + Size;
 238 end;
 239
 240 function TMsg.BytesLeft(): Integer;
 241 begin
 242   Result := CurSize - ReadCount;
 243 end;
 244
 245 function TMsg.ReadData(V: Pointer; N: Integer): Integer;
 246 begin
 247   Result := 0;
 248   if ReadCount + N > CurSize then
 249   begin
 250     // TODO: maybe partial reads?
 251     ReadCount := CurSize + 1;
 252     raise Exception.Create('TMsg.ReadData: buffer overrun!');
 253     Exit;
 254   end;
 255   Move((Data + ReadCount)^, V^, N);
 256   ReadCount := ReadCount + N;
 257   Result := N;
 258 end;
 259
 260 function TMsg.ReadChar(): Char;
 261 begin
 262   Result := #0;
 263   ReadData(@Result, 1);
 264 end;
 265
 266 function TMsg.ReadByte(): Byte;
 267 begin
 268   Result := 0;
 269   ReadData(@Result, 1);
 270 end;
 271
 272 function TMsg.ReadWord(): Word;
 273 begin
 274   Result := 0;
 275   ReadData(@Result, 2);
 276 end;
 277
 278 function TMsg.ReadLongWord(): LongWord;
 279 begin
 280   Result := 0;
 281   ReadData(@Result, 4);
 282 end;
 283
 284 function TMsg.ReadShortInt(): ShortInt;
 285 begin
 286   Result := 0;
 287   ReadData(@Result, 1);
 288 end;
 289
 290 function TMsg.ReadSmallInt(): SmallInt;
 291 begin
 292   Result := 0;
 293   ReadData(@Result, 2);
 294 end;
 295
 296 function TMsg.ReadLongInt(): LongInt;
 297 begin
 298   Result := 0;
 299   ReadData(@Result, 4);
 300 end;
 301
 302 function TMsg.ReadInt64(): Int64;
 303 begin
 304   Result := 0;
 305   ReadData(@Result, 8);
 306 end;
 307
 308 function TMsg.ReadString(): string;
 309 var
 310   I: Integer;
 311   L: Byte;
 312 begin
 313   Result := '';
 314   // TODO: L := ReadWord();
 315   L := ReadByte();
 316   if (L > 0) and (L <> Byte(-1)) then
 317   begin
 318     SetLength(Result, L);
 319     for I := 1 to L do
 320       Result[I] := ReadChar();
 321   end;
 322 end;
 323
 324 function TMsg.ReadMD5(): TMD5Digest;
 325 var
 326   I: Integer;
 327 begin
 328   for I := 0 to 15 do
 329     Result[I] := ReadByte();
 330 end;
 331
 332 end.