unit Sprmain;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, ExtCtrls, Spritbox, StdCtrls, Menus, Sequence,
  Sprite, Frame, E_String;

type
  TfrmSpriteTest = class(TForm)
    { The sprites + spritebox }
    spriteRed: TSprite;
    spriteGreen: TSprite;
    TheSpriteBox: TSpriteBox;

    { The controls for running the program }
    butShowHide: TButton;
    butStartStopGreen: TButton;
    butStartStopRed: TButton;
    butCloneGreen: TButton;
    butCloneRed: TButton;
    butFastSlow: TButton;
    butTransaction: TButton;
    chkTransparent: TCheckBox;
    chkTestOnHit: TCheckBox;
    ZPos: TRadioGroup;

    { The labels }
    lblCode: TLabel;
    lblCaption1: TLabel;
    lblCaption2: TLabel;
    lblStatusRed: TLabel;
    lblStatusGreen: TLabel;

    { The menu }
    mnuMainTest: TMenuItem;
    mnuTestExit: TMenuItem;
    mnuMainHelp: TMenuItem;
    mnuHelpAbout: TMenuItem;
    MainMenu1: TMainMenu;

    timerTransaction: TTimer; { Timer for demonstrating the transaction }
    memoCode: TMemo;
    memoBackground: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure mnuTestExitClick(Sender: TObject);
    procedure mnuHelpAboutClick(Sender: TObject);
    procedure butShowHideClick(Sender: TObject);
    procedure butStartStopGreenClick(Sender: TObject);
    procedure butStartStopRedClick(Sender: TObject);
    procedure butCloneGreenClick(Sender: TObject);
    procedure butCloneRedClick(Sender: TObject);
    procedure butFastSlowClick(Sender: TObject);
    procedure butTransactionClick(Sender: TObject);
    procedure chkTransparentClick(Sender: TObject);
    procedure chkTestOnHitClick(Sender: TObject);
    procedure ZPosClick(Sender: TObject);
    procedure SpriteFinishSequence(Sender: TObject;
                                   var RepeatCount: Integer);
    procedure SpriteOnHit(Sender: TObject; HitWhom: TSprite);
    procedure timerTransactionTimer(Sender: TObject);
  private
    FShowSource : Boolean;     { If true: the source is displayed in de demo }
    FSourceList : TStringList;

    procedure ReadSourceFile;
    procedure ClearMemo;
    procedure ShowMemo;
    procedure AddToMemo(sProc : String);
    function  SearchProc(sProc : String) : Integer;

    procedure ShowCodeTransparent;
    procedure ShowCodeOnHit;
    procedure ShowCodeShowHideButton;
    procedure ShowCodeStartStopGreen;
    procedure ShowCodeStartStopRed;
    procedure ShowCodeCloneGreen;
    procedure ShowCodeCloneRed;
    procedure ShowCodeZPos;
    procedure ShowCodeFastSlow;
    procedure ShowCodeTransaction;

    procedure CloneSprite(ASprite : TSprite; bStartLeft : Boolean);
    procedure SeparateSprites(ASprite, A2ndSprite : TSprite);
    procedure StartStop(ASprite : TSprite;
                        const sLeftStandStill : String;
                        const sRightStandStill : String;
                        AButton : TButton;
                        const sButtonStart : String;
                        const sButtonStop : String);
    procedure ChangeIntervals(ASprite : TSprite; rInterval : Real);
    procedure SetSpriteHitTest(const bHitTest : Boolean);
    procedure EnableButtons(const bEnable : Boolean);
    procedure TestTransactionStart;
    procedure TestTransactionStop;
  end;

var
  frmSpriteTest: TfrmSpriteTest;

implementation

const
    iPictureWidth = 24;
    iDefXPosGreen : Integer = 0;   { Starting positions }
    iDefXPosRed   : Integer = 0;
    iDefYPos      : Integer = 18;
    iLeftMargin   : Integer = 0;
    iRightMargin  : Integer = 0;

    rSlowInterval = 0.2;  { Intervals are given in seconds }
    rFastInterval = 0.1;

{$R *.DFM}

procedure TfrmSpriteTest.FormCreate(Sender: TObject);
var
    W : Integer;
begin
    { Determine some default positions: }
    W := TheSpriteBox.Width;
    iDefXPosRed := W - iPictureWidth;
    iLeftMargin := W div 4;
    iRightMargin := W - (W div 4);

    { Read the source file to display: }
    FShowSource := True;
    FSourceList := nil;
    ReadSourceFile;
end;

