start.pas

类似文明的游戏源代码。

  end;
s:='';
if MiniMode=mmPicture then
  begin
  BitBlt(Canvas.Handle,xMini+2,yMini+2,MiniWidth*2,MiniHeight,Mini.Canvas.Handle,0,0,SRCCOPY);
  if page=pgStartRandom then s:=Phrases.Lookup('RANMAP')
  end
else if MiniMode=mmMultiPlayer then s:=Phrases.Lookup('MPMAP')
else if page=pgStartMap then s:=Copy(MapFileName,1,Length(MapFileName)-9)
else if page=pgEditMap then s:=List.Items[List.ItemIndex]
else if page=pgNoLoad then s:=Phrases.Lookup('NOGAMES');
if s<>'' then
  RisedTextOut(Canvas,x0Mini+2-Canvas.TextWidth(s) div 2,y0Mini-8,s);
end;

procedure TStartDlg.FormShow(Sender:TObject);
type
TLine=array[0..99999999] of Byte;
var
i,x,y: integer;
PictureLine: ^TLine;
begin
GenerateNames:=true;
InputDlg.Tex:=StartTex;
MessgDlg.Tex:=StartTex;
List.Font.Color:=StartTex.clMark;
ETurn.Font.Color:=StartTex.clMark;

Fill(EmptyPicture.Canvas,0,0,64,64,0,0,StartTex);
for y:=0 to 63 do
  begin // darken texture for empty slot
  PictureLine:=EmptyPicture.ScanLine[y];
  for x:=0 to 64*3-1 do
    begin
    i:=integer(PictureLine[x])-28;
    if i<0 then i:=0;
    PictureLine[x]:=i;
    end
  end;

Difficulty[0]:=Diff0;

if not Welcomed then with MessgDlg do
  begin
  MessgText:=Phrases.Lookup('WELCOME');
  Kind:=mkWelcome;
  ShowModal;
  Welcomed:=true;
  end;
if ShowTab=2 then PreviewMap(StartLandMass); // avoid delay on first tab change 
ChangeTab(ShowTab);
end;

procedure TStartDlg.UnlistBackupFile(FileName: string);
var
i: integer;
begin
if FileName[1]<>'~' then FileName:='~'+FileName;
i:=FormerGames.Count-1;
while (i>=0) and (AnsiCompareFileName(FormerGames[i],FileName)<>0) do dec(i);
if i>=0 then
  begin
  FormerGames.Delete(i);
  if ListIndex[2]=i then ListIndex[2]:=0
  end
end;

