

{

Pacman X Level Editor
Made by Gummo.

Menu pictures and some improvents
done by Antti Kirjavainen.

}


unit UnitLevelMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Menus;

type
  TfrmMain = class(TForm)
    MainMenu1: TMainMenu;
    Load1: TMenuItem;
    Load2: TMenuItem;
    SaveAs1: TMenuItem;
    od: TOpenDialog;
    sd: TSaveDialog;
    Image1: TImage;
    Zoom1: TMenuItem;
    In1: TMenuItem;
    Out1: TMenuItem;
    Normal1: TMenuItem;
    ool1: TMenuItem;
    Tool1: TMenuItem;
    Tool2: TMenuItem;
    Tool3: TMenuItem;
    Tool4: TMenuItem;
    Tool5: TMenuItem;
    Tool6: TMenuItem;
    Tool7: TMenuItem;
    Tool8: TMenuItem;
    Tool9: TMenuItem;
    Tool10: TMenuItem;
    N1: TMenuItem;
    mnuExit: TMenuItem;
    mnuNew: TMenuItem;
    N2: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure Load2Click(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure In1Click(Sender: TObject);
    procedure Out1Click(Sender: TObject);
    procedure Normal1Click(Sender: TObject);
    procedure OnTool(Sender: TObject);
    procedure SaveAs1Click(Sender: TObject);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
procedure UncheckAll;
procedure AppException(Sender: TObject; E: Exception);
    procedure mnuExitClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure mnuNewClick(Sender: TObject);
procedure OpenFile(FileName: String);

  private
    BlockWidth, BlockHeight: Integer;

    CurrentTool: Integer;
    MouseIsDown: Boolean;
  
    WorkCanvas: TCanvas;
    Area: TRect;
    Grid: Array[0..19, 0..19] of Word; // 0 = wall, 1 = meatball, 2 = drug, 3 = blank, 4 = jail entrance, 5 = pacman, 6 = ghoul 1, 7 = ghoul 2, 8 = ghoul 3, 9 = ghoul 4

    function GetBlockRect(n, n2: Integer): TRect;
    procedure DrawIt(Sender: TObject; var Done: Boolean);
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;
  AppPath : String;
  Added : Boolean;

implementation

{$R *.dfm}

procedure TfrmMain.AppException(Sender: TObject; E: Exception);
begin
// Nothing
end;

function TfrmMain.GetBlockRect(n, n2: Integer): TRect;
begin
  Result := Rect(Area.Left + (BlockWidth * n), Area.Top + (BlockHeight * n2), (Area.Left + (BlockWidth * n)) + BlockWidth, (Area.Top + (BlockHeight * n2)) + BlockHeight)
end;

procedure TfrmMain.DrawIt(Sender: TObject; var Done: Boolean);
var
  n, n2: Integer;
  r: TRect;
begin
  Done := False;

  Sleep(100);

  for n2 := low(Grid[0]) to high(Grid[0]) do // y
    for n := low(Grid) to high(Grid) do // x
    begin
      r := GetBlockRect(n, n2);
      if Grid[n, n2] <= 4 then
        StretchBlt(WorkCanvas.Handle, r.Left, r.Top, BlockWidth, BlockHeight, Image1.Canvas.Handle, Grid[n, n2] * 20, 0, 20, 20, SRCCOPY)
      else if Grid[n, n2] = 5 then
        StretchBlt(WorkCanvas.Handle, r.Left, r.Top, BlockWidth, BlockHeight, Image1.Canvas.Handle, 0, 20, 20, 20, SRCCOPY)
      else
        StretchBlt(WorkCanvas.Handle, r.Left, r.Top, BlockWidth, BlockHeight, Image1.Canvas.Handle, (Grid[n, n2]-6) * 20, 40, 20, 20, SRCCOPY);
    end;

  WorkCanvas.Pen.Mode := pmWhite;
  for n := low(Grid) to high(Grid) do
  begin
    WorkCanvas.MoveTo(n * BlockWidth, 0);
    WorkCanvas.LineTo(n * BlockWidth, Area.Bottom);
  end;
  for n := low(Grid[0]) to high(Grid[0]) do
  begin
    WorkCanvas.MoveTo(0, n * BlockHeight);
    WorkCanvas.LineTo(area.Right, n * BlockHeight);
  end;

  Canvas.CopyRect(Area, WorkCanvas, Area);
end;

procedure TfrmMain.FormCreate(Sender: TObject);
var
  workDC: HDC;
  bmp: HBitmap;
begin

  Application.OnException := AppException;
  AppPath := ExtractFilePath(Application.ExeName);

  // set down the thread priority so this application doesn't lag others
  // *** IF IT RUNS CHOPPY DELETE THIS LINE ***
  SetThreadPriority(GetCurrentThread(), THREAD_PRIORITY_LOWEST);
  
  // set draw loop thing
  Application.OnIdle := DrawIt;

  // setup rects
  BlockWidth := 20;
  BlockHeight := 20; 
  Area := Rect(0, 0, length(Grid) * BlockWidth, length(Grid[0]) * BlockHeight); 

  // setup workcanvas
  WorkCanvas := TCanvas.Create(); 
  workDC := CreateCompatibleDC(Canvas.Handle);
  bmp := CreateCompatibleBitmap(Canvas.Handle, Screen.Width, Screen.Height);
  SelectObject(workDC, bmp);
  WorkCanvas.Handle := workDC;

  CurrentTool := 0;

  MouseIsDown := False;

if (Length(ParamStr(1)) > 0) then begin
                                  OpenFile(ParamStr(1));
                                  exit;
                                  end;

  mnuNew.Click;

end;

procedure TfrmMain.Load2Click(Sender: TObject);
var
  msgLoad : Integer;

begin
od.FileName := '';

if Added then begin
                msgLoad := MessageDlg('Would you like to save this level first?', mtConfirmation, [mbYes, mbNo, mbCancel], 0);

                if (msgLoad = mrCancel) then begin
                                                exit;
                                                end;

                if (msgLoad = mrYes) then begin
                                                SaveAs1.Click;
                                                end;
                end;
                

  if (Length(od.FileName) = 0) then begin
                                    if not od.Execute then Exit;
                                    end;

  OpenFile(od.FileName);
end;

procedure TfrmMain.OpenFile(FileName: String);
var
  n, n2: Integer;
  s: String;

begin
  with TStringList.Create() do
  try
    od.FileName := FileName;
    LoadFromFile(FileName);
    
    for n2 := low(Grid[0]) to high(Grid[0]) do // y
      for n := low(Grid) to high(Grid) do // x   
      begin
        s := Copy(Strings[n2], n + 1, 1);  
        
        if s = 'p' then // pacman start position
        begin
          Grid[n, n2] := 5;
        end else if s = 'a' then // ghoul 0 start
        begin
          Grid[n, n2] := 6;
        end else if s = 'b' then // ghoul 1 start
        begin
          Grid[n, n2] := 7;
        end else if s = 'c' then // ghoul 2 start
        begin
          Grid[n, n2] := 8;
        end else if s = 'd' then // ghoul 3 start
        begin
          Grid[n, n2] := 9;
        end else if s = 'w' then // jail entrance
        begin
          Grid[n, n2] := 4;
        end else begin
          Grid[n, n2] := StrToInt(s); 
        end;
      end;
  finally
    Free();
  end;

Self.Caption := FileName;
sd.FileName := FileName;

Added := False;
FileName := '';

end;

procedure TfrmMain.In1Click(Sender: TObject);
begin
UnCheckAll;
  In1.Checked := True;
  BlockWidth := BlockWidth + 10;
  BlockHeight := BlockHeight + 10;
  Area := Rect(0, 0, length(Grid) * BlockWidth, length(Grid[0]) * BlockHeight);
Self.Refresh;
end;

procedure TfrmMain.Out1Click(Sender: TObject);
begin
UnCheckAll;
  Out1.Checked := True;
  BlockWidth := BlockWidth - 10;
  BlockHeight := BlockHeight - 10;
  Area := Rect(0, 0, length(Grid) * BlockWidth, length(Grid[0]) * BlockHeight);
Self.Refresh;
end;

procedure TfrmMain.UncheckAll;
begin
In1.Checked := False;
Out1.Checked := False;
Normal1.Checked := False;
end;

procedure TfrmMain.Normal1Click(Sender: TObject);
begin
UnCheckAll;
  Normal1.Checked := True;
  BlockWidth := 20;
  BlockHeight := 20;
  Area := Rect(0, 0, length(Grid) * BlockWidth, length(Grid[0]) * BlockHeight);
Self.Refresh;
end;

procedure TfrmMain.OnTool(Sender: TObject);
begin
  Tool1.Checked := False;
  Tool2.Checked := False;
  Tool3.Checked := False;
  Tool4.Checked := False;
  Tool5.Checked := False;
  Tool6.Checked := False;
  Tool7.Checked := False;
  Tool8.Checked := False;
  Tool9.Checked := False;
  Tool10.Checked := False;
  TMenuItem(Sender).Checked := True;

  CurrentTool := TMenuItem(Sender).Tag;
end;

procedure TfrmMain.SaveAs1Click(Sender: TObject);
var
  n, n2: Integer;
  s: String;
  TimesFound: Word;
begin

  if not sd.Execute then exit;

  TimesFound := 0;
  for n2 := low(Grid[0]) to high(Grid[0]) do // y
    for n := low(Grid) to high(Grid) do // x 
      if Grid[n, n2] = 5 then 
        inc(TimesFound);
  if TimesFound <> 1 then
  begin
    MessageDlg('You should only have one Pacman!' + #13 + #10 + 'Saving canceled.', mtError, [mbOK], 0);
    Exit;
  end;
  TimesFound := 0;
  for n2 := low(Grid[0]) to high(Grid[0]) do // y
    for n := low(Grid) to high(Grid) do // x 
      if Grid[n, n2] >= 6 then 
        inc(TimesFound);
  if TimesFound <> 4 then
  begin
    MessageDlg('You should only have one of each ghoul!' + #13 + #10 + 'Saving canceled.', mtError, [mbOK], 0);
    Exit;
  end;
    
  with TStringList.Create() do
  try
    for n2 := low(Grid[0]) to high(Grid[0]) do // y
    begin
      s := '';  
      for n := low(Grid) to high(Grid) do // x  
        if Grid[n, n2] <= 3 then
          s := s + IntToStr(Grid[n, n2])
        else if Grid[n, n2] = 4 then
          s := s + 'w'
        else if Grid[n, n2] = 5 then
          s := s + 'p'
        else if Grid[n, n2] = 6 then
          s := s + 'a'
        else if Grid[n, n2] = 7 then
          s := s + 'b'
        else if Grid[n, n2] = 8 then
          s := s + 'c'
        else if Grid[n, n2] = 9 then
          s := s + 'd';
          
      Add(s);
    end;

    SaveToFile(sd.FileName);
    Self.Caption := sd.FileName;
    od.FileName := sd.FileName;

  finally
    Free();
  end; 

Added := False;

end;

procedure TfrmMain.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  x := x div BlockWidth;
  y := y div BlockHeight;
  if (x > high(Grid)) or (y > high(Grid[0])) then
    Exit;

  Grid[x, y] := CurrentTool;

  MouseIsDown := True;
  Added := True;
end;

procedure TfrmMain.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if not MouseIsDown then
    Exit;
  
  x := x div BlockWidth;
  y := y div BlockHeight;
  if (x > high(Grid)) or (y > high(Grid[0])) then
    Exit;

  Grid[x, y] := CurrentTool;
end;

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

procedure TfrmMain.mnuExitClick(Sender: TObject);
begin
Self.Close;
end;

procedure TfrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
var
        msgQuit : Integer;

begin
if not Added then exit;

msgQuit := MessageDlg('Would you like to save this level first?', mtConfirmation, [mbYes, mbNo, mbCancel], 0);

if (msgQuit = mrCancel) then begin
                              CanClose := False;
                              exit;
                              end;

if (msgQuit = mrYes) then begin
                              SaveAs1.Click;
                              CanClose := True;
                              exit;
                              end;

if (msgQuit = mrNo) then begin
                              CanClose := True;
                              exit;
                              end;
end;

procedure TfrmMain.mnuNewClick(Sender: TObject);
begin
OpenFile(AppPath + 'Levels\blank.pml');
end;

end.
