Subversion Repositories plumbers

unit Main;

// BUG: If you drag the window, the dia show will stop playing, but the sound continues! This makes everything out of sync.

// TODO: When the windows is only resized a little bit (A few pixels), the window should not centered

//       ... Calc the width and height of ALL pictures, and then size the form to the biggest value?

//       ... or hard code the resolution in the INI file?

// Idea: Ini Parameter if fullscreen is applied or not

// Idea: Savestates, speedup, pause, Use Space bar to go to the next decision point.

// -----------------------------------------------------------------------------

// HOTSPOT_RELATIVE_ORIGIN is a new behavior which is not compatible with the original engine.

// With HOTSPOT_RELATIVE_ORIGIN enabled, the coordinates will be relative to the picture

// The original game has the origin at the top left corner of the screen.

// This is a problem because the game as well as the scene editor does not know the

// desired resolution, as it is automatically determined.

// If we would hardcode the desired canvas (640x480) in <ExeName>.ini, then

// it would work, but then, the scene Editor can not know the desired resolution...

{$DEFINE HOTSPOT_RELATIVE_ORIGIN}

interface

uses

  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,

  Dialogs, ExtCtrls, StdCtrls, Game, MPlayer, SyncObjs;

type

  TMainForm = class(TForm)

    Image1: TImage;

    Panel1: TPanel;

    StartupTimer: TTimer;

    MediaPlayer1: TMediaPlayer;

    Panel2: TPanel;

    procedure FormCreate(Sender: TObject);

    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);

    procedure StartupTimerTimer(Sender: TObject);

    procedure ControlClick(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

    procedure FormDestroy(Sender: TObject);

  private

    FHotspots: array[0..2] of THotspot;

    FullscreenMode: boolean;

    procedure cbPictureShow(ASender: TGame; AFilename: string; AType: TPictureType);

    procedure cbAsyncSound(ASender: TGame; AFilename: string);

    procedure cbExit(ASender: TGame);

    function cbWait(ASender: TGame; AMilliseconds: Cardinal): boolean;

    procedure cbSetHotspot(ASender: TGame; AIndex: THotspotIndex; AHotspot: THotspot);

    procedure cbClearHotspots(ASender: TGame);

    procedure ClickEvent(X, Y: Integer);

  private

    FCancelSceneRequest: boolean;

    csCancelSceneRequest: TCriticalSection;

  public

    game: TGame;

  end;

var

  MainForm: TMainForm;

implementation

{$R *.dfm}

uses

  MMSystem, IniFiles, Math, GameBinStruct;

function AddThouSeps(const S: string): string;

var

  LS, L2, I, N: Integer;

  Temp: string;

begin

  // http://www.delphigroups.info/2/11/471892.html

  result := S ;

  LS := Length(S);

  N := 1 ;

  if LS > 1 then

  begin

    if S [1] = '-' then  // check for negative value

    begin

      N := 2;

      LS := LS - 1;

    end;

  end;

  if LS <= 3 then exit;

  L2 := (LS - 1) div 3;

  Temp := '';

  for I := 1 to L2 do

  begin

    Temp := {$IF not Declared(ThousandSeparator)}FormatSettings.{$IFEND}ThousandSeparator + Copy (S, LS - 3 * I + 1, 3) + Temp;

  end;

  Result := Copy (S, N, (LS - 1) mod 3 + 1) + Temp;

  if N > 1 then Result := '-' + Result;

end;

{ TMainForm }

procedure TMainForm.cbPictureShow(ASender: TGame; AFilename: string; AType: TPictureType);

resourcestring

  S_YOUR_SCORE = 'Your score is: %s';

begin

  csCancelSceneRequest.Acquire;

  try

    FCancelSceneRequest := false;

  finally

    csCancelSceneRequest.Release;

  end;

  {$IFDEF DEBUG}

  Caption := AFileName;

  {$ENDIF}

  if FileExists(AFilename) then

  begin

    Image1.Visible := false;

    try

      Image1.Picture.LoadFromFile(AFilename);

      Image1.Autosize := true;

    finally

      // This speeds up the picture loading on very old computers

      Image1.Visible := true;

    end;

    // Make form bigger if necessary

    if Image1.Width > ClientWidth then

    begin

      ClientWidth := Min(Image1.Width, Screen.Width);

      if (ClientWidth >= Screen.Width) then FullscreenMode := true;

      Position := poScreenCenter;

    end;

    if Image1.Height > ClientHeight then

    begin

      ClientHeight := Min(Image1.Height, Screen.Height);

      if (ClientHeight >= Screen.Height) then FullscreenMode := true;

      Position := poScreenCenter;

    end;

    // Center image

    Image1.Left := ClientWidth div 2 - Image1.Width div 2;

    Image1.Top := ClientHeight div 2 - Image1.Height div 2;

  end

  else

  begin

    // ShowMessageFmt('File not found: %s', [AFileName]);

    Image1.Picture := nil;

  end;

  if FullScreenMode then

  begin

    BorderStyle := bsNone;

    FormStyle := fsStayOnTop;

    Case AType of

      ptDia: Screen.Cursor := -1;

      ptDecision: Screen.Cursor := 0;

    End;

  end;

  Panel1.Caption := Format(S_YOUR_SCORE, [AddThouSeps(IntToStr(ASender.Score))]);

  Panel1.Left := 8;

  Panel1.Top := Min(ClientHeight, Screen.Height) - Panel1.Height - 8;

  Panel1.Visible := AType = ptDecision;

end;

procedure TMainForm.cbAsyncSound(ASender: TGame; AFilename: string);

begin

  PlaySound(nil, hinstance, 0);

  if FileExists(AFilename) then

  begin

    PlaySound(PChar(AFilename), hinstance, SND_FILENAME or SND_ASYNC);

  end;

end;

procedure TMainForm.cbSetHotspot(ASender: TGame; AIndex: THotspotIndex; AHotspot: THotspot);

begin

  FHotspots[AIndex] := AHotspot;

end;

procedure TMainForm.cbClearHotspots(ASender: TGame);

var

  i: Integer;

begin

  for i := Low(FHotspots) to High(FHotspots) - 1 do

  begin

    FHotspots[i].lpAction := nil;

  end;

end;

procedure TMainForm.cbExit(ASender: TGame);

begin

  Application.Terminate;

end;

function TMainForm.cbWait(ASender: TGame; AMilliseconds: Cardinal): boolean;

var

  FirstTickCount: DWord;

begin

  //Cursor := crHourglass;

  try

    result := false; // don't cancel

    FirstTickCount := GetTickCount; // TODO: Attention, GetTickCount can overflow

    while not Application.Terminated and ((GetTickCount - FirstTickCount) < AMilliseconds) do

    begin

      csCancelSceneRequest.Acquire;

      try

        if FCancelSceneRequest then

        begin

          FCancelSceneRequest := false;

          result := true; // cancel

          exit;

        end;

      finally

        csCancelSceneRequest.Release;

      end;

      Application.ProcessMessages;

      Sleep(0);

    end;

  finally

    //Cursor := crDefault;

  end;

end;

procedure TMainForm.FormCreate(Sender: TObject);

var

  ini: TMemIniFile;

  iniFilename: string;

begin

  csCancelSceneRequest := TCriticalSection.Create;

  iniFilename := ChangeFileExt(ExtractFileName(ParamStr(0)), '.ini');

  DoubleBuffered := true;

  if FileExists(iniFilename) then

  begin

    ini := TMemIniFile.Create(iniFilename);

    try

      Caption := ini.ReadString('Config', 'Title', '');

    finally

      FreeAndNil(ini);

    end;

  end;

  try

    StartupTimer.Enabled := true;

  except

    Application.Terminate;

  end;

end;

procedure TMainForm.FormDestroy(Sender: TObject);

begin

  if Assigned(Game) then FreeAndNil(Game);

  // Without this, some audio drivers could crash if you press ESC to end the game.

  // (VPC 2007 with Win95; cpsman.dll crashes sometimes)

  PlaySound(nil, hinstance, 0);

  FreeAndNil(csCancelSceneRequest);

end;

procedure TMainForm.FormKeyDown(Sender: TObject; var Key: Word;

  Shift: TShiftState);

begin

  if Key = VK_SPACE then

  begin

    if MediaPlayer1.Mode = mpPlaying then MediaPlayer1.Stop;

  end;

  if KEY = VK_RETURN then

  begin

    if MediaPlayer1.Mode = mpPlaying then

    begin

      MediaPlayer1.Position := MediaPlayer1.EndPos;

    end;

    csCancelSceneRequest.Acquire;

    try

      FCancelSceneRequest := true;

    finally

      csCancelSceneRequest.Release;

    end;

  end;

  if Key = VK_ESCAPE then Close;

end;

procedure TMainForm.ClickEvent(X, Y: Integer);

var

  i: integer;

  ac: TActionDef;

begin

  // Debug: Go to prev decision by clicking on the top left edge

  if (X < 20) and (Y < 20) then

  begin

    // TODO: Also allow to go back multiple steps (we would need a stack instead of PrevDecisionScene/CurDecisionScene)

    ac.scoreDelta := 0;

    ac.nextSceneID := SCENEID_PREVDECISION;

    ac.sceneSegment := 0;

    Game.PerformAction(@ac);

    Exit;

  end;

  // If hotspots are overlaying, the lowest action will be chosen (same behavior as original game)

  for i := Low(FHotspots) to High(FHotspots) do

  begin

    if Assigned(FHotspots[i].lpAction) and

       (X >= FHotspots[i].cHotspotTopLeft.X) and

       (Y >= FHotspots[i].cHotspotTopLeft.Y) and

       (X <= FHotspots[i].cHotspotBottomRight.X) and

       (Y <= FHotspots[i].cHotspotBottomRight.Y) then

    begin

      FHotspots[i].Game.PerformAction(FHotspots[i].lpAction);

      Exit;

    end;

  end;

end;

procedure TMainForm.ControlClick(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

  {$IFDEF HOTSPOT_RELATIVE_ORIGIN}

  ClickEvent(X, Y);

  {$ELSE}

  ClickEvent(X+TControl(Sender).Left, Y+TControl(Sender).Top);

  {$ENDIF}

end;

procedure TMainForm.StartupTimerTimer(Sender: TObject);

begin

  StartupTimer.Enabled := false;

  if FileExists('INTRO.AVI') then

  begin

    MediaPlayer1.FileName := 'INTRO.AVI';

    MediaPlayer1.Open;

    Panel2.Visible := true;

    Panel2.Top := 0;

    Panel2.Left := 0;

    Panel2.Width  := MediaPlayer1.DisplayRect.Right;

    Panel2.Height := MediaPlayer1.DisplayRect.Bottom;

    ClientWidth := Panel2.Width;

    if (ClientWidth >= Screen.Width) then FullscreenMode := true;

    ClientHeight := Panel2.Height;

    if (ClientHeight >= Screen.Height) then FullscreenMode := true;

    Position := poScreenCenter;

    if FullScreenMode then

    begin

      BorderStyle := bsNone;

      FormStyle := fsStayOnTop;

      Screen.Cursor := -1;

    end;

    // For some reason, "Position := poScreenCenter" causes the video handle to break!

    // we need to close+open it again!

    MediaPlayer1.Close;

    MediaPlayer1.Open;

    MediaPlayer1.Play;

    while MediaPlayer1.Mode <> mpStopped do

    begin

      Sleep(100);

      Application.ProcessMessages;

      if Application.Terminated then break;

    end;

    MediaPlayer1.Close;

    Panel2.Visible := false;

    Screen.Cursor := 0;

  end;

  try

    Game := TGame.Create('.');

    Game.PictureShowCallback := cbPictureShow;

    Game.AsyncSoundCallback := cbAsyncSound;

    Game.ExitCallback := cbExit;

    Game.WaitCallback := cbWait;

    Game.SetHotspotCallback := cbSetHotspot;

    Game.ClearHotspotsCallback := cbClearHotspots;

    Game.Run;

  except

    on E: EAbort do

    begin

      Close;

    end;

    on E: Exception do

    begin

      MessageDlg(E.Message, mtError, [mbOK], 0);

      Close;

    end;

  end;

end;

end.