sandmain.pas

模拟2维沙堆效果

unit SandMain;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, StdCtrls, Dialogs, SandSim, Sandpile;

type
  TMainForm = class(TForm)
    StartBtn: TButton;
    PauseBtn: TButton;
    TraceBtn: TButton;
    ColorBtn: TButton;
    LoadBtn: TButton;
    SaveBtn: TButton;
    ExitBtn: TButton;
    AboutBtn: TButton;
    PileCheckBox: TCheckBox;
    GroupBox3: TGroupBox;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    SizeLabel: TLabel;
    AddLabel: TLabel;
    RoundsLabel: TLabel;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    AddedLabel: TLabel;
    LostLabel: TLabel;
    ToppledLabel: TLabel;
    GroupBox2: TGroupBox;
    Label4: TLabel;
    Label5: TLabel;
    DeltaLostLabel: TLabel;
    DeltaToppledLabel: TLabel;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure StartBtnClick(Sender: TObject);
    procedure PauseBtnClick(Sender: TObject);
    procedure TraceBtnClick(Sender: TObject);
    procedure ColorBtnClick(Sender: TObject);
    procedure ExitBtnClick(Sender: TObject);
    procedure LoadBtnClick(Sender: TObject);
    procedure SaveBtnClick(Sender: TObject);
    procedure PileCheckBoxClick(Sender: TObject);
    procedure AboutBtnClick(Sender: TObject);
  private
    FExecuting: Boolean;
    FieldSize: Byte;         // Size of grid fields in pixels
    procedure SetExecuting(Exec: Boolean);
    procedure ThreadDone(Sender: TObject);
    procedure StartSimulation;
    procedure StopSimulation;
    procedure UpdateSettings;
  public
    Simulation: TSimulation;
    PileSize: Byte;          // Size of sandpile as specified by user
    AddRect: Byte;           // Add grains inside this square
    MaxRounds: Longint;      // # rounds simulation will run
    Colors: array[0..6] of Longint;  // Palette
    ShowGrid: Boolean;
    Pile: TPile;             // The sandpile
    property Executing: Boolean read FExecuting write SetExecuting;
    procedure Statistics;
  end;

var
  MainForm: TMainForm;

implementation

{$R *.DFM}

uses
  IniFiles, SandColr, SandShow, SandParm, SandInfo;

const
  IniFileName: String = 'Sand.ini';

type
  TPileInfoRec = record
    PileSize: Byte;
    AddRect: Byte;
    MaxRounds: Longint;
    Added, Toppled, Lost: Longint;
    dToppled, dLost: Longint;
  end;

{--------------------- TMainForm ----------------------}

procedure TMainForm.FormCreate(Sender: TObject);
var
  IniFile: TIniFile;
begin
  BorderIcons := BorderIcons - [biMaximize];

  IniFile := TIniFile.Create(IniFileName);
  with IniFile do
  begin
    // Get parameters for simulation
    PileSize  := ReadInteger('Parameters', 'PileSize', 50);
    Addrect   := ReadInteger('Parameters', 'AddRect', 10);
    MaxRounds := ReadInteger('Parameters', 'MaxRounds', 10000);
    // Initialize colors
    Colors[0] := clWhite;
    Colors[1] := ReadInteger('Colors', 'Height1', clWhite);
    Colors[2] := ReadInteger('Colors', 'Height2', clSilver);
    Colors[3] := ReadInteger('Colors', 'Height3', clBlue);
    Colors[4] := ReadInteger('Colors', 'Height4', clNavy);
    Colors[5] := ReadInteger('Colors', 'Height5', clYellow);
    Colors[6] := ReadInteger('Colors', 'Traced', clBlack);
    // Get grid settings
    ShowGrid := ReadBool('Grid', 'ShowGrid', False);
  end;
  IniFile.Free;

  Executing := False;
  Pile := TPile.Create(PileSize);
end;


procedure TMainForm.FormDestroy(Sender: TObject);
var
  IniFile: TIniFile;
begin
  if Executing then
    StopSimulation;

  IniFile := TIniFile.Create(IniFileName);
  with IniFile do
  begin
    // Write parameters
    WriteInteger('Parameters', 'PileSize', PileSize);
    WriteInteger('Parameters', 'AddRect', AddRect);
    WriteInteger('Parameters', 'MaxRounds', MaxRounds);
    // Write colors
    WriteInteger('Colors', 'Height1', Colors[1]);
    WriteInteger('Colors', 'Height2', Colors[2]);
    WriteInteger('Colors', 'Height3', Colors[3]);
    WriteInteger('Colors', 'Height4', Colors[4]);
    WriteInteger('Colors', 'Height5', Colors[5]);
    WriteInteger('Colors', 'Traced', Colors[6]);
    // Write grid settings
    WriteBool('Grid', 'ShowGrid', ShowGrid);
  end;
  IniFile.Free;

  Pile.Free;
end;


procedure TMainForm.UpdateSettings;
begin
  SizeLabel.Caption   := IntToStr(PileSize);
  AddLabel.Caption    := IntToStr(AddRect);
  RoundsLabel.Caption := IntToStr(MaxRounds);
end;


procedure TMainForm.StartBtnClick(Sender: TObject);
begin
  if not Executing then
    StartSimulation
  else
    StopSimulation;
end;


procedure TMainForm.PauseBtnClick(Sender: TObject);
begin
  with Simulation do
  begin
    if Tracing then
    begin
      Tracing := False;
      PileForm.UndrawTrace;
    end;
    if Suspended then
      PauseBtn.Caption := '&Pause'
    else
      PauseBtn.Caption := 'Un&pause';

    Suspended := not Suspended;
  end;
end;


