Changeset 590
- Timestamp:
- Jul 24, 2024, 10:25:56 PM (4 months ago)
- Location:
- trunk
- Files:
-
- 1 added
- 4 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/Database.pas
r558 r590 7 7 8 8 uses 9 SysUtils, Protocol, CmdList ;9 SysUtils, Protocol, CmdList, Map; 10 10 11 11 const … … 120 120 function MapGeneratorAvailable: Boolean; 121 121 procedure CreateElevation; 122 procedure CreateMap( preview: Boolean);122 procedure CreateMap(Preview: Boolean); 123 123 procedure InitMapEditor; 124 124 procedure ReleaseMapEditor; … … 970 970 end; 971 971 972 procedure CreateMap( preview: Boolean);972 procedure CreateMap(Preview: Boolean); 973 973 const 974 974 ShHiHills = 6; { of land } … … 1089 1089 1090 1090 var 1091 X, Y, N, Dir, plus, Count, Loc0, Loc1, bLand, bHills, bMountains, V8: Integer;1091 X, Y, N, Dir, Plus, Count, Loc0, Loc1, bLand, bHills, bMountains, V8: Integer; 1092 1092 CopyFrom: array [0 .. lxmax * lymax - 1] of Integer; 1093 1093 Adjacent: TVicinity8Loc; … … 1095 1095 begin 1096 1096 FillChar(RealMap, MapSize * SizeOf(Cardinal), 0); 1097 plus := 0;1097 Plus := 0; 1098 1098 bMountains := 256; 1099 while plus < MapSize * LandMass * ShMountains div 10000 do1099 while Plus < MapSize * LandMass * ShMountains div 10000 do 1100 1100 begin 1101 1101 Dec(bMountains); 1102 Inc( plus, ElCount[bMountains]);1103 end; 1104 Count := plus;1105 plus := 0;1102 Inc(Plus, ElCount[bMountains]); 1103 end; 1104 Count := Plus; 1105 Plus := 0; 1106 1106 bHills := bMountains; 1107 while plus < MapSize * LandMass * ShHiHills div 10000 do1107 while Plus < MapSize * LandMass * ShHiHills div 10000 do 1108 1108 begin 1109 1109 Dec(bHills); 1110 Inc( plus, ElCount[bHills]);1111 end; 1112 Inc(Count, plus);1110 Inc(Plus, ElCount[bHills]); 1111 end; 1112 Inc(Count, Plus); 1113 1113 bLand := bHills; 1114 1114 while Count < MapSize * LandMass div 100 do … … 1144 1144 end; 1145 1145 1146 if not preview then1147 begin 1148 plus := 36 * 56 * 20 * ShTestRiver div (LandMass * 100);1149 if plus > MapSize then1150 plus := MapSize;1146 if not Preview then 1147 begin 1148 Plus := 36 * 56 * 20 * ShTestRiver div (LandMass * 100); 1149 if Plus > MapSize then 1150 Plus := MapSize; 1151 1151 Loc0 := DelphiRandom(MapSize); 1152 for N := 0 to plus - 1 do1152 for N := 0 to Plus - 1 do 1153 1153 begin 1154 1154 if (RealMap[Loc0] and fTerrain >= fGrass) and (Loc0 >= lx) and … … 1267 1267 ($F shl 27); 1268 1268 1269 if not preview then1269 if not Preview then 1270 1270 begin 1271 1271 FindContinents; … … 1941 1941 // cix=-2 - don't search city, don't calculate city benefits, just government of player p 1942 1942 var 1943 p0, Tile, special: Integer;1943 p0, Tile, Special: Integer; 1944 1944 begin 1945 1945 with Info do … … 1971 1971 end; // no city found here 1972 1972 1973 special := Tile and fSpecial and ResourceMask[P] shr 5;1973 Special := Tile and fSpecial and ResourceMask[P] shr 5; 1974 1974 with Terrain[Tile and fTerrain] do 1975 1975 begin 1976 Food := FoodRes[ special];1977 Prod := ProdRes[ special];1978 Trade := TradeRes[ special];1979 if ( special > 0) and (Tile and fTerrain <> fGrass) and1976 Food := FoodRes[Special]; 1977 Prod := ProdRes[Special]; 1978 Trade := TradeRes[Special]; 1979 if (Special > 0) and (Tile and fTerrain <> fGrass) and 1980 1980 (RW[P].NatBuilt[imSpacePort] > 0) then 1981 1981 begin // GeoSat effect -
trunk/GameServer.pas
r589 r590 8 8 uses 9 9 Protocol, Database, DynLibs, Platform, DateUtils, LazFileUtils, Brain, Global, 10 Map, 10 11 {$IFDEF DPI}Graphics{$ELSE}Graphics{$ENDIF}; 11 12 … … 73 74 function LoadGame(const FileName: string; Turn: Integer; 74 75 MovieMode: Boolean): Boolean; 75 procedure EditMap(const Map: string; Newlx, Newly, NewLandMass: Integer);76 procedure EditMap(const AMapFileName: string; Newlx, Newly, NewLandMass: Integer); 76 77 procedure DirectHelp(Command: Integer); 77 78 function ToAutoSaveFileName(FileName: string): string; … … 80 81 procedure ChangeClient; 81 82 procedure NextPlayer; 82 function PreviewMap( lm: Integer): Pointer;83 function PreviewMap(ALandMass: Integer): Pointer; 83 84 84 85 … … 283 284 end; 284 285 285 function PreviewMap( lm: Integer): Pointer;286 function PreviewMap(ALandMass: Integer): Pointer; 286 287 begin 287 288 lx := lxmax; 288 289 ly := lymax; 289 290 MapSize := lx * ly; 290 LandMass := lm;291 LandMass := ALandMass; 291 292 DelphiRandSeed := PreviewRND; 292 293 if not PreviewElevation then … … 563 564 end; 564 565 565 procedure SaveMap(FileName: string);566 var567 I: Integer;568 MapFile: TFileStream;569 S: string[255];570 begin571 MapFile := TFileStream.Create(FileName, fmCreate or fmShareExclusive);572 try573 MapFile.Position := 0;574 S := 'cEvoMap'#0;575 MapFile.Write(S[1], 8); { file id }576 I := 0;577 MapFile.Write(I, 4); { format id }578 MapFile.Write(MaxTurn, 4);579 MapFile.Write(lx, 4);580 MapFile.Write(ly, 4);581 MapFile.Write(RealMap, MapSize * 4);582 finally583 FreeAndNil(MapFile);584 end;585 end;586 587 function LoadMap(FileName: string): Boolean;588 var589 I, Loc1: Integer;590 MapFile: TFileStream;591 S: string[255];592 begin593 Result := False;594 if not FileExists(FileName) then Exit;595 MapFile := TFileStream.Create(FileName, fmOpenRead or fmShareExclusive);596 try597 MapFile.Position := 0;598 MapFile.Read(S[1], 8); { file id }599 MapFile.Read(I, 4); { format id }600 if I = 0 then601 begin602 MapFile.Read(I, 4); // MaxTurn603 MapFile.Read(lx, 4);604 MapFile.Read(ly, 4);605 ly := ly and not 1;606 if lx > lxmax then607 lx := lxmax;608 if ly > lymax then609 ly := lymax;610 MapSize := lx * ly;611 MapFile.Read(RealMap, MapSize * 4);612 for Loc1 := 0 to MapSize - 1 do613 begin614 RealMap[Loc1] := RealMap[Loc1] and615 ($7F01FFFF or fPrefStartPos or fStartPos) or ($F shl 27);616 if RealMap[Loc1] and (fTerrain or fSpecial) = fSwamp or fSpecial2 then617 RealMap[Loc1] := RealMap[Loc1] and not (fTerrain or fSpecial) or618 (fSwamp or fSpecial1);619 if (RealMap[Loc1] and fDeadLands <> 0) and620 (RealMap[Loc1] and fTerrain <> fArctic) then621 RealMap[Loc1] := RealMap[Loc1] and not (fTerrain or fSpecial)622 or fDesert;623 end;624 Result := True;625 end;626 finally627 FreeAndNil(MapFile);628 end;629 end;630 631 566 procedure SaveGame(FileName: string; Auto: Boolean); 632 567 var … … 717 652 BrainUsed: Set of 0 .. 254; { used brains } 718 653 AIBrains: TBrains; 654 Map: TMap; 719 655 begin 720 656 for p1 := 0 to nPl - 1 do begin … … 865 801 else 866 802 begin // predefined map 867 if Mode = moPlaying then 868 LoadMap(MapFileName); // new game -- load map from file 803 if Mode = moPlaying then begin 804 Map := TMap.Create; 805 Map.LoadFromFile(MapFileName); // new game -- load map from file 806 MapSize := Map.MapSize; 807 lx := Map.Size.X; 808 ly := Map.Size.Y; 809 Move(Map.Tiles[0], RealMap, MapSize * 4); 810 FreeAndNil(Map); 811 end; 869 812 GetMem(MapField, MapSize * 4); 870 813 Move(RealMap, MapField^, MapSize * 4); … … 1419 1362 end; 1420 1363 1421 procedure EditMap(const Map: string; Newlx, Newly, NewLandMass: Integer);1364 procedure EditMap(const AMapFileName: string; Newlx, Newly, NewLandMass: Integer); 1422 1365 var 1423 1366 p1, Loc1: Integer; 1424 1367 Game: TNewGameData; 1368 Map: TMap; 1425 1369 begin 1426 1370 Notify(ntStartDone); 1427 1371 Notify(ntInitLocalHuman); 1428 MapFileName := Map;1372 MapFileName := AMapFileName; 1429 1373 lx := Newlx; 1430 1374 ly := Newly; … … 1438 1382 GAlive := 0; 1439 1383 GWatching := 1; 1440 if not LoadMap(MapFileName) then 1441 for Loc1 := 0 to MapSize - 1 do 1442 RealMap[Loc1] := fOcean or ($F shl 27); 1384 for Loc1 := 0 to MapSize - 1 do 1385 RealMap[Loc1] := fOcean or ($F shl 27); 1386 if FileExists(MapFileName) then begin 1387 Map := TMap.Create; 1388 Map.LoadFromFile(MapFileName); 1389 MapSize := Map.MapSize; 1390 lx := Map.Size.X; 1391 ly := Map.Size.Y; 1392 Move(Map.Tiles[0], RealMap, MapSize * 4); 1393 FreeAndNil(Map); 1394 end; 1443 1395 CL := nil; 1444 1396 InitMapEditor; … … 2720 2672 ShowNegoData: TShowNegoData; 2721 2673 Logged, Ok, HasShipChanged, AllHumansDead, OfferFullySupported: Boolean; 2674 Map: TMap; 2722 2675 begin 2723 2676 if Command = sTurn then … … 3295 3248 if Player = 0 then 3296 3249 begin 3297 if Command = sSaveMap then 3298 SaveMap(MapFileName); 3250 if Command = sSaveMap then begin 3251 Map := TMap.Create; 3252 Map.Size := Point(lx, ly); 3253 Map.MaxTurn := MaxTurn; 3254 Move(RealMap, Map.Tiles[0], MapSize * 4); 3255 Map.SaveToFile(MapFileName); 3256 FreeAndNil(Map); 3257 end; 3299 3258 Notify(ntBackOn); 3300 3259 BrainTerm.Client(cBreakGame, -1, nil^); -
trunk/Integrated.lpi
r539 r590 108 108 </Item4> 109 109 </RequiredPackages> 110 <Units Count="4 7">110 <Units Count="48"> 111 111 <Unit0> 112 112 <Filename Value="Integrated.lpr"/> … … 369 369 <IsPartOfProject Value="True"/> 370 370 </Unit46> 371 <Unit47> 372 <Filename Value="Map.pas"/> 373 <IsPartOfProject Value="True"/> 374 </Unit47> 371 375 </Units> 372 376 </ProjectOptions> -
trunk/MiniMap.pas
r545 r590 5 5 6 6 uses 7 Classes, SysUtils, Protocol, ClientTools, 7 Classes, SysUtils, Protocol, ClientTools, Map, 8 8 {$IFDEF DPI}Dpi.Graphics, Dpi.Common{$ELSE}Graphics{$ENDIF}; 9 9 … … 111 111 procedure TMiniMap.LoadFromMapFile(FileName: string; var nMapLandTiles, nMapStartPositions: Integer); 112 112 var 113 x, y, lxFile, lyFile: integer; 114 MapFile: file; 115 s: string[255]; 113 x, y: integer; 116 114 MapRow: array [0 .. lxmax - 1] of Cardinal; 117 115 ImageFileName: string; 116 Map: TMap; 117 Tile: Cardinal; 118 118 begin 119 119 ImageFileName := Copy(FileName, 1, Length(FileName) - Length(CevoMapExt)) + CevoMapPictureExt; … … 125 125 if Bitmap.Height > MaxHeightMapLogo then 126 126 Bitmap.Height := MaxHeightMapLogo; 127 Size.X := Bitmap.Width div 2; 128 Size.Y := Bitmap.Height; 127 Size := Point(Bitmap.Width div 2, Bitmap.Height); 129 128 end else begin 130 129 Mode := mmNone; 131 Size.X := MaxWidthMapLogo; 132 Size.Y := MaxHeightMapLogo; 133 end; 134 135 AssignFile(MapFile, FileName); 130 Size := Point(MaxWidthMapLogo, MaxHeightMapLogo); 131 end; 132 133 Map := TMap.Create; 136 134 try 137 Reset(MapFile, 4); 138 BlockRead(MapFile, s[1], 2); { file id } 139 BlockRead(MapFile, x, 1); { format id } 140 BlockRead(MapFile, x, 1); // MaxTurn 141 BlockRead(MapFile, lxFile, 1); 142 BlockRead(MapFile, lyFile, 1); 135 Map.LoadFromFile(FileName); 143 136 nMapLandTiles := 0; 144 137 nMapStartPositions := 0; 145 for y := 0 to lyFile - 1 do begin 146 BlockRead(MapFile, MapRow, lxFile); 147 for x := 0 to lxFile - 1 do 148 begin 149 if (MapRow[x] and fTerrain) in [fGrass, fPrairie, fTundra, fSwamp, 138 for y := 0 to Map.Size.Y - 1 do begin 139 for X := 0 to Map.Size.X - 1 do begin 140 Tile := Map.Tiles[Y * Map.Size.X + X]; 141 if (Tile and fTerrain) in [fGrass, fPrairie, fTundra, fSwamp, 150 142 fForest, fHills] then 151 143 Inc(nMapLandTiles); 152 if MapRow[x]and (fPrefStartPos or fStartPos) <> 0 then144 if Tile and (fPrefStartPos or fStartPos) <> 0 then 153 145 Inc(nMapStartPositions); 154 end 146 end; 155 147 end; 156 148 if nMapStartPositions > nPl then 157 149 nMapStartPositions := nPl; 158 CloseFile(MapFile); 159 except 160 CloseFile(MapFile); 150 finally 151 FreeAndNil(Map); 161 152 end; 162 153 end;
Note:
See TracChangeset
for help on using the changeset viewer.