pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@2089 8e941d3f-bd1b-0410-a28a-d453659cc2b4

Browse Source
This commit is contained in:
denniscuflat
2011-10-24 19:51:13 +00:00
parent 9ab5cb45e9
commit bd690c6ad9
9 changed files with 159 additions and 56 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
applications/tappytux/gameconfigform.lfm
View File

@ -1,7 +1,7 @@
object formConfig: TformConfig
Left = 345
Left = 731
Height = 432
Top = 296
Top = 390
Width = 582
Caption = 'TappyTux Loader'
ClientHeight = 432

14
applications/tappytux/gameconfigform.pas
View File

@ -7,7 +7,7 @@ interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
ExtCtrls,
tappymodules, gameplayform;
tappymodules, gameplayform, tappygamedata;
type
@ -77,27 +77,25 @@ end;
procedure TformConfig.btnLoadClick(Sender: TObject);
begin
SetCurrentModule(comboGameType.ItemIndex);
GetCurrentModule().StartNewGame();
GetCurrentModule().StartNewGame(comboSound.ItemIndex, comboMusic.ItemIndex, comboLevel.ItemIndex);
formTappyTuxGame.Show;
Hide;
end;
procedure TformConfig.comboSoundChange(Sender: TObject);
begin
{
Case comboSound.itemIndex of
0: begin
TTappyGameData.SndFX = true;
//gameData.SndFX := true;
end;
1: begin
TTappyGameData.SndFX = false;
//gameData.SndFX := false;
end;
end; }
end;
end;

6
applications/tappytux/gameplayform.lfm
View File

@ -1,10 +1,10 @@
object formTappyTuxGame: TformTappyTuxGame
Left = 630
Height = 421
Top = 249
Height = 425
Top = 245
Width = 621
Caption = 'Tappy Tux'
ClientHeight = 421
ClientHeight = 425
ClientWidth = 621
OnCreate = FormCreate
LCLVersion = '0.9.31'

8
applications/tappytux/gameplayform.pas
View File

@ -8,7 +8,7 @@ uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
ExtCtrls,
// TappyTux
tappydrawer, tappymodules;
{GameData,} tappydrawer, tappymodules;
type
@ -59,6 +59,8 @@ begin
begin
formTappyTuxGame.Memo1.Lines.Add(Edit1.Text);
formTappyTuxGame.Edit1.Clear;
//TappyTuxGame.ThrowHammer();
end;
end;
@ -74,6 +76,10 @@ begin
vTappyTuxDrawer.SendToBack();
end;
{procedure TformTappyTuxGame.OnClose;
begin
formConfig
end;}
end.

9
applications/tappytux/mod_tappymath.pas
View File

@ -6,6 +6,9 @@ interface
uses
Classes, SysUtils,
// LCL
ExtCtrls,
// TappyTux
tappymodules;
type
@ -17,12 +20,14 @@ type
constructor Create; override;
procedure TranslateTextsToEnglish; override;
procedure TranslateTextsToPortuguese; override;
procedure StartNewGame(); override;
procedure StartNewGame(SndFX: Integer; Music: Integer; Level: Integer); override;
procedure EndGame(); override;
end;
implementation
uses tappydrawer {,tappygamedata};
{ TTappyWords }
constructor TTappyMath.Create;
@ -40,7 +45,7 @@ begin
ShortDescription := 'TappyMath - Um jogo para aprender aritmética';
end;
procedure TTappyMath.StartNewGame;
procedure TTappyMath.StartNewGame(SndFX: Integer; Music: Integer; Level: Integer);
begin
end;

18
applications/tappytux/mod_tappywords.pas
View File

