Changeset 6 for trunk/CmdList.pas
- Timestamp:
- Jan 7, 2017, 11:32:14 AM (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/CmdList.pas
r2 r6 1 1 {$INCLUDE switches} 2 3 2 unit CmdList; 4 3 … … 6 5 7 6 uses 8 Classes;7 Classes; 9 8 10 9 const 11 MaxDataSize=1024;10 MaxDataSize = 1024; 12 11 13 12 type 14 TLogData=array[0..999999999] of Byte;15 16 TCmdListState=record17 nLog, {used size of LogData in bytes}18 LoadPos, {position in LogData when loading a game}19 LastMovingUnit: integer;20 MoveCode, LoadMoveCode: Cardinal;13 TLogData = array [0 .. 999999999] of Byte; 14 15 TCmdListState = record 16 nLog, { used size of LogData in bytes } 17 LoadPos, { position in LogData when loading a game } 18 LastMovingUnit: integer; 19 MoveCode, LoadMoveCode: Cardinal; 21 20 end; 22 21 23 TCmdList=class 24 constructor Create; 25 destructor Destroy; override; 26 procedure Get(var Command, Player, Subject: integer; var Data: pointer); 27 procedure GetDataChanges(Data: pointer; DataSize: integer); 28 procedure Put(Command, Player, Subject: integer; Data: pointer); 29 procedure PutDataChanges(Command, Player: integer; OldData, NewData: pointer; DataSize: integer); 30 procedure LoadFromFile(const f: TFileStream); 31 procedure SaveToFile(const f: TFileStream); 32 procedure AppendToFile(const f: TFileStream; const OldState: TCmdListState); 33 procedure Cut; 34 function Progress: integer; 35 private 36 LogAlloc: integer; {allocated size of LogData in bytes} 37 LogData: ^TLogData; 38 FState: TCmdListState; 39 procedure PutData(Data: pointer; Length: integer); 40 procedure CompleteMoveCode; 41 public 42 property State: TCmdListState read FState write FState; 22 TCmdList = class 23 constructor Create; 24 destructor Destroy; override; 25 procedure Get(var Command, Player, Subject: integer; var Data: pointer); 26 procedure GetDataChanges(Data: pointer; DataSize: integer); 27 procedure Put(Command, Player, Subject: integer; Data: pointer); 28 procedure PutDataChanges(Command, Player: integer; 29 OldData, NewData: pointer; DataSize: integer); 30 procedure LoadFromFile(const f: TFileStream); 31 procedure SaveToFile(const f: TFileStream); 32 procedure AppendToFile(const f: TFileStream; const OldState: TCmdListState); 33 procedure Cut; 34 function Progress: integer; 35 private 36 LogAlloc: integer; { allocated size of LogData in bytes } 37 LogData: ^TLogData; 38 FState: TCmdListState; 39 procedure PutData(Data: pointer; Length: integer); 40 procedure CompleteMoveCode; 41 public 42 property State: TCmdListState read FState write FState; 43 43 end; 44 44 … … 46 46 47 47 uses 48 Protocol;48 Protocol; 49 49 50 50 const 51 LogGrow=1 shl 18;51 LogGrow = 1 shl 18; 52 52 53 53 type 54 TData=array[0..MaxDataSize-1] of Cardinal;55 PData=^TData;54 TData = array [0 .. MaxDataSize - 1] of Cardinal; 55 PData = ^TData; 56 56 57 57 constructor TCmdList.Create; 58 58 begin 59 inherited Create;60 FState.nLog:=0;61 LogAlloc:=0;62 LogData:=nil;63 FState.LastMovingUnit:=-1;64 FState.MoveCode:=0;65 FState.LoadMoveCode:=0;59 inherited Create; 60 FState.nLog := 0; 61 LogAlloc := 0; 62 LogData := nil; 63 FState.LastMovingUnit := -1; 64 FState.MoveCode := 0; 65 FState.LoadMoveCode := 0; 66 66 end; 67 67 68 68 destructor TCmdList.Destroy; 69 69 begin 70 ReallocMem(LogData, 0); 71 inherited Destroy; 72 end; 73 74 procedure TCmdList.Get(var Command, Player, Subject: integer; var Data: pointer); 70 ReallocMem(LogData, 0); 71 inherited Destroy; 72 end; 73 74 procedure TCmdList.Get(var Command, Player, Subject: integer; 75 var Data: pointer); 75 76 var 76 DirCode, code: Cardinal;77 begin 78 if FState.LoadMoveCode>0 then79 begin 80 Player:=-1;81 if FState.LoadMoveCode and 1=1 then77 DirCode, code: Cardinal; 78 begin 79 if FState.LoadMoveCode > 0 then 80 begin 81 Player := -1; 82 if FState.LoadMoveCode and 1 = 1 then 82 83 begin // FM 83 DirCode:=FState.LoadMoveCode shr 1 and 7; 84 Subject:=FState.LastMovingUnit; 85 FState.LoadMoveCode:=FState.LoadMoveCode shr 4; 86 end 84 DirCode := FState.LoadMoveCode shr 1 and 7; 85 Subject := FState.LastMovingUnit; 86 FState.LoadMoveCode := FState.LoadMoveCode shr 4; 87 end 88 else 89 begin // M 90 DirCode := FState.LoadMoveCode shr 3 and 7; 91 Subject := FState.LoadMoveCode shr 6 and $FFF; 92 FState.LoadMoveCode := FState.LoadMoveCode shr 18; 93 FState.LastMovingUnit := Subject 94 end; 95 case DirCode of 96 0: 97 Command := sMoveUnit + $090; 98 1: 99 Command := sMoveUnit + $0F0; 100 2: 101 Command := sMoveUnit + $390; 102 3: 103 Command := sMoveUnit + $3F0; 104 4: 105 Command := sMoveUnit + $020; 106 5: 107 Command := sMoveUnit + $060; 108 6: 109 Command := sMoveUnit + $100; 110 7: 111 Command := sMoveUnit + $300; 112 end; 113 Data := nil; 114 end 87 115 else 88 begin // M 89 DirCode:=FState.LoadMoveCode shr 3 and 7; 90 Subject:=FState.LoadMoveCode shr 6 and $FFF; 91 FState.LoadMoveCode:=FState.LoadMoveCode shr 18; 92 FState.LastMovingUnit:=Subject 93 end; 94 case DirCode of 95 0: Command:=sMoveUnit+$090; 96 1: Command:=sMoveUnit+$0F0; 97 2: Command:=sMoveUnit+$390; 98 3: Command:=sMoveUnit+$3F0; 99 4: Command:=sMoveUnit+$020; 100 5: Command:=sMoveUnit+$060; 101 6: Command:=sMoveUnit+$100; 102 7: Command:=sMoveUnit+$300; 103 end; 104 Data:=nil; 105 end 106 else 107 begin 108 code:=Cardinal((@LogData[FState.LoadPos])^); 109 if code and 3=0 then 116 begin 117 code := Cardinal((@LogData[FState.LoadPos])^); 118 if code and 3 = 0 then 110 119 begin // non-clientex command 111 Command:=code shr 2 and $3FFF +sExecute;112 Player:=code shr 16 and $f;113 Subject:=code shr 20 and $FFF;114 inc(FState.LoadPos,4);115 end 116 else if code and 7=2 then120 Command := code shr 2 and $3FFF + sExecute; 121 Player := code shr 16 and $F; 122 Subject := code shr 20 and $FFF; 123 inc(FState.LoadPos, 4); 124 end 125 else if code and 7 = 2 then 117 126 begin // clientex command 118 Command:=code shr 3 and $FFFF;119 Player:=code shr 19 and $f;120 Subject:=0;121 inc(FState.LoadPos,3);122 end 123 else127 Command := code shr 3 and $FFFF; 128 Player := code shr 19 and $F; 129 Subject := 0; 130 inc(FState.LoadPos, 3); 131 end 132 else 124 133 begin // move command shortcut 125 if (code and 1=1) and (code and (7 shl 4)<>6 shl 4) then 126 begin FState.LoadMoveCode:=code and $FF; inc(FState.LoadPos) end 127 else begin FState.LoadMoveCode:=code and $FFFFFF; inc(FState.LoadPos,3); end; 128 Get(Command, Player, Subject, Data); 129 exit; 130 end; 131 132 if Command and $f=0 then Data:=nil 133 else 134 begin 135 Data:=@LogData[FState.LoadPos]; 136 inc(FState.LoadPos,Command and $f *4); 134 if (code and 1 = 1) and (code and (7 shl 4) <> 6 shl 4) then 135 begin 136 FState.LoadMoveCode := code and $FF; 137 inc(FState.LoadPos) 138 end 139 else 140 begin 141 FState.LoadMoveCode := code and $FFFFFF; 142 inc(FState.LoadPos, 3); 143 end; 144 Get(Command, Player, Subject, Data); 145 exit; 146 end; 147 148 if Command and $F = 0 then 149 Data := nil 150 else 151 begin 152 Data := @LogData[FState.LoadPos]; 153 inc(FState.LoadPos, Command and $F * 4); 137 154 end 138 155 end … … 141 158 procedure TCmdList.GetDataChanges(Data: pointer; DataSize: integer); 142 159 var 143 b0, b1: integer; 144 Map0, Map1: Cardinal; 145 begin 146 Map0:=Cardinal((@LogData[FState.LoadPos])^); 147 inc(FState.LoadPos,4); 148 b0:=0; 149 while Map0>0 do 150 begin 151 if Map0 and 1<>0 then 152 begin 153 Map1:=Cardinal((@LogData[FState.LoadPos])^); 154 inc(FState.LoadPos,4); 155 for b1:=0 to 31 do if 1 shl b1 and Map1<>0 then 156 begin 157 if b0*32+b1<DataSize then 158 PData(Data)[b0*32+b1]:=Cardinal((@LogData[FState.LoadPos])^); 159 inc(FState.LoadPos,4); 160 end; 161 end; 162 inc(b0); 163 Map0:=Map0 shr 1; 160 b0, b1: integer; 161 Map0, Map1: Cardinal; 162 begin 163 Map0 := Cardinal((@LogData[FState.LoadPos])^); 164 inc(FState.LoadPos, 4); 165 b0 := 0; 166 while Map0 > 0 do 167 begin 168 if Map0 and 1 <> 0 then 169 begin 170 Map1 := Cardinal((@LogData[FState.LoadPos])^); 171 inc(FState.LoadPos, 4); 172 for b1 := 0 to 31 do 173 if 1 shl b1 and Map1 <> 0 then 174 begin 175 if b0 * 32 + b1 < DataSize then 176 PData(Data)[b0 * 32 + b1] := Cardinal((@LogData[FState.LoadPos])^); 177 inc(FState.LoadPos, 4); 178 end; 179 end; 180 inc(b0); 181 Map0 := Map0 shr 1; 164 182 end 165 183 end; … … 167 185 procedure TCmdList.Put(Command, Player, Subject: integer; Data: pointer); 168 186 var 169 DirCode, code: Cardinal;170 begin 171 if Command and $FC00=sMoveUnit then187 DirCode, code: Cardinal; 188 begin 189 if Command and $FC00 = sMoveUnit then 172 190 begin // move command shortcut 173 case Command of 174 sMoveUnit+$090: DirCode:=0; 175 sMoveUnit+$0F0: DirCode:=1; 176 sMoveUnit+$390: DirCode:=2; 177 sMoveUnit+$3F0: DirCode:=3; 178 sMoveUnit+$020: DirCode:=4; 179 sMoveUnit+$060: DirCode:=5; 180 sMoveUnit+$100: DirCode:=6; 181 sMoveUnit+$300: DirCode:=7; 182 end; 183 if Subject=FState.LastMovingUnit then code:=1+DirCode shl 1 184 else code:=6+DirCode shl 3+Cardinal(Subject) shl 6; 185 if FState.MoveCode=0 then FState.MoveCode:=code 186 else if FState.MoveCode and 1=1 then 191 case Command of 192 sMoveUnit + $090: 193 DirCode := 0; 194 sMoveUnit + $0F0: 195 DirCode := 1; 196 sMoveUnit + $390: 197 DirCode := 2; 198 sMoveUnit + $3F0: 199 DirCode := 3; 200 sMoveUnit + $020: 201 DirCode := 4; 202 sMoveUnit + $060: 203 DirCode := 5; 204 sMoveUnit + $100: 205 DirCode := 6; 206 sMoveUnit + $300: 207 DirCode := 7; 208 end; 209 if Subject = FState.LastMovingUnit then 210 code := 1 + DirCode shl 1 211 else 212 code := 6 + DirCode shl 3 + Cardinal(Subject) shl 6; 213 if FState.MoveCode = 0 then 214 FState.MoveCode := code 215 else if FState.MoveCode and 1 = 1 then 187 216 begin // FM + this 188 FState.MoveCode:=FState.MoveCode+code shl 4; 189 if code and 1=1 then PutData(@FState.MoveCode, 1) // FM + FM 190 else PutData(@FState.MoveCode, 3); // FM + M 191 FState.MoveCode:=0; 192 end 193 else if code and 1=1 then 217 FState.MoveCode := FState.MoveCode + code shl 4; 218 if code and 1 = 1 then 219 PutData(@FState.MoveCode, 1) // FM + FM 220 else 221 PutData(@FState.MoveCode, 3); // FM + M 222 FState.MoveCode := 0; 223 end 224 else if code and 1 = 1 then 194 225 begin // M + FM 195 FState.MoveCode:=FState.MoveCode+code shl 18;196 PutData(@FState.MoveCode, 3);197 FState.MoveCode:=0;198 end 199 else // M + M200 begin 201 PutData(@FState.MoveCode, 3);202 FState.MoveCode:=code203 end; 204 FState.LastMovingUnit:=Subject;226 FState.MoveCode := FState.MoveCode + code shl 18; 227 PutData(@FState.MoveCode, 3); 228 FState.MoveCode := 0; 229 end 230 else // M + M 231 begin 232 PutData(@FState.MoveCode, 3); 233 FState.MoveCode := code 234 end; 235 FState.LastMovingUnit := Subject; 205 236 end 206 else 207 begin 237 else 238 begin 239 CompleteMoveCode; 240 if Command >= cClientEx then 241 begin 242 code := 2 + Command shl 3 + Player shl 19; 243 PutData(@code, 3); 244 end 245 else 246 begin 247 code := Cardinal(Command - sExecute) shl 2 + Cardinal(Player) shl 16 + 248 Cardinal(Subject) shl 20; 249 PutData(@code, 4); 250 end; 251 end; 252 if Command and $F <> 0 then 253 PutData(Data, Command and $F * 4); 254 end; 255 256 procedure TCmdList.PutDataChanges(Command, Player: integer; 257 OldData, NewData: pointer; DataSize: integer); 258 var 259 MapPos, LogPos, b0, b1, RowEnd: integer; 260 Map0, Map1, code: Cardinal; 261 begin 262 if DataSize <= 0 then 263 exit; 264 if DataSize > MaxDataSize then 265 DataSize := MaxDataSize; 208 266 CompleteMoveCode; 209 if Command>=cClientEx then 210 begin 211 code:=2+Command shl 3+Player shl 19; 212 PutData(@code, 3); 213 end 214 else 215 begin 216 code:=Cardinal(Command-sExecute) shl 2+Cardinal(Player) shl 16 217 +Cardinal(Subject) shl 20; 218 PutData(@code, 4); 267 MapPos := FState.nLog + 8; 268 LogPos := MapPos + 4; 269 Map0 := 0; 270 for b0 := 0 to (DataSize - 1) div 32 do 271 begin 272 if LogPos + 4 * 32 > LogAlloc then 273 begin 274 inc(LogAlloc, LogGrow); 275 ReallocMem(LogData, LogAlloc); 276 end; 277 Map0 := Map0 shr 1; 278 Map1 := 0; 279 RowEnd := DataSize - 1; 280 if RowEnd > b0 * 32 + 31 then 281 RowEnd := b0 * 32 + 31; 282 for b1 := b0 * 32 to RowEnd do 283 begin 284 Map1 := Map1 shr 1; 285 if PData(NewData)[b1] <> PData(OldData)[b1] then 286 begin 287 Cardinal((@LogData[LogPos])^) := PData(NewData)[b1]; 288 inc(LogPos, 4); 289 inc(Map1, $80000000); 290 end; 291 end; 292 if Map1 > 0 then 293 begin 294 Map1 := Map1 shr (b0 * 32 + 31 - RowEnd); 295 Cardinal((@LogData[MapPos])^) := Map1; 296 MapPos := LogPos; 297 inc(LogPos, 4); 298 inc(Map0, $80000000); 219 299 end; 220 300 end; 221 if Command and $f<>0 then PutData(Data, Command and $f *4); 222 end; 223 224 procedure TCmdList.PutDataChanges(Command, Player: integer; OldData, 225 NewData: pointer; DataSize: integer); 226 var 227 MapPos, LogPos, b0, b1, RowEnd: integer; 228 Map0, Map1, code: Cardinal; 229 begin 230 if DataSize<=0 then exit; 231 if DataSize>MaxDataSize then DataSize:=MaxDataSize; 232 CompleteMoveCode; 233 MapPos:=FState.nLog+8; 234 LogPos:=MapPos+4; 235 Map0:=0; 236 for b0:=0 to (DataSize-1) div 32 do 237 begin 238 if LogPos+4*32>LogAlloc then 239 begin 301 if Map0 = 0 then 302 exit; // no changes 303 304 Map0 := Map0 shr (31 - (DataSize - 1) div 32); 305 Cardinal((@LogData[FState.nLog + 4])^) := Map0; 306 code := Cardinal(Command - sExecute) shl 2 + Cardinal(Player) shl 16; 307 Cardinal((@LogData[FState.nLog])^) := code; 308 FState.nLog := MapPos 309 end; 310 311 procedure TCmdList.PutData(Data: pointer; Length: integer); 312 begin 313 if FState.nLog + Length > LogAlloc then 314 begin 240 315 inc(LogAlloc, LogGrow); 241 316 ReallocMem(LogData, LogAlloc); 242 end;243 Map0:=Map0 shr 1;244 Map1:=0;245 RowEnd:=DataSize-1;246 if RowEnd>b0*32+31 then RowEnd:=b0*32+31;247 for b1:=b0*32 to RowEnd do248 begin249 Map1:=Map1 shr 1;250 if PData(NewData)[b1]<>PData(OldData)[b1] then251 begin252 Cardinal((@LogData[LogPos])^):=PData(NewData)[b1];253 inc(LogPos,4);254 inc(Map1,$80000000);255 end;256 end;257 if Map1>0 then258 begin259 Map1:=Map1 shr (b0*32+31-RowEnd);260 Cardinal((@LogData[MapPos])^):=Map1;261 MapPos:=LogPos;262 inc(LogPos,4);263 inc(Map0,$80000000);264 end;265 317 end; 266 if Map0=0 then exit; // no changes 267 268 Map0:=Map0 shr (31-(DataSize-1) div 32); 269 Cardinal((@LogData[FState.nLog+4])^):=Map0; 270 code:=Cardinal(Command-sExecute) shl 2+Cardinal(Player) shl 16; 271 Cardinal((@LogData[FState.nLog])^):=code; 272 FState.nLog:=MapPos 273 end; 274 275 procedure TCmdList.PutData(Data: pointer; Length: integer); 276 begin 277 if FState.nLog+Length>LogAlloc then 278 begin 279 inc(LogAlloc, LogGrow); 318 move(Data^, LogData[FState.nLog], Length); 319 inc(FState.nLog, Length); 320 end; 321 322 procedure TCmdList.CompleteMoveCode; 323 begin 324 if FState.MoveCode > 0 then 325 begin 326 if FState.MoveCode and 1 = 1 then 327 PutData(@FState.MoveCode, 1) // Single FM 328 else 329 PutData(@FState.MoveCode, 3); // Single M 330 FState.MoveCode := 0; 331 end 332 end; 333 334 procedure TCmdList.LoadFromFile(const f: TFileStream); 335 begin 336 f.read(FState.nLog, 4); 337 LogData := nil; 338 LogAlloc := ((FState.nLog + 2) div LogGrow + 1) * LogGrow; 280 339 ReallocMem(LogData, LogAlloc); 281 end; 282 move(Data^, LogData[FState.nLog], Length); 283 inc(FState.nLog, Length); 284 end; 285 286 procedure TCmdList.CompleteMoveCode; 287 begin 288 if FState.MoveCode>0 then 289 begin 290 if FState.MoveCode and 1=1 then PutData(@FState.MoveCode, 1) // Single FM 291 else PutData(@FState.MoveCode, 3); // Single M 292 FState.MoveCode:=0; 293 end 294 end; 295 296 procedure TCmdList.LoadFromFile(const f: TFileStream); 297 begin 298 f.read(FState.nLog, 4); 299 LogData:=nil; 300 LogAlloc:=((FState.nLog+2) div LogGrow +1)*LogGrow; 301 ReallocMem(LogData, LogAlloc); 302 f.read(LogData^, FState.nLog); 303 FState.LoadPos:=0; 340 f.read(LogData^, FState.nLog); 341 FState.LoadPos := 0; 304 342 end; 305 343 306 344 procedure TCmdList.SaveToFile(const f: TFileStream); 307 345 begin 308 CompleteMoveCode; 309 f.write(FState.nLog, 4); 310 f.write(LogData^, FState.nLog) 311 end; 312 313 procedure TCmdList.AppendToFile(const f: TFileStream; const OldState: TCmdListState); 314 begin 315 CompleteMoveCode; 316 f.write(FState.nLog, 4); 317 f.Position:=f.Position+OldState.nLog; 318 f.write(LogData[OldState.nLog], FState.nLog-OldState.nLog) 346 CompleteMoveCode; 347 f.write(FState.nLog, 4); 348 f.write(LogData^, FState.nLog) 349 end; 350 351 procedure TCmdList.AppendToFile(const f: TFileStream; 352 const OldState: TCmdListState); 353 begin 354 CompleteMoveCode; 355 f.write(FState.nLog, 4); 356 f.Position := f.Position + OldState.nLog; 357 f.write(LogData[OldState.nLog], FState.nLog - OldState.nLog) 319 358 end; 320 359 321 360 procedure TCmdList.Cut; 322 361 begin 323 FState.nLog:=FState.LoadPos;362 FState.nLog := FState.LoadPos; 324 363 end; 325 364 326 365 function TCmdList.Progress: integer; 327 366 begin 328 if (FState.LoadPos=FState.nLog) and (FState.LoadMoveCode=0) then 329 result:=1000 // loading complete 330 else if FState.nLog>1 shl 20 then 331 result:=(FState.LoadPos shr 8)*999 div (FState.nLog shr 8) 332 else result:=FState.LoadPos*999 div FState.nLog 333 end; 334 335 {Format Specification: 336 337 Non-ClientEx-Command: 367 if (FState.LoadPos = FState.nLog) and (FState.LoadMoveCode = 0) then 368 result := 1000 // loading complete 369 else if FState.nLog > 1 shl 20 then 370 result := (FState.LoadPos shr 8) * 999 div (FState.nLog shr 8) 371 else 372 result := FState.LoadPos * 999 div FState.nLog 373 end; 374 375 { Format Specification: 376 377 Non-ClientEx-Command: 338 378 Byte3 Byte2 Byte1 Byte0 339 379 ssssssss sssspppp cccccccc cccccc00 340 380 (c = Command-sExecute, p = Player, s = Subject) 341 381 342 ClientEx-Command:382 ClientEx-Command: 343 383 Byte2 Byte1 Byte0 344 384 0ppppccc cccccccc ccccc010 345 385 (c = Command, p = Player) 346 386 347 Single Move:387 Single Move: 348 388 Byte2 Byte1 Byte0 349 389 000000ss ssssssss ssaaa110 350 390 (a = Direction, s = Subject) 351 391 352 Move + Follow Move:392 Move + Follow Move: 353 393 Byte2 Byte1 Byte0 354 394 00bbb1ss ssssssss ssaaa110 355 395 (a = Direction 1, s = Subject 1, b = Direction 2) 356 396 357 Follow Move + Move:397 Follow Move + Move: 358 398 Byte2 Byte1 Byte0 359 399 00ssssss ssssssbb b110aaa1 360 400 (a = Direction 1, b = Direction 2, s = Subject 2) 361 401 362 Single Follow Move:402 Single Follow Move: 363 403 Byte0 364 404 0000aaa1 365 405 (a = Direction) 366 406 367 Double Follow Move:407 Double Follow Move: 368 408 Byte0 369 409 bbb1aaa1 … … 372 412 373 413 end. 374
Note:
See TracChangeset
for help on using the changeset viewer.