Changeset 591
- Timestamp:
- Jul 24, 2024, 11:02:31 PM (6 weeks ago)
- Location:
- trunk
- Files:
-
- 3 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/Database.pas
r590 r591 598 598 } 599 599 var 600 primitive: Integer;600 Primitive: Integer; 601 601 StartLoc, StartLoc2: array [0 .. nPl - 1] of Integer; { starting coordinates } 602 602 Elevation: array [0 .. lxmax * lymax - 1] of Byte; { map elevation } … … 607 607 I, J: Integer; 608 608 begin 609 primitive := 1;609 Primitive := 1; 610 610 I := 2; 611 611 while I * I <= MapSize + 1 do // test whether prime 612 612 begin 613 613 if (MapSize + 1) mod I = 0 then 614 primitive := 0;614 Primitive := 0; 615 615 Inc(I); 616 616 end; 617 617 618 if primitive > 0 then618 if Primitive > 0 then 619 619 repeat 620 Inc( primitive);620 Inc(Primitive); 621 621 I := 1; 622 622 J := 0; 623 623 repeat 624 624 Inc(J); 625 I := I * primitive mod (MapSize + 1);625 I := I * Primitive mod (MapSize + 1); 626 626 until (I = 1) or (J = MapSize + 1); 627 627 until J = MapSize; … … 630 630 function MapGeneratorAvailable: Boolean; 631 631 begin 632 Result := ( primitive > 0) and (lx >= 20) and (ly >= 40);632 Result := (Primitive > 0) and (lx >= 20) and (ly >= 40); 633 633 end; 634 634 … … 1155 1155 (Loc0 < MapSize - lx) then 1156 1156 RunRiver(Loc0); 1157 Loc0 := (Loc0 + 1) * primitive mod (MapSize + 1) - 1;1157 Loc0 := (Loc0 + 1) * Primitive mod (MapSize + 1) - 1; 1158 1158 end; 1159 1159 end; … … 1413 1413 end; 1414 1414 end; 1415 Loc := (Loc + 1) * primitive mod (MapSize + 1) - 1;1415 Loc := (Loc + 1) * Primitive mod (MapSize + 1) - 1; 1416 1416 end; 1417 1417 -
trunk/GameServer.pas
r590 r591 291 291 LandMass := ALandMass; 292 292 DelphiRandSeed := PreviewRND; 293 if not PreviewElevation then 294 begin 293 if not PreviewElevation then begin 295 294 CreateElevation; 296 295 PreviewElevation := True; … … 1382 1381 GAlive := 0; 1383 1382 GWatching := 1; 1384 for Loc1 := 0 to MapSize - 1 do1385 RealMap[Loc1] := fOcean or ($F shl 27);1386 1383 if FileExists(MapFileName) then begin 1387 1384 Map := TMap.Create; … … 1392 1389 Move(Map.Tiles[0], RealMap, MapSize * 4); 1393 1390 FreeAndNil(Map); 1391 end else begin 1392 for Loc1 := 0 to MapSize - 1 do 1393 RealMap[Loc1] := fOcean or ($F shl 27); 1394 1394 end; 1395 1395 CL := nil; -
trunk/MiniMap.pas
r590 r591 26 26 procedure LoadFromLogFile(FileName: string; var LastTurn: Integer; DefaultSize: TPoint); 27 27 procedure LoadFromMapFile(FileName: string; var nMapLandTiles, nMapStartPositions: Integer); 28 procedure PaintMap(Map: TMap); 28 29 procedure PaintRandom(Brightness, StartLandMass: Integer; WorldSize: TPoint); 29 30 procedure PaintFile(SaveMap: TMapArray); … … 111 112 procedure TMiniMap.LoadFromMapFile(FileName: string; var nMapLandTiles, nMapStartPositions: Integer); 112 113 var 113 x, y: integer; 114 MapRow: array [0 .. lxmax - 1] of Cardinal; 114 X, Y: Integer; 115 115 ImageFileName: string; 116 116 Map: TMap; 117 117 Tile: Cardinal; 118 PaintMapEnabled: Boolean; 118 119 begin 119 120 ImageFileName := Copy(FileName, 1, Length(FileName) - Length(CevoMapExt)) + CevoMapPictureExt; … … 126 127 Bitmap.Height := MaxHeightMapLogo; 127 128 Size := Point(Bitmap.Width div 2, Bitmap.Height); 129 PaintMapEnabled := False; 128 130 end else begin 129 Mode := mm None;131 Mode := mmPicture; 130 132 Size := Point(MaxWidthMapLogo, MaxHeightMapLogo); 133 PaintMapEnabled := True; 131 134 end; 132 135 … … 136 139 nMapLandTiles := 0; 137 140 nMapStartPositions := 0; 138 for y:= 0 to Map.Size.Y - 1 do begin141 for Y := 0 to Map.Size.Y - 1 do begin 139 142 for X := 0 to Map.Size.X - 1 do begin 140 143 Tile := Map.Tiles[Y * Map.Size.X + X]; … … 148 151 if nMapStartPositions > nPl then 149 152 nMapStartPositions := nPl; 153 154 if PaintMapEnabled then begin 155 Size := Map.Size; 156 PaintMap(Map); 157 end; 150 158 finally 151 159 FreeAndNil(Map); 160 end; 161 end; 162 163 procedure TMiniMap.PaintMap(Map: TMap); 164 var 165 i, x, y, xm, cm, Tile, OwnColor, EnemyColor: integer; 166 MiniPixel: TPixelPointer; 167 PrevMiniPixel: TPixelPointer; 168 xx, yy: Integer; 169 begin 170 OwnColor := HGrSystem.Data.Canvas.Pixels[95, 67]; 171 EnemyColor := HGrSystem.Data.Canvas.Pixels[96, 67]; 172 Bitmap.PixelFormat := TPixelFormat.pf24bit; 173 Bitmap.SetSize(Size.X * 2, Size.Y); 174 if Mode = mmPicture then begin 175 Bitmap.BeginUpdate; 176 MiniPixel := TPixelPointer.Create(Bitmap); 177 PrevMiniPixel := TPixelPointer.Create(Bitmap); 178 xx := ScaleToNative(Size.X); 179 yy := ScaleToNative(Size.Y); 180 for y := 0 to yy - 1 do begin 181 for x := 0 to xx - 1 do begin 182 for i := 0 to 1 do begin 183 xm := (x * 2 + i + y and 1) mod (xx * 2); 184 MiniPixel.SetX(xm); 185 Tile := Map.Tiles[ScaleFromNative(x) + Size.X * ScaleFromNative(y)]; 186 if Tile and fTerrain = fUNKNOWN then 187 cm := $000000 188 else if Tile and smCity <> 0 then begin 189 if Tile and smOwned <> 0 then cm := OwnColor 190 else cm := EnemyColor; 191 if y > 0 then begin 192 // 2x2 city dot covers two lines 193 PrevMiniPixel.SetX(xm); 194 if (PByte(PrevMiniPixel.Pixel) >= Bitmap.RawImage.Data) and 195 (PByte(PrevMiniPixel.Pixel) < (Bitmap.RawImage.Data + yy * PrevMiniPixel.BytesPerLine)) then begin 196 PrevMiniPixel.PixelB := cm shr 16; 197 PrevMiniPixel.PixelG:= cm shr 8 and $FF; 198 PrevMiniPixel.PixelR := cm and $FF; 199 end; 200 end; 201 end 202 else if (i = 0) and (Tile and smUnit <> 0) then begin 203 if Tile and smOwned <> 0 then cm := OwnColor 204 else cm := EnemyColor; 205 end else 206 cm := Colors[Tile and fTerrain, i]; 207 if (PByte(MiniPixel.Pixel) >= Bitmap.RawImage.Data) and 208 (PByte(MiniPixel.Pixel) < (Bitmap.RawImage.Data + yy * MiniPixel.BytesPerLine)) then begin 209 MiniPixel.PixelB := (cm shr 16) and $ff; 210 MiniPixel.PixelG := (cm shr 8) and $ff; 211 MiniPixel.PixelR := (cm shr 0) and $ff; 212 end; 213 end; 214 end; 215 MiniPixel.NextLine; 216 if y > 0 then PrevMiniPixel.NextLine; 217 end; 218 Bitmap.EndUpdate; 152 219 end; 153 220 end;
Note:
See TracChangeset
for help on using the changeset viewer.