source: tags/1.3.0/Forms/UFormMain.pas

unit UFormMain;

{$mode delphi}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Menus, Math,
  ActnList, ExtCtrls, StdCtrls, UGame, UPersistentForm, UApplicationInfo,
  LCLType, Syncobjs, DateUtils;

type
  TFormMain = class;

  { TMoveThread }

  TMoveThread = class(TThread)
    FormMain: TFormMain;
    procedure Execute; override;
  end;

  { TFormMain }

  TFormMain = class(TForm)
    MainMenu1: TMainMenu;
    MenuItem1: TMenuItem;
    MenuItem2: TMenuItem;
    MenuItem3: TMenuItem;
    MenuItem4: TMenuItem;
    MenuItemMovesHistory: TMenuItem;
    MenuItemTools: TMenuItem;
    MenuItemNew: TMenuItem;
    MenuItemExit: TMenuItem;
    MenuItemHelp: TMenuItem;
    MenuItemAbout: TMenuItem;
    MenuItemGame: TMenuItem;
    TimerDraw: TTimer;
    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormPaint(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure TimerDrawTimer(Sender: TObject);
    procedure EraseBackground(DC: HDC); override;
  private
    DrawDuration: TDateTime;
    MouseStart: TPoint;
    MouseDown: Boolean;
    RedrawPending: Boolean;
    MoveBuffer: array of TMoveDirection;
    MoveBufferLock: TCriticalSection;
    procedure AddToMoveBuffer(Direction: TMoveDirection);
    procedure ProcessMoveBuffer;
  public
    MoveThread: TMoveThread;
    procedure Redraw;
    procedure UpdateInterface;
  end;

var
  FormMain: TFormMain;

implementation

{$R *.lfm}

uses
  UCore;

{ TMoveThread }

procedure TMoveThread.Execute;
begin
  while not Terminated do begin
    FormMain.ProcessMoveBuffer;
    Sleep(10);
  end;
end;

{ TFormMain }

procedure TFormMain.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  if Core.Game.Running then begin
    case Key of
      37: AddToMoveBuffer(drLeft);
      38: AddToMoveBuffer(drUp);
      39: AddToMoveBuffer(drRight);
      40: AddToMoveBuffer(drDown);
    end;
    //ProcessMoveBuffer;
  end;
end;

procedure TFormMain.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  MouseStart := Point(X, Y);
  MouseDown := True;
end;

function AngleOfLine(const P1, P2: TPoint): Double;
begin
  if P2.X = P1.X then
    if P2.Y > P1.Y then
      Result := 90
    else
      Result := 270
  else
    Result := RadToDeg(ArcTan2(P2.Y - P1.Y, P2.X - P1.X));
  if Result < 0 then
    Result := Result + 360;
end;

procedure TFormMain.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  D: Real;
  Angle: Real;
begin
  if MouseDown then begin;
    D := MouseStart.Distance(Point(X, Y));
    if D > ScaleX(100, 96) then begin
      MouseDown := False;
      Angle := AngleOfLine(MouseStart, Point(X, Y));
      if (Angle > 315) or (Angle <= 45) then AddToMoveBuffer(drRight)
      else if (Angle > 45) and (Angle <= 135) then AddToMoveBuffer(drDown)
      else if (Angle > 135) and (Angle <= 225) then AddToMoveBuffer(drLeft)
      else if (Angle > 225) and (Angle <= 315) then AddToMoveBuffer(drUp);
      //ProcessMoveBuffer;
    end;
  end;
end;

procedure TFormMain.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  MouseDown := False;
end;

procedure TFormMain.FormPaint(Sender: TObject);
var
  TimeStart: TDateTime;
begin
  {$IFDEF DEBUG}
  TimeStart := Now;
  {$ENDIF}
  Core.Game.Render(Canvas, Point(Width, Height - MainMenu1.Height));
  {$IFDEF DEBUG}
  DrawDuration := Now - TimeStart;
  {$ENDIF}
end;

procedure TFormMain.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
  Core.PersistentForm1.Save(Self);
end;

procedure TFormMain.FormCreate(Sender: TObject);
begin
  Core.Translator1.TranslateComponentRecursive(Self);
  MoveBufferLock := TCriticalSection.Create;
  MoveThread := TMoveThread.Create(True);
  MoveThread.FormMain := Self;
  MoveThread.FreeOnTerminate := False;
  MoveThread.Start;
  ControlStyle := ControlStyle + [csOpaque];
end;

procedure TFormMain.FormDestroy(Sender: TObject);
begin
  FreeAndNil(MoveThread);
  FreeAndNil(MoveBufferLock);
end;

procedure TFormMain.FormShow(Sender: TObject);
begin
  Core.PersistentForm1.RegistryContext := Core.ApplicationInfo1.GetRegistryContext;
  Core.PersistentForm1.Load(Self);
  Core.ThemeManager1.UseTheme(Self);
  UpdateInterface;
  if Core.Game.Board.GetEmptyTilesCount > Core.Game.Board.Size.X * Core.Game.Board.Size.Y -
    InitialTileCount then
    Core.Game.New;
end;

procedure TFormMain.TimerDrawTimer(Sender: TObject);
begin
  if RedrawPending then begin
    RedrawPending := False;
    Repaint;
{$IFDEF DEBUG}
    //Caption := FloatToStr(Round(DrawDuration / OneMillisecond));
{$ENDIF}
  end;
end;

procedure TFormMain.EraseBackground(DC: HDC);
begin
  // Do nothing
end;

procedure TFormMain.AddToMoveBuffer(Direction: TMoveDirection);
begin
  MoveBufferLock.Acquire;
  try
    SetLength(MoveBuffer, Length(MoveBuffer) + 1);
    MoveBuffer[Length(MoveBuffer) - 1] := Direction;
  finally
    MoveBufferLock.Release;
  end;
end;

procedure TFormMain.ProcessMoveBuffer;
begin
  if not Core.Game.Moving then begin
    MoveBufferLock.Acquire;
    while Length(MoveBuffer) > 0 do begin
      MoveBufferLock.Release;
      Core.Game.MoveAllAndUpdate(MoveBuffer[0], Core.Game.AnimationDuration > 0);
      MoveBufferLock.Acquire;
      if Length(MoveBuffer) > 1 then
        Move(MoveBuffer[1], MoveBuffer[0], (Length(MoveBuffer) - 1) * SizeOf(TMoveDirection));
      if Length(MoveBuffer) > 0 then
        SetLength(MoveBuffer, Length(MoveBuffer) - 1);
    end;
    MoveBufferLock.Release;
  end;
end;

procedure TFormMain.Redraw;
begin
  RedrawPending := True;
end;

procedure TFormMain.UpdateInterface;
var
  I: Integer;
  ToolsVisible: Boolean;
begin
  MenuItemMovesHistory.Visible := Core.Game.RecordHistory;
  ToolsVisible := False;
  for I := 0 to MenuItemTools.Count - 1 do
    if MenuItemTools.Items[I].Visible then begin
      ToolsVisible := True;
      Break;
    end;
  MenuItemTools.Visible := ToolsVisible;
end;

end.