procedure TfrmSpriteTest.FormShow(Sender: TObject);
begin
    { In the beginning, show the sprites on their initial positions }
    spriteGreen.MoveTo(iDefXPosGreen, iDefYPos);
    spriteGreen.Show('');
    spriteRed.MoveTo(iDefXPosRed, iDefYPos);
    spriteRed.Show('');
end;

procedure TfrmSpriteTest.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
    FSourceList.Free;
end;

procedure TfrmSpriteTest.mnuTestExitClick(Sender: TObject);
begin
    Close;
end;

procedure TfrmSpriteTest.mnuHelpAboutClick(Sender: TObject);
begin
    spriteGreen.ShowAbout;
end;

procedure TfrmSpriteTest.butShowHideClick(Sender: TObject);
{ Shows or hides both sprites (not their clones, if any). }
begin
    ShowCodeShowHideButton;
    if spriteGreen.Visible then begin
        spriteGreen.Hide;
        spriteRed.Hide;
        butShowHide.Caption := 'Show';
    end else begin
        spriteGreen.MoveTo(iDefXPosGreen, iDefYPos);
        spriteGreen.Show('');
        spriteRed.MoveTo(iDefXPosRed, iDefYPos);
        spriteRed.Show('');
        butShowHide.Caption := 'Hide';
    end;
end;

procedure TfrmSpriteTest.butStartStopGreenClick(Sender: TObject);
begin
    ShowCodeStartStopGreen;
    StartStop(spriteGreen, 'GSTAND1L', 'GSTAND1R',
              butStartStopGreen, 'Start Green', 'Stop Green');
end;

procedure TfrmSpriteTest.butStartStopRedClick(Sender: TObject);
begin
    ShowCodeStartStopRed;
    StartStop(spriteRed, 'STAND1L', 'STAND1R',
              butStartStopRed, 'Start Red', 'Stop Red');
end;

procedure TfrmSpriteTest.butCloneGreenClick(Sender: TObject);
begin
    ShowCodeCloneGreen;
    CloneSprite(spriteGreen, True);
end;

procedure TfrmSpriteTest.butCloneRedClick(Sender: TObject);
begin
    ShowCodeCloneRed;
    CloneSprite(spriteRed, False);
end;

procedure TfrmSpriteTest.butFastSlowClick(Sender: TObject);
begin
    { Speeding up or slowing down the Red and Green sprites, will also
      change the speed of their clones. A clone is a sprite on its own
      but it shares the framelist and sequencelist of the sprite it was
      cloned from. }
    ShowCodeFastSlow;
    if butFastSlow.Caption = 'Fast' then begin
        { Slow the sprites down: }
        ChangeIntervals(spriteGreen, rFastInterval);
        ChangeIntervals(spriteRed, rFastInterval);
        butFastSlow.Caption := 'Slow';
    end else begin
        ChangeIntervals(spriteGreen, rSlowInterval);
        ChangeIntervals(spriteRed, rSlowInterval);
        butFastSlow.Caption := 'Fast';
    end;
end;

procedure TfrmSpriteTest.butTransactionClick(Sender: TObject);
{ Testing out a transaction is especially nice when a few clones are
  walking. They will disappear and then reappear when the transaction
  is ended. }
begin
    if butTransaction.Caption = 'Stop' then
        TestTransactionStop
    else begin
        { Show sprites, standing still and disable all buttons: }
        TestTransactionStart;
        ShowCodeTransaction;

        { Start the transaction and the timer. Normally transactions are
          usefull for real applications and/or slow computers. Using a timer,
          it is possible to show some actions with a large time interval
          between them. }
        TheSpriteBox.BeginTransaction;
        timerTransaction.Tag := 0;
        timerTransaction.Enabled := True;
    end;
end;

procedure TfrmSpriteTest.chkTransparentClick(Sender: TObject);
begin
    ShowCodeTransparent;
    if chkTransparent.Checked then begin
        spriteGreen.PlotMode := spriteGreen.PlotMode + [PlotTransparent];
        spriteRed.PlotMode := spriteRed.PlotMode + [PlotTransparent];
    end else begin
        spriteGreen.PlotMode := spriteGreen.PlotMode - [PlotTransparent];
        spriteRed.PlotMode := spriteRed.PlotMode - [PlotTransparent];
    end;
    spriteGreen.RePaint;
    spriteRed.RePaint;
end;

procedure TfrmSpriteTest.chkTestOnHitClick(Sender: TObject);
begin
    ShowCodeOnHit;
    SetSpriteHitTest(chkTestOnHit.Checked);
end;

procedure TfrmSpriteTest.SetSpriteHitTest(const bHitTest : Boolean);
begin
    if bHitTest then begin
        spriteGreen.HitTest := htRect;
        spriteRed.HitTest := htRect;
    end else begin
        spriteGreen.HitTest := htNone;
        spriteRed.HitTest := htNone;
    end;
end;

procedure TfrmSpriteTest.ZPosClick(Sender: TObject);
var
    iGreen : Integer;
    iRed : Integer;
begin
    ShowCodeZPos;
    { Determine z positions. The sprites with a higher ZPos value move
      behind sprites with smaller values. If two sprites have the same
      ZPos, it is undetermined which one moves behind which one. }
    iGreen := 0;
    iRed := 0;
    if ZPos.ItemIndex = 1 then iGreen := 1;
    if ZPos.ItemIndex = 2 then iRed := 1;

    spriteGreen.ZPos := iGreen;
    spriteRed.ZPos := iRed;
end;

procedure TfrmSpriteTest.ReadSourceFile;
var
    S, tmp : String;
begin
    FSourceList := TStringList.Create;
    try
      AnalyzeFileSpec(ParamStr(0), S, tmp);
      S := MakeFileSpec(S, 'sprmain.pas');
      FSourceList.LoadFromFile(S);
      memoCode.Lines := FSourceList;
    except
      on EFOpenError do begin
          memoCode.WordWrap := True;
          memoCode.Lines.Add('The file "SPRMAIN.PAS" could not be opened. '+
                             'This memo will therefore not display code ' +
                             'with the examples.');
          FShowSource := False;
      end;
    end;
end;

procedure TfrmSpriteTest.ClearMemo;
begin
    if FShowSource then begin
        memoCode.Lines.Clear;
        memoCode.Visible := False;
    end;
end;

procedure TfrmSpriteTest.ShowMemo;
begin
    memoCode.SelStart := 0;
    memoCode.SelLength := 0;
    memoCode.Visible := True;
end;

procedure TfrmSpriteTest.AddToMemo(sProc : String);
var
    i : Integer;
begin
    if FShowSource then begin
        i := SearchProc('.' + sProc);
        if i = -1 then Exit;
        while i < FSourceList.Count do begin
            memoCode.Lines.Add(FSourceList[i]);
            if Pos('end;', FSourceList[i]) = 1 then begin
                memoCode.Lines.Add('');
                i := FSourceList.Count;
            end;
            Inc(i);
        end;
    end;
end;

function  TfrmSpriteTest.SearchProc(sProc : String) : Integer;
var
    i : Integer;
begin
    Result := -1;
    for i := 0 to FSourceList.Count -1 do begin
        if Pos(sProc, FSourceList[i]) <> 0 then begin
            Result := i;
            Break;
        end;
    end;
end;

procedure TfrmSpriteTest.ShowCodeTransparent;
begin
    ClearMemo;
    AddToMemo('chkTransparentClick');
    ShowMemo;
end;

procedure TfrmSpriteTest.ShowCodeOnHit;
begin
    ClearMemo;
    AddToMemo('chkTestOnHitClick');
    AddToMemo('SetSpriteHitTest');
    AddToMemo('SpriteOnHit');
    ShowMemo;
end;

procedure TfrmSpriteTest.ShowCodeShowHideButton;
begin
    ClearMemo;
    AddToMemo('butShowHideClick');
    ShowMemo;
end;

procedure TfrmSpriteTest.ShowCodeStartStopGreen;
begin
    ClearMemo;
    AddToMemo('butStartStopGreenClick');
    AddToMemo('StartStop');
    AddToMemo('SpriteFinishSequence');
    ShowMemo;
end;

procedure TfrmSpriteTest.ShowCodeStartStopRed;
begin
    ClearMemo;
    AddToMemo('butStartStopRedClick');
    AddToMemo('StartStop');
    AddToMemo('SpriteFinishSequence');
    ShowMemo;
end;

procedure TfrmSpriteTest.ShowCodeCloneGreen;
begin
    ClearMemo;
    AddToMemo('butCloneGreenClick');
    AddToMemo('CloneSprite');
    AddToMemo('SpriteFinishSequence');
    ShowMemo;
end;

procedure TfrmSpriteTest.ShowCodeCloneRed;
begin
    ClearMemo;
    AddToMemo('butCloneRedClick');
    AddToMemo('CloneSprite');
    AddToMemo('SpriteFinishSequence');
    ShowMemo;
end;

procedure TfrmSpriteTest.ShowCodeZPos;
begin
    ClearMemo;
    AddToMemo('ZPosClick');
    ShowMemo;
end;