@ -9,7 +9,7 @@ uses
// LCL
ExtCtrls,
// TappyTux
tappymodules, tappydrawer;
tappymodules, tappygamedata;
type
@ -24,12 +24,14 @@ type
destructor Destroy; override;
procedure TranslateTextsToEnglish; override;
procedure TranslateTextsToPortuguese; override;
procedure StartNewGame(); override;
procedure StartNewGame(SndFX: Integer; Music: Integer; Level: Integer); override;
procedure EndGame(); override;
end;
implementation
uses tappydrawer;
{ TTappyWords }
procedure TTappyWords.HandleOnTimer(Sender: TObject);
@ -48,6 +50,7 @@ begin
timerWords.Enabled := False;
timerWords.Interval := 1000;
timerWords.OnTimer := @HandleOnTimer;
end;
destructor TTappyWords.Destroy;
@ -67,9 +70,18 @@ begin
ShortDescription := 'TappyWords - Um jogo para aprender a digitar e ortografia';
end;
procedure TTappyWords.StartNewGame;
procedure TTappyWords.StartNewGame(SndFX: Integer; Music: Integer; Level: Integer);
begin
//Causam "External: SIGSEGV"
gameData.SetSndFX(SndFX);
gameData.SetMusic(Music);
gameData.SetLevel(Level);
timerWords.Enabled := True;
end;
procedure TTappyWords.EndGame;

2
applications/tappytux/tappydrawer.pas
View File

@ -7,7 +7,7 @@ interface
uses
Classes, SysUtils, Controls, Graphics, LCLType, IntfGraphics, fpimage,
Math,
tappygamedata, tappyconfig, tappymodules;
{tappygamedata,} tappyconfig, tappymodules;
type

150
applications/tappytux/tappygamedata.pas
View File

@ -1,19 +1,100 @@
unit tappygamedata;
// Responsável apenas por guardar e alterar dados referentes aos jogos.
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils;
type
{ GameData }
TTappyGameData = class
ModuleName : String;
SndFX : Boolean;
Music : Boolean;
Level : Integer;
Lives : Integer;
Score : Integer;
procedure SetSndFX(var newSndFX: Integer);
procedure SetMusic(var newMusic: Integer);
procedure SetLevel(var newLevel: Integer);
end;
var
gameData: TTappyGameData;
implementation
procedure TTappyGameData.SetSndFX(var newSndFX: Integer);
begin
Case newSndFx of
0: gameData.SndFX := true;
1: gameData.SndFX := false;
end;
end;
procedure TTappyGameData.SetMusic(var newMusic: Integer);
begin
Case newMusic of
0: gameData.Music := true;
1: gameData.Music := false;
end;
end;
procedure TTappyGameData.SetLevel(var newLevel: Integer);
begin
Level := newLevel + 1;
end;
end.
{
unit tappygamedata;
{$mode objfpc}{$H+}
interface
uses
Classes, Forms, SysUtils, process;
// SynRegExpr,
// LCLProc,
// tappywords,
// util,
// tappyconfig;
Classes, Forms, SysUtils, process, LCLProc, tappymodules, mod_tappywords,{ util,} tappyconfig;
Type
TTappyGameData = object
{TTappyGameData = class
SndFX : Boolean;
SndMusic: Boolean;
ModuleName : String;
@ -28,22 +109,23 @@ Type
QuestionList :TStringList;
BGS : TStringList;
BG : Integer;
(* Procedure Create;
Procedure Create;
Function GetQuestion:String;
Function CheckAnswer(Question,Answer:String):Integer;
Procedure ScoreUp(ScorInc:Integer);
Procedure LevelUp;
Procedure LoseLife;
Function NextSong: String;
Function NextBG:String;*)
Function NextBG:String; }
end;
(* HammerQue = Object
HammerQue = Object
Target : Array [1..10] of Integer;
Count: Integer; //teste
Function addTarget(newTarget : Integer):Boolean;
Procedure delTarget;
Count : Integer;
end;
{Count : Integer;}
end;
TSong = class(TThread)
@ -62,17 +144,17 @@ Type
Constructor Create(isSuspended : boolean);
published
property terminated;
end;*)
end;
var
gGameData: TTappyGameData;
//Question : TQuestion;
//Scale : Integer;
//TPTDIR: string;
Question : TQuestion;
Scale : Integer;
TPTDIR: string;
implementation
(*constructor TQuestion.Create(isSuspended : boolean);
constructor TQuestion.Create(isSuspended : boolean);
begin
S := TSTringlist.Create;
FreeOnTerminate := True;
@ -86,27 +168,27 @@ Var CMD : String;
Begin
repeat
If (Not Terminated) and
(ThisGame.QuestionList.Count < 20) and
(length(ThisGame.ModuleName) > 0) and
(Length(ThisGame.Option) > 0) then
(gGameData{ThisGame}.QuestionList.Count < 20) and
(length(gGameData{ThisGame}.ModuleName) > 0) and
(Length(gGameData{ThisGame}.Option) > 0) then
Begin
if pos('tappywords',ThisGame.ModuleName) <> 0 then
if pos('tappywords',gGameData{ThisGame}.ModuleName) <> 0 then
Begin
TheWord :=GetQuestion(ThisGame.Level);
If ThisGame.QuestionList.IndexOf(TheWord) = -1 then
ThisGame.QuestionList.Add(TheWord);
TheWord :=gGameData.GetQuestion({gGameDataThisGame.Level});
If gGameData{ThisGame}.QuestionList.IndexOf(TheWord) = -1 then
gGameData{ThisGame}.QuestionList.Add(TheWord);
end else
Begin
S.Clear;
Ps := TProcess.create(nil);;
CMD := ThisGame.ModuleName' "'ThisGAme.Option'" 'intToStr(ThisGame.Level)' --getquestion';
CMD := gGameData{ThisGame}.ModuleName;//TESTE' "'ThisGAme.Option'" 'intToStr(ThisGame.Level)' --getquestion';
PS.CommandLine := cmd;
Ps.Options := [poNoConsole,poUsePipes,poWaitOnExit];
Ps.Execute;
S.LoadFromStream(PS.OutPut);
PS.Free;
If ThisGame.QuestionList.IndexOf(S[0]) = -1 then
ThisGame.QuestionList.Add(S[0]);
If gGameData{ThisGame}.QuestionList.IndexOf(S[0]) = -1 then
gGameData{ThisGame}.QuestionList.Add(S[0]);
end;
end;
until Terminated;
@ -125,7 +207,7 @@ var
begin
{To prevent ESD clashes - we slow this down on first run}
sleep(5000);
with ThisGame do
with gGameData{ThisGame} do
begin
Process := TProcess.create(nil);
while (NextSong <> 'NONE') and (not Terminated) do
@ -156,7 +238,7 @@ begin
if not(Score > 0) then Score := 0;
Lives := 5;
SearchFiles(SongList,TPTDirpathdelim'music'pathdelim,'*.ogg','');
{TESTE SearchFiles(SongList,TPTDirpathdelim'music'pathdelim,'*.ogg','');
If Scale = 640 then
SearchFiles(BGS,TPTDirpathdelim'levels','*.jpg','');
@ -165,9 +247,10 @@ begin
SearchFiles(BGS,TPTDirpathdelim'levels'pathdelim'800'pathdelim,'*.jpg','');
If scale = 1024 then
SearchFiles(BGS,TPTDirpathdelim'levels'pathdelim'1024'pathdelim,'*.jpg','');
SearchFiles(BGS,TPTDirpathdelim'levels'pathdelim'1024'pathdelim,'*.jpg','');}
end;
Function TTappyGameData.GetQuestion:String;
Var
TheQ:String;
@ -180,13 +263,12 @@ While QuestionList.Count < 1 do
end;
Function TTappyGameData.CheckAnswer(Question,Answer:String):Integer;
Var S: TStringList;
Begin
if (length(Question) <> 0) and (length(Answer) <> 0) then
begin
If ThisGame.ModuleName <> 'tappywords' then
If gGameData{ThisGame}.ModuleName <> 'tappywords' then
begin
try
execute(ModuleName' "'Option'" 'intToStr(Level)' --checkquestion "'Question'" "'answer'"',S);
@ -271,6 +353,6 @@ Begin
Target[X] := Target[X 1];
Dec(Count);
end;*)
end;
end.
end. }

4
applications/tappytux/tappymodules.pas
View File

@ -24,7 +24,7 @@ type
procedure TranslateTextsToEnglish; virtual;
procedure TranslateTextsToPortuguese; virtual;
procedure InitModule(); virtual;
procedure StartNewGame(); virtual; abstract;
procedure StartNewGame(SndFX: Integer; Music: Integer; Level: Integer); virtual; abstract;
procedure EndGame(); virtual; abstract;
end;
@ -38,7 +38,7 @@ implementation
var
gTappyModules: TFPList;
gCurrentTappyModule: Integer = -1;
gCurrentTappyModule: Integer = 0; //=-1
procedure AddModule(AModule: TTappyModule);
begin