procedure TMainForm.TraceBtnClick(Sender: TObject);
begin
  PauseBtn.Caption := '&No trace';
  Simulation.Trace;
end;


procedure TMainForm.ColorBtnClick(Sender: TObject);
begin
  if Executing then
    Simulation.Suspend;

  if ColorForm.ShowModal = mrOk then
  begin
    with ColorForm do
    begin
      Colors[1] := Panel1.Color;
      Colors[2] := Panel2.Color;
      Colors[3] := Panel3.Color;
      Colors[4] := Panel4.Color;
      Colors[5] := Panel5.Color;
      Colors[6] := Panel6.Color;
      ShowGrid := GridCheckBox.Checked;
    end;
    PileForm.SetGridSize;
  end;

  if Executing then
    Simulation.Resume;
end;


procedure TMainForm.ExitBtnClick(Sender: TObject);
begin
  Close;
end;


procedure TMainForm.AboutBtnClick(Sender: TObject);
begin
  AboutBox.ShowModal;
end;


procedure TMainForm.LoadBtnClick(Sender: TObject);
var
  PileInfo: TPileInfoRec;
  F: Integer;      // File handle
  I, J: Byte;
begin
  if Executing then
    Simulation.Suspend;

  if OpenDialog1.Execute then
  begin
    if Executing then
      StopSimulation;

    F := FileOpen(OpenDialog1.FileName, fmOpenRead);
    if F <> -1 then
    begin
      FileRead(F, PileInfo, SizeOf(PileInfo));
      PileSize  := PileInfo.PileSize;
      AddRect   := PileInfo.AddRect;
      MaxRounds := PileInfo.MaxRounds;
      UpdateSettings;
      PileForm.SetGridSize;
//      PileForm.ClearCells;
      Simulation := TSimulation.Create;
      Simulation.OnTerminate := ThreadDone;
      Simulation.Suspend;

      Pile := TPile.Create(PileSize);
      Pile.GrainsAdded   := PileInfo.Added;
      Pile.GrainsLost    := PileInfo.Lost;
      Pile.GrainsToppled := PileInfo.Toppled;
      Pile.DeltaLost     := PileInfo.dLost;
      Pile.DeltaToppled  := PileInfo.dToppled;
      Statistics;
      // Fill the pile
      for I := 0 to PileSize do
        for J := 0 to PileSize do
          FileRead(F, Pile.Grid[I,J], 1);
      FileClose(F);

      Executing := True;
      PileForm.DrawGrid.Refresh;
    end;
  end;

  PauseBtn.Caption := 'Un&pause';
end;


procedure TMainForm.SaveBtnClick(Sender: TObject);
var
  PileInfo: TPileInfoRec;
  F: Integer;      // File handle
  I, J: Byte;
begin
  if Executing then
    Simulation.Suspend;

  if SaveDialog1.Execute then
  begin
    F := FileCreate(SaveDialog1.FileName);
    // Save pile info
    PileInfo.PileSize  := PileSize;
    PileInfo.AddRect   := AddRect;
    PileInfo.MaxRounds := MaxRounds;
    PileInfo.Added     := Pile.GrainsAdded;
    PileInfo.Lost      := Pile.GrainsLost;
    PileInfo.Toppled   := Pile.GrainsToppled;
    PileInfo.dLost     := Pile.DeltaLost;
    PileInfo.dToppled  := Pile.DeltaToppled;
    FileWrite(F, PileInfo, SizeOf(PileInfo));
    // Save the pile itself
    for I := 0 to PileSize do
      for J := 0 to PileSize do
        FileWrite(F, Pile.Grid[I,J], 1);
    FileClose(F);
  end;

  if Executing then
    Simulation.Resume;
end;


procedure TMainForm.PileCheckBoxClick(Sender: TObject);
begin
  if PileCheckBox.Checked then
    PileForm.Show
  else
    PileForm.Hide;
end;


procedure TMainForm.ThreadDone(Sender: TObject);
begin
  Executing := False;
end;


procedure TMainForm.SetExecuting(Exec: Boolean);
begin
  FExecuting := Exec;
  if FExecuting then
  begin
    StartBtn.Caption := '&Stop';
    PauseBtn.Caption := '&Pause';
    PauseBtn.Enabled := True;
    TraceBtn.Enabled := True;
  end
  else
  begin
    StartBtn.Caption := '&Start...';
    PauseBtn.Enabled := False;
    TraceBtn.Enabled := False;
  end;
end;


procedure TMainForm.Statistics;
begin
  AddedLabel.Caption        := IntToStr(Pile.GrainsAdded);
  LostLabel.Caption         := IntToStr(Pile.GrainsLost);
  ToppledLabel.Caption      := IntToStr(Pile.GrainsToppled);
  DeltaLostLabel.Caption    := IntToStr(Pile.DeltaLost);
  DeltaToppledLabel.Caption := IntToStr(Pile.DeltaToppled);
end;


procedure TMainForm.StartSimulation;
begin
  if ParameterForm.ShowModal = mrOk then
  begin
    Screen.Cursor := crHourglass;
    with ParameterForm do
    begin
      PileSize  := StrToInt(Edit1.Text);
      AddRect   := StrToInt(Edit2.Text);
      MaxRounds := StrToInt(Edit3.Text);
    end;
    UpdateSettings;
    PileForm.SetGridSize;
//    PileForm.ClearCells;
    Simulation := TSimulation.Create;
    Simulation.OnTerminate := ThreadDone;
    Pile.Free;     // Destroy old pile
    Pile := TPile.Create(PileSize);
    Executing := True;
    Screen.Cursor := crDefault;
  end;
end;


procedure TMainForm.StopSimulation;
begin
  Simulation.Suspend;
  Simulation.Free;
  Executing := False;
end;

end.