procedure TfrmSpriteTest.ShowCodeFastSlow;
begin
    ClearMemo;
    AddToMemo('butFastSlowClick');
    AddToMemo('ChangeIntervals');
    ShowMemo;
end;

procedure TfrmSpriteTest.ShowCodeTransaction;
begin
    ClearMemo;
    AddToMemo('butTransactionClick');
    AddToMemo('PrepareTransaction');
    AddToMemo('TestTransactionStart');
    AddToMemo('TestTransactionStop');
    AddToMemo('timerTransactionTimer');
    ShowMemo;
end;

procedure TfrmSpriteTest.CloneSprite(ASprite : TSprite; bStartLeft : Boolean);
var
    AClone : TSprite;
begin
    AClone := TSprite.Clone(ASprite);
    if bStartLeft then begin
        AClone.MoveTo(iDefXPosGreen, iDefYPos);
        AClone.Show('');
        AClone.Run('Walk Right', 100);
    end else begin
        AClone.MoveTo(iDefXPosRed, iDefYPos);
        AClone.Show('');
        AClone.Run('Walk Left', 100);
    end;
end;

procedure TfrmSpriteTest.StartStop(ASprite : TSprite;
                                   const sLeftStandStill : String;
                                   const sRightStandStill : String;
                                   AButton : TButton;
                                   const sButtonStart : String;
                                   const sButtonStop : String);
begin
    with ASprite do if ASprite.Sequence = '' then begin
        { The sprite is doing nothing, start to walk to the left or the right
          (repeat equals 100). See also OnFinishSeqeunceEvent. }
        if CurrentFrame = sRightStandStill then
            ASprite.Run('Walk Right', 100)
        else
            ASprite.Run('Walk Left', 100);
        AButton.Caption := sButtonStop;
    end else begin
        { Stop the sequence }
        Pause;
        { Let the sprite stand still }
        if ASprite.Sequence = 'Walk Right' then
            CurrentFrame := sRightStandStill
        else
            CurrentFrame := sLeftStandStill;
        ASprite.Sequence := '';
        AButton.Caption := sButtonStart;
    end;
end;

procedure TfrmSpriteTest.ChangeIntervals(ASprite : TSprite; rInterval : Real);
var
    ASeqList : TSequenceList;
    ASeq : TSequence;
    i, j : Integer;
begin
    { It is assumed that the sequencelist and all its sequences
      are valid. Tests like "Assigned(ASeqList)" are left out. }
    ASeqList := ASprite.SequenceList;
    for i := 0 to ASeqList.Count-1 do begin
        ASeq := ASeqList[i];
        for j := 0 to ASeq.Count-1 do begin
            { ASeq[j] is a TFrameRef }
            ASeq[j].Time := rInterval;
        end;
    end;
end;

procedure TfrmSpriteTest.EnableButtons(const bEnable : Boolean);
begin
    butShowHide.Enabled := bEnable;
    butStartStopGreen.Enabled := bEnable;
    butStartStopRed.Enabled := bEnable;
    butCloneGreen.Enabled := bEnable;
    butCloneRed.Enabled := bEnable;
    butFastSlow.Enabled := bEnable;
    chkTransparent.Enabled := bEnable;
    chkTestOnHit.Enabled := bEnable;
    ZPos.Enabled := bEnable;
end;

procedure TfrmSpriteTest.TestTransactionStart;
begin
    { We do not want any hits: }
    chkTestOnHit.Checked := False;
    SetSpriteHitTest(chkTestOnHit.Checked);

    { Temporarily disable the controls: }
    EnableButtons(False);

    { Stop the sprites and move them to the default location: }
    spriteGreen.Pause;
    spriteGreen.Show('GSTAND1R');
    spriteGreen.MoveTo(iDefXPosGreen, iDefYPos);
    spriteRed.Pause;
    spriteRed.Show('STAND1L');
    spriteRed.MoveTo(iDefXPosRed, iDefYPos);

    { Show correct button captions: }
    butShowHide.Caption := 'Hide';
    butStartStopGreen.Caption := 'Start Green';
    butStartStopRed.Caption := 'Start Red';
    butTransaction.Caption := 'Stop';
end;

procedure TfrmSpriteTest.TestTransactionStop;
begin
    { End the timer: }
    timerTransaction.Enabled := False;

    { End the transaction. This paint all the dirty rects: }
    TheSpriteBox.EndTransAction;

    { Enable the controls: }
    EnableButtons(True);

    { One caption to change: }
    butTransaction.Caption := 'Transaction';
end;

procedure TfrmSpriteTest.SeparateSprites(ASprite, A2ndSprite : TSprite);
var
    W : Integer;
