From 5379901827ef78d70850fe7525f0898c6fd0be87 Mon Sep 17 00:00:00 2001 From: sekelsenmat Date: Thu, 15 Sep 2011 14:34:06 +0000 Subject: [PATCH] Adds basic animations support to tappytux git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1961 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- applications/tappytux/gameconfigform.pas | 1 + applications/tappytux/gameplayform.pas | 4 +- applications/tappytux/mod_tappymath.pas | 12 ++ applications/tappytux/mod_tappywords.pas | 41 ++++- applications/tappytux/tappydrawer.pas | 70 ++++++++- applications/tappytux/tappymodules.pas | 2 + applications/tappytux/tappytux.lpi | 184 +++++++++++++---------- 7 files changed, 226 insertions(+), 88 deletions(-) diff --git a/applications/tappytux/gameconfigform.pas b/applications/tappytux/gameconfigform.pas index 33a3efb80..059e2d474 100644 --- a/applications/tappytux/gameconfigform.pas +++ b/applications/tappytux/gameconfigform.pas @@ -77,6 +77,7 @@ end; procedure TformConfig.btnLoadClick(Sender: TObject); begin SetCurrentModule(comboGameType.ItemIndex); + GetCurrentModule().StartNewGame(); formTappyTuxGame.Show; Hide; diff --git a/applications/tappytux/gameplayform.pas b/applications/tappytux/gameplayform.pas index fc8126ad6..828987571 100644 --- a/applications/tappytux/gameplayform.pas +++ b/applications/tappytux/gameplayform.pas @@ -8,7 +8,7 @@ uses Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls, // TappyTux - tappydrawer; + tappydrawer, tappymodules; type @@ -49,6 +49,8 @@ procedure TformTappyTuxGame.btnExitClick(Sender: TObject); begin Close; formConfig.Show; + + GetCurrentModule().EndGame(); end; procedure TformTappyTuxGame.Edit1KeyPress(Sender: TObject; var Key: char); diff --git a/applications/tappytux/mod_tappymath.pas b/applications/tappytux/mod_tappymath.pas index cabec68af..9afcd32ce 100644 --- a/applications/tappytux/mod_tappymath.pas +++ b/applications/tappytux/mod_tappymath.pas @@ -17,6 +17,8 @@ type constructor Create; override; procedure TranslateTextsToEnglish; override; procedure TranslateTextsToPortuguese; override; + procedure StartNewGame(); override; + procedure EndGame(); override; end; implementation @@ -38,6 +40,16 @@ begin ShortDescription := 'TappyMath - Um jogo para aprender aritmética'; end; +procedure TTappyMath.StartNewGame; +begin + +end; + +procedure TTappyMath.EndGame; +begin + +end; + initialization AddModule(TTappyMath.Create); end. diff --git a/applications/tappytux/mod_tappywords.pas b/applications/tappytux/mod_tappywords.pas index 0197e3df7..856581813 100644 --- a/applications/tappytux/mod_tappywords.pas +++ b/applications/tappytux/mod_tappywords.pas @@ -6,26 +6,55 @@ interface uses Classes, SysUtils, - tappymodules; + // LCL + ExtCtrls, + // TappyTux + tappymodules, tappydrawer; type { TTappyWords } TTappyWords = class(TTappyModule) + private + timerWords: TTimer; + procedure HandleOnTimer(Sender: TObject); public constructor Create; override; + destructor Destroy; override; procedure TranslateTextsToEnglish; override; procedure TranslateTextsToPortuguese; override; + procedure StartNewGame(); override; + procedure EndGame(); override; end; implementation { TTappyWords } +procedure TTappyWords.HandleOnTimer(Sender: TObject); +begin + vTappyTuxDrawer.HandleAnimationOnTimer(); + + // Create falling ballons here + vTappyTuxDrawer.AddAnimation(TBallonAnimation.Create); +end; + constructor TTappyWords.Create; begin inherited Create; + + timerWords := TTimer.Create(nil); + timerWords.Enabled := False; + timerWords.Interval := 1000; + timerWords.OnTimer := @HandleOnTimer; +end; + +destructor TTappyWords.Destroy; +begin + timerWords.Free; + + inherited Destroy; end; procedure TTappyWords.TranslateTextsToEnglish; @@ -38,6 +67,16 @@ begin ShortDescription := 'TappyWords - Um jogo para aprender a digitar e ortografia'; end; +procedure TTappyWords.StartNewGame; +begin + timerWords.Enabled := True; +end; + +procedure TTappyWords.EndGame; +begin + timerWords.Enabled := False; +end; + initialization AddModule(TTappyWords.Create); end. diff --git a/applications/tappytux/tappydrawer.pas b/applications/tappytux/tappydrawer.pas index bb8d8419d..b0410c309 100644 --- a/applications/tappytux/tappydrawer.pas +++ b/applications/tappytux/tappydrawer.pas @@ -14,7 +14,7 @@ type TTappyTuxAnimation = class CurrentStep: Integer; FinalStep: Integer; - constructor Create; + constructor Create; virtual; procedure DrawToIntfImg(AIntfImg: TLazIntfImage); virtual; abstract; procedure ExecuteFinal; virtual; abstract; end; @@ -27,6 +27,15 @@ type procedure ExecuteFinal; override; end; + { TBallonAnimation } + + TBallonAnimation = class(TTappyTuxAnimation) + public + constructor Create; override; + procedure DrawToIntfImg(AIntfImg: TLazIntfImage); override; + procedure ExecuteFinal; override; + end; + { TTappyTuxDrawer } TTappyTuxDrawer = class(TCustomControl) @@ -35,6 +44,7 @@ type FAnimationList: TFPList; public constructor Create(AOwner: TComponent); override; + destructor Destroy; override; procedure EraseBackground(DC: HDC); override; procedure Paint; override; procedure DrawToCanvas(ACanvas: TCanvas); @@ -49,6 +59,7 @@ type Shift: TShiftState; X, Y: Integer); procedure HandleOnTimer(Sender: TObject); procedure AddAnimation(AAnimation: TTappyTuxAnimation); + procedure HandleAnimationOnTimer(); end; var @@ -56,6 +67,26 @@ var implementation +{ TBallonAnimation } + +constructor TBallonAnimation.Create; +begin + inherited Create; + + CurrentStep := 0; + FinalStep := 200; +end; + +procedure TBallonAnimation.DrawToIntfImg(AIntfImg: TLazIntfImage); +begin + AIntfImg.Colors[CurrentStep, CurrentStep] := colRed; +end; + +procedure TBallonAnimation.ExecuteFinal; +begin + // Lost the game if the ballon reached its end +end; + { TFireAnimation } procedure TFireAnimation.DrawToIntfImg(AIntfImg: TLazIntfImage); @@ -102,6 +133,8 @@ constructor TTappyTuxDrawer.Create(AOwner: TComponent); begin inherited Create(AOwner); + FAnimationList := TFPList.Create; + { imgBoard := TPortableNetworkGraphic.Create; imgWPawn := TPortableNetworkGraphic.Create; imgWKnight := TPortableNetworkGraphic.Create; @@ -122,6 +155,13 @@ begin OnMouseDown := @HandleMouseDown; end; +destructor TTappyTuxDrawer.Destroy; +begin + FAnimationList.Free; + + inherited Destroy; +end; + procedure TTappyTuxDrawer.EraseBackground(DC: HDC); begin // Uncomment this to enable default background erasing @@ -155,6 +195,8 @@ var lIntfImage: TLazIntfImage; lTmpBmp: TBitmap; X, Y: integer; + i: Integer; + lAnimation: TTappyTuxAnimation; begin lIntfImage := TLazIntfImage.Create(0, 0); lTmpBmp := TBitmap.Create; @@ -180,10 +222,14 @@ begin Y := (8 - row) * INT_CHESSTILE_SIZE; DrawImageWithTransparentColor(lIntfImage, X, Y, FPCOLOR_TRANSPARENT_TILE, lTileBmp); - end; + end;} // Now animations - if Assigned(FAnimation) then FAnimation.DrawToIntfImg(lIntfImage);} + for i := 0 to FAnimationList.Count - 1 do + begin + lAnimation := TTappyTuxAnimation(FAnimationList.Items[i]); + lAnimation.DrawToIntfImg(lIntfImage); + end; lTmpBmp.LoadFromIntfImage(lIntfImage); ACanvas.Draw(0, 0, lTmpBmp); @@ -290,8 +336,22 @@ end; procedure TTappyTuxDrawer.AddAnimation(AAnimation: TTappyTuxAnimation); begin -{ FDrawerState := dsRunningAnimation; - FAnimation := AAnimation;} + FAnimationList.Add(AAnimation); +end; + +procedure TTappyTuxDrawer.HandleAnimationOnTimer; +var + i: Integer; + lAnimation: TTappyTuxAnimation; +begin + + for i := 0 to FAnimationList.Count - 1 do + begin + lAnimation := TTappyTuxAnimation(FAnimationList.Items[i]); + Inc(lAnimation.CurrentStep); + end; + + Self.Invalidate; end; end. diff --git a/applications/tappytux/tappymodules.pas b/applications/tappytux/tappymodules.pas index 7514f0f57..f6c75d7b8 100644 --- a/applications/tappytux/tappymodules.pas +++ b/applications/tappytux/tappymodules.pas @@ -23,6 +23,8 @@ type procedure TranslateTexts(ALanguage: Integer); procedure TranslateTextsToEnglish; virtual; procedure TranslateTextsToPortuguese; virtual; + procedure StartNewGame(); virtual; abstract; + procedure EndGame(); virtual; abstract; end; procedure AddModule(AModule: TTappyModule); diff --git a/applications/tappytux/tappytux.lpi b/applications/tappytux/tappytux.lpi index 4493a9007..1d44a84c8 100644 --- a/applications/tappytux/tappytux.lpi +++ b/applications/tappytux/tappytux.lpi @@ -35,12 +35,12 @@ - + - + @@ -50,9 +50,9 @@ - - - + + + @@ -62,13 +62,13 @@ - - - - + + + + @@ -78,7 +78,7 @@ - + @@ -87,9 +87,9 @@ - - - + + + @@ -99,28 +99,29 @@ - + - + + - - - + + + - + - - - + + + @@ -129,9 +130,9 @@ - - - + + + @@ -141,127 +142,148 @@ + + + + + + + + + + + + + + + + + + + + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - + - - + + - + - + - + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + +