sandsim.pas

模拟2维沙堆效果

unit SandSim;
// The simulation logic (based on the TThread class)

interface

uses
  Classes, Sandpile, SandQue, SandLog;

type
  TSimulation = class(TThread)
  public
    Rounds: Longint;         // # rounds so far
    Tracing: Boolean;        // Are we in trace mode?
    constructor Create;
    destructor Destroy; override;
    procedure Trace;
  private
    CurrentCell: TField;     // Used when updating a cell
    Q: TQueue;               // Queue of points that have toppled
    procedure DoDrawCell;
    procedure DoShowStatistics;
  protected
    procedure Execute; override;
    procedure DrawCell(X, Y: Integer);
    procedure ShowStatistics;
  end;

  TMyLog = class(TLog)
    procedure Log; override;
  private
    Time1, Time2: TDateTime;
  end;

implementation

uses
  SysUtils, Forms, SandMain, SandShow;

var
  Log1: TMyLog;

{---------------------- TMyLog ------------------------}

procedure TMyLog.Log;
const
  Freq = 100;
begin
  with MainForm do
    if Pile.GrainsAdded mod Freq = 0 then   // For every Freq rounds
      LogList.Add(IntToStr(Pile.GrainsAdded) + ' ' + IntToStr(Pile.GrainsToppled));
end;

{-------------------- TSimulation ---------------------}

constructor TSimulation.Create;
begin
  inherited Create(False);
  Suspend;
  FreeOnTerminate := True;
  Q := TQueue.Create;
  Log1 := TMyLog.Create('sandlog.txt');
  Log1.Time1 := Time;
  Log1.LogTime(Log1.Time1);
  Randomize;
  Rounds := 0;
  Tracing := False;
  Resume;
end;


destructor TSimulation.Destroy;
begin
  Q.Free;
  Log1.Time2 := Time;
  Log1.LogTime(Log1.Time2);
  Log1.LogTime(Log1.Time2-Log1.Time1);
  Log1.Save;
  Log1.Free;
  inherited Destroy;
end;


procedure TSimulation.DrawCell(X, Y: Integer);
// This method is a wrapper for the method DoDrawCell.
// It ensures synchronization with the PileForm TDrawGrid VCL component.
begin
  if PileForm.Visible then
  begin
    CurrentCell.X := X;
    CurrentCell.Y := Y;
    Synchronize(DoDrawCell);
  end;
end;


procedure TSimulation.DoDrawCell;
// Updates a cell in the grid
begin
  with CurrentCell do
    PileForm.QuickDrawCell(X, Y);
end;


procedure TSimulation.ShowStatistics;
// This method is a wrapper for the method DoShowStatistics.
// It ensures synchronization with the MainForm TLabel VCL components.
begin
  Synchronize(DoShowStatistics);
end;


procedure TSimulation.DoShowStatistics;
// Shows statistics on the sandpile
begin
  MainForm.Statistics;
end;


procedure TSimulation.Execute;
var
  X, Y: Integer;
  Field: PField;
begin
  // Run the simulation for MaxRounds rounds or until user stops/exits
  while Rounds < MainForm.MaxRounds do
  begin
    Inc(Rounds);
    // Determine the point to add a grain
    with MainForm do
    begin
      X := (Pile.Size-AddRect) div 2 + Random(AddRect);
      Y := (Pile.Size-AddRect) div 2 + Random(AddRect);
      Pile.AddGrain(X, Y);  // Add 1 grain in point (X,Y)
    end;
    New(Field);
    Field^.X := X;
    Field^.Y := Y;
    Q.Enqueue(Field);      // Add the point to the queue

    while Q.Size > 0 do
    begin
      Q.Dequeue(Pointer(Field));
      if MainForm.Pile.IsCritical(Field^.X, Field^.Y) then
        MainForm.Pile.Topple(Field^.X, Field^.Y, Q);  // Topple point 
      DrawCell(Field^.X, Field^.Y);
      Dispose(Field);
    end;           // The queue is empty - any avalanche is finished

    ShowStatistics;
{    Log1.Log; }

    if Terminated then
      Exit;
    if Tracing then
      Suspend;
  end;
end;


procedure TSimulation.Trace;
begin
  PileForm.UndrawTrace;
  Tracing := True;
  Resume;
end;

end.