begin
    Exit;
    if ASprite.XPos < A2ndSprite.XPos then begin
        if ASprite.XPos + ASprite.Width >= A2ndSprite.XPos then begin
            W := (ASprite.XPos + ASprite.Width) - A2ndSprite.XPos;
            A2ndSprite.Move(W div 2, 0);
            ASprite.Move(-((W div 2) + 1), 0);
        end;
    end else begin
        if A2ndSprite.XPos + A2ndSprite.Width >= ASprite.XPos then begin
            W := (A2ndSprite.XPos + A2ndSprite.Width) - ASprite.XPos;
            ASprite.Move(W div 2, 0);
            A2ndSprite.Move(-((W div 2) + 1), 0);
        end;
    end;
end;

procedure TfrmSpriteTest.SpriteFinishSequence(Sender: TObject;
  var RepeatCount: Integer);
var
    ASprite : TSprite;
    ALabel : TLabel;
begin
    { Determine which sprite ended its sequence: }
    ASprite := Sender as TSprite;
    if Sender = spriteRed then
        ALabel := lblStatusRed
    else if Sender = spriteGreen then
        ALabel := lblStatusGreen
    else begin
        { Sprite is a clone. Destroy it. }
        if (ASprite.XPos > TheSpriteBox.Width) or
           (ASprite.XPos < -(ASprite.Width+1))then begin
            ASprite.Release;
        end;
        Exit;
    end;
    ALabel.Caption := 'OnFinishSequence (repeat=' + IntToStr(RepeatCount) + ')';

    with ASprite do begin
        if ASprite.Sequence = 'Walk Left' then begin
            if XPos <= iLeftMargin then
                ASprite.Run('Turn Right', 1)
        end else if ASprite.Sequence = 'Walk Right' then begin
            if XPos >= iRightMargin then
                ASprite.Run('Turn Left', 1);
        end else if (ASprite.Sequence = 'Turn Right') or
                    (ASprite.Sequence = 'Bump Left') then
            ASprite.Run('Walk Right', 100)
        else if (ASprite.Sequence = 'Turn Left') or
                (ASprite.Sequence = 'Bump Right') then
            ASprite.Run('Walk Left', 100);
    end;
end;

procedure TfrmSpriteTest.SpriteOnHit(Sender: TObject; HitWhom: TSprite);
{ This is the event handler for both the Green and the Red sprite. }
var
    ThisSprite : TSprite;
    ALabel : TLabel;
begin
    { Determine which sprite got the hit event: }
    ThisSprite := Sender as TSprite;

    { If the sprites were bumping ignore this hit event }
    if (Copy(ThisSprite.Sequence, 1, 4) = 'Bump') or
       (Copy(HitWHom.Sequence, 1, 4) = 'Bump') then Exit;

    if Sender = spriteRed then
        ALabel := lblStatusRed
    else if Sender = spriteGreen then
        ALabel := lblStatusGreen
    else begin
        { Clone: do nothing }
        Exit;
    end;

    if (HitWhom <> spriteRed) and (HitWhom <> spriteGreen) then
        { Clone: do nothing }
        Exit;

    MessageBeep( 0 );
    ALabel.Caption := 'OnHit (hit with=' + HitWhom.Name + ')';

    if (ThisSprite.Sequence <> 'Bump Left') and
       (ThisSprite.Sequence <> 'Bump Right') then begin
        { Make sure the sprites do not touch each other anymore: }
        SeparateSprites(ThisSprite, HitWhom);

        { Run the correct bump sequences: }
        with ThisSprite do begin
            if Sequence = 'Walk Left' then begin
                if ThisSprite.Sequence <> '' then
                    ThisSprite.Run('Bump Left', 1);
                if HitWhom.Sequence <> '' then
                    HitWhom.Run('Bump Right', 1);
            end else if Sequence = 'Walk Right' then begin
                if ThisSprite.Sequence <> '' then
                    ThisSprite.Run('Bump Right', 1);
                if HitWhom.sequence <> '' then
                    HitWhom.Run('Bump Left', 1);
            end;
        end;
    end;
end;

procedure TfrmSpriteTest.timerTransactionTimer(Sender: TObject);
begin
    timerTransaction.Tag := timerTransaction.Tag + 1;

    case timerTransaction.Tag of
        1 : spriteGreen.MoveTo(TheSpriteBox.Width div 2, iDefYPos);
        2 : spriteRed.MoveTo(TheSpriteBox.Width div 2, iDefYPos);
        3 : spriteGreen.Move(-12, 0);
        4 : spriteRed.Move(12, 0);

        5 : TestTransactionStop;
    end;
end;

end.