procedure TStartDlg.StartBtnClick(Sender:TObject);
var
i,GameCount,MapCount,LoadTurn: integer;
FileName: string;
Reg: TRegistry;
begin
case Page of
  pgLoad:
    begin //load
    val(ETurn.Text,LoadTurn,i);
    if (i=0) and (LoadTurn>=-4000) then
      begin
      LoadTurn:=YearToTurn(LoadTurn);
      if LoadTurn>LastTurn then LoadTurn:=LastTurn;
      end
    else LoadTurn:=LastTurn;
    FileName:=List.Items[List.ItemIndex];
    if LoadGame(HomeDir+'Saved\', FileName+'.cevo', LoadTurn) then
      UnlistBackupFile(FileName)
    else SimpleMessage(Phrases.Lookup('LOADERR'),'INVALID');
    SlotAvailable:=-1;
    end;

  pgStartRandom,pgStartMap: if bixView[0]>=0 then
    begin
    Reg:=TRegistry.Create;
    Reg.OpenKey('SOFTWARE\cevo\RegVer5\Start',true);
    try
      GameCount:=Reg.ReadInteger('GameCount');
    except
      GameCount:=0;
      end;

    if bixView[0]=bixNoTerm then FileName:='Round'
    else
      begin
      inc(GameCount);
      FileName:=Format(Phrases.Lookup('GAME'),[GameCount]);
      end;

    // save settings and AI assignment
    if page=pgStartRandom then for i:=0 to nPl-1 do
      begin
      if bixView[i]=-1 then Reg.WriteString('Control'+IntToStr(i),'')
      else Reg.WriteString('Control'+IntToStr(i),Brain[bixView[i]].FileName);
      Reg.WriteInteger('Diff'+IntToStr(i),Difficulty[i]);
      end;
    Reg.WriteInteger('GameCount',GameCount);
    Reg.WriteInteger('WorldSize',WorldSize);
    Reg.WriteInteger('LandMass',StartLandMass);
    Reg.WriteInteger('MaxTurn',MaxTurn);
    Reg.closekey;
    Reg.Free;

    StartNewGame(HomeDir+'Saved\', FileName+'.cevo', MapFileName,
      lxpre[WorldSize], lypre[WorldSize], StartLandMass, MaxTurn);
    UnlistBackupFile(FileName);
    end;

  pgEditMap: EditMap(MapFileName, lxmax, lymax, DefaultLandMass);

  pgEditRandom: // new map
    begin
    Reg:=TRegistry.Create;
    Reg.OpenKey('SOFTWARE\cevo\RegVer5\Start',true);
    try
      MapCount:=Reg.ReadInteger('MapCount');
    except
      MapCount:=0;
      end;
    inc(MapCount);
    Reg.WriteInteger('MapCount',MapCount);
    Reg.closekey;
    Reg.Free;
    MapFileName:=Format(Phrases.Lookup('MAP'),[MapCount])+'.cevo map';
    EditMap(MapFileName, lxpre[WorldSize], lypre[WorldSize], StartLandMass);
    end
  end
end;

procedure TStartDlg.PaintInfo;

  procedure PaintRandomMini(Brightness: integer);
  type
  TLine=array[0..lxmax*2,0..2] of Byte;
  var
  i,x,y,xm,cm:integer;
  MiniLine:^TLine;
  Map: ^TTileList;
  begin
  Map:=PreviewMap(StartLandMass);
  MiniWidth:=lxpre[WorldSize]; MiniHeight:=lypre[WorldSize];

  Mini.PixelFormat:=pf24bit;
  Mini.Width:=MiniWidth*2;Mini.Height:=MiniHeight;
  for y:=0 to MiniHeight-1 do
    begin
    MiniLine:=Mini.ScanLine[y];
    for x:=0 to MiniWidth-1 do for i:=0 to 1 do
      begin
      xm:=(x*2+i+y and 1) mod (MiniWidth*2);
      cm:=MiniColors[Map[x*lxmax div MiniWidth
        +lxmax*((y*(lymax-1)+MiniHeight div 2) div (MiniHeight-1))] and fTerrain,i];
      MiniLine[xm,0]:=cm shr 16 *Brightness div 3;
      MiniLine[xm,1]:=cm shr 8 and $FF *Brightness div 3;
      MiniLine[xm,2]:=cm and $FF *Brightness div 3;
      end;
    end;
  end;

var
SaveMap: array[0..lxmax*lymax-1] of Byte;

  procedure PaintFileMini;
  type
  TLine=array[0..99999999,0..2] of Byte;
  var
  i,x,y,xm,cm,Tile:integer;
  MiniLine,PrevMiniLine:^TLine;
  begin
  Mini.PixelFormat:=pf24bit;
  Mini.Width:=MiniWidth*2;Mini.Height:=MiniHeight;
  if MiniMode=mmPicture then
    begin
    MiniLine:=nil;
    for y:=0 to MiniHeight-1 do
      begin
      PrevMiniLine:=MiniLine;
      MiniLine:=Mini.ScanLine[y];
      for x:=0 to MiniWidth-1 do for i:=0 to 1 do
        begin
        xm:=(x*2+i+y and 1) mod (MiniWidth*2);
        Tile:=SaveMap[x+MiniWidth*y];
        if Tile and fTerrain=fUNKNOWN then cm:=$000000
        else if Tile and smCity<>0 then
          begin
          if Tile and smOwned<>0 then cm:=$FFFFFF
          else cm:=$00E0FF;
          if PrevMiniLine<>nil then
            begin // 2x2 city dot covers two scanlines
            PrevMiniLine[xm,0]:=cm shr 16;
            PrevMiniLine[xm,1]:=cm shr 8 and $FF;
            PrevMiniLine[xm,2]:=cm and $FF;
            end
          end
        else if (i=0) and (Tile and smUnit<>0) then
          if Tile and smOwned<>0 then cm:=$FFFFFF
          else cm:=$00E0FF
        else cm:=MiniColors[Tile and fTerrain,i];
        MiniLine[xm,0]:=cm shr 16;
        MiniLine[xm,1]:=cm shr 8 and $FF;
        MiniLine[xm,2]:=cm and $FF;
        end;
      end
    end;
  end;

var
x,y,dummy, FileLandMass, lxFile, lyFile: integer;
LogFile, MapFile: file;
s: string[255];
MapRow: array[0..lxmax-1] of Cardinal;
r: TRect;

begin
case Page of
  pgStartRandom:
    begin
    MiniMode:=mmPicture;
    PaintRandomMini(3);
    end;

  pgNoLoad:
    begin
    MiniWidth:=lxpre[DefaultWorldSize]; MiniHeight:=lypre[DefaultWorldSize];
    MiniMode:=mmNone;
    end;

  pgLoad:
    begin
    AssignFile(LogFile,HomeDir+'Saved\'+List.Items[List.ItemIndex]+'.cevo');
    try
      Reset(LogFile,4);
      BlockRead(LogFile,s[1],2); {file id}
      BlockRead(LogFile,dummy,1); {format id}
      BlockRead(LogFile,MiniWidth,1);
      BlockRead(LogFile,MiniHeight,1);
      BlockRead(LogFile,FileLandMass,1);
      if FileLandMass=0 then
        for y:=0 to MiniHeight-1 do BlockRead(LogFile,MapRow,MiniWidth);
      BlockRead(LogFile,dummy,1);
      BlockRead(LogFile,dummy,1);
      BlockRead(LogFile,LastTurn,1);
      BlockRead(LogFile,SaveMap,1);
      if SaveMap[0]=$80 then MiniMode:=mmMultiPlayer
      else MiniMode:=mmPicture;
      if MiniMode=mmPicture then BlockRead(LogFile,SaveMap[4],(MiniWidth*MiniHeight-1) div 4);
      CloseFile(LogFile);
    except
      CloseFile(LogFile);
      LastTurn:=0;
      MiniWidth:=lxpre[DefaultWorldSize]; MiniHeight:=lypre[DefaultWorldSize];
      MiniMode:=mmNone;
      end;
    //BookDate:=DateToStr(FileDateToDateTime(FileAge(FileName)));
    PaintFileMini;
    if not TurnValid then ETurn.Text:=IntToStr(turntoyear(LastTurn));
    TurnValid:=true;
    end;

  pgEditRandom:
    begin
    MapFileName:='';
    MiniMode:=mmPicture;
    PaintRandomMini(4);
    end;

  pgStartMap,pgEditMap:
    begin
    MiniMode:=mmPicture;
    if Page=pgEditMap then MapFileName:=List.Items[List.ItemIndex]+'.cevo map';
    try
      Mini.LoadFromFile(HomeDir+'Maps\'
        +Copy(MapFileName,1,Length(MapFileName)-9)+'.bmp');
      if Mini.Width div 2>MaxWidthMapLogo then Mini.Width:=MaxWidthMapLogo*2;
      if Mini.Height>MaxHeightMapLogo then Mini.Height:=MaxHeightMapLogo;
      MiniWidth:=Mini.Width div 2;
      MiniHeight:=Mini.Height;
    except
      MiniMode:=mmNone;
      MiniWidth:=MaxWidthMapLogo; MiniHeight:=MaxHeightMapLogo;
      end;

    AssignFile(MapFile,HomeDir+'Maps\'+MapFileName);
    try
      Reset(MapFile,4);
      BlockRead(MapFile,s[1],2); {file id}
      BlockRead(MapFile,x,1); {format id}
      BlockRead(MapFile,x,1); //MaxTurn
      BlockRead(MapFile,lxFile,1);
      BlockRead(MapFile,lyFile,1);
      nMapStartPositions:=0;
      for y:=0 to lyFile-1 do
        begin
        BlockRead(MapFile,MapRow,lxFile);
        for x:=0 to lxFile-1 do
          if MapRow[x] and (fPrefStartPos or fStartPos)<>0 then
            inc(nMapStartPositions);
        end;
      CloseFile(MapFile);
    except
      CloseFile(MapFile);
      end;
    end
  end;
r:=Rect(x0Mini-lxmax,y0Mini-lymax div 2,
  x0Mini-lxmax+2*lxmax+4,y0Mini-lymax div 2+lymax+4);
InvalidateRect(Handle,@r,false);
end;

procedure TStartDlg.BrainClick(Sender: TObject);
var
i: integer;
r: TRect;
begin
Play('BUTTON_UP');
Brain[bixView[bixPopup]].Flags:=Brain[bixView[bixPopup]].Flags and not fUsed;
bixView[bixPopup]:=TMenuItem(Sender).Tag;
DiffUpBtn[bixPopup].Visible:= bixView[bixPopup]>=bixTerm;
DiffDownBtn[bixPopup].Visible:= bixView[bixPopup]>=bixTerm;
Brain[bixView[bixPopup]].Flags:=Brain[bixView[bixPopup]].Flags or fUsed;
if bixView[bixPopup]<bixTerm then Difficulty[bixPopup]:=0 {supervisor}
else Difficulty[bixPopup]:=2;
if (bixPopup=0) and (MapFileName<>'') then ChangePage(Page);
if bixView[bixPopup]=bixNoTerm then
  begin // turn all local players off
  for i:=1 to nPlOffered-1 do if bixView[i]=bixTerm then
    begin
    bixView[i]:=-1;
    DiffUpBtn[i].Visible:=false;
    DiffUpBtn[i].Tag:=0;
    DiffDownBtn[i].Visible:=false;
    DiffDownBtn[i].Tag:=0;
    r:=Rect(xBrain[i]-19,yBrain[i],xBrain[i]+64,DiffUpBtn[i].Top+25);
    InvalidateRect(Handle,@r,false);
    end;
  Brain[bixTerm].Flags:=Brain[bixTerm].Flags and not fUsed;
  end;
r:=Rect(xBrain[bixPopup]-19,yBrain[bixPopup],xBrain[bixPopup]+64,
  DiffUpBtn[bixPopup].Top+25);
InvalidateRect(Handle,@r,false);
end;

procedure TStartDlg.InitPopup(PopupIndex: integer);
var
i, FixedLines: integer;
m: TMenuItem;

  procedure OfferBrain(Index: integer);
  var
  j: integer;
  begin
  m:=TMenuItem.Create(PopupMenu1);
  if Index<0 then m.Caption:=Phrases.Lookup('NOMOD')
  else m.Caption:=Brain[Index].Name;
  m.Tag:=Index;
  m.OnClick:=BrainClick;
  j:=FixedLines;
  while (j<PopupMenu1.Items.Count) and (StrIComp(pchar(m.Caption),
    pchar(PopupMenu1.Items[j].Caption))>0) do inc(j);
  m.RadioItem:=true;
  m.Checked:= bixView[bixPopup]=Index;
  PopupMenu1.Items.Insert(j,m);
  end;

begin
bixPopup:=PopupIndex;
while PopupMenu1.Items.Count>0 do PopupMenu1.Items.Delete(0);
FixedLines:=0;
if bixPopup>0 then begin OfferBrain(-1); inc(FixedLines); end;
for i:=bixTerm downto 0 do // offer game interfaces
  if (bixPopup=0) or (i=bixTerm) and (bixView[0]<>bixNoTerm) then
    begin OfferBrain(i); inc(FixedLines); end;
if bixPopup>0 then
  begin
  m:=TMenuItem.Create(PopupMenu1);
  m.Caption:='-';
  PopupMenu1.Items.Add(m);
  inc(FixedLines);
  end;
for i:=bixTerm+1 to nBrain-1 do // offer available AIs
  if (bixPopup>0) and
    ((Brain[i].Flags and fMultiple<>0) or (Brain[i].Flags and fUsed=0)
    or (i=bixView[bixPopup])) then
    OfferBrain(i);
end;

procedure TStartDlg.UpdateFormerGames;
var
i: integer;