\ doge.pp - /g/pasta 2.4
From Edgy Kitten, 5 Years ago, written in Delphi (Object Pascal).
Embed
  1. program DogeSim2013;
  2.  
  3. {$mode objfpc}{$h+}
  4.  
  5. uses
  6.   Classes,
  7.   SysUtils,
  8.   Math,
  9.  
  10.   fpg_base,
  11.   fpg_main,
  12.   fpg_form,
  13.   fpg_button,
  14.   fpg_widget,
  15.   fpg_imgfmt_bmp,
  16.   fpg_label,
  17.   fpg_dialogs,
  18.  
  19.   WavePlayer;
  20.  
  21. type
  22.   TMenuWin = class(TfpgWidget)
  23.   private
  24.     BtnStart: TfpgButton;
  25.     TitleImage: TfpgImage;
  26.   protected
  27.     procedure HandlePaint; override;
  28.   public
  29.     constructor Create(AOwner: TComponent;
  30.       x, y, w, h: Integer); overload;
  31.   end;
  32.  
  33.   TMainWin = class(TfpgWidget)
  34.   private
  35.     Image: TfpgImage;
  36.     LblPet: TfpgLabel;
  37.     LblHappiness: TfpgLabel;
  38.     BtnYes: TfpgButton;
  39.     BtnNo: TfpgButton;
  40.     FHappiness: Integer;
  41.   protected
  42.     procedure HandlePaint; override;
  43.   public
  44.     constructor Create(AOwner: TComponent;
  45.       x, y, w, h: Integer); overload;
  46.     procedure UpdateHappiness;      
  47.     property Happiness: Integer read FHappiness write FHappiness;
  48.   end;
  49.  
  50.   TVictoryWin = class(TfpgWidget)
  51.   private
  52.     Image: TfpgImage;
  53.     BtnAgain: TfpgButton;
  54.   protected
  55.     procedure HandlePaint; override;
  56.   public
  57.     constructor Create(AOwner: TComponent;
  58.       x, y, w, h: Integer); overload;
  59.   end;
  60.  
  61.   TFailureWin = class(TfpgWidget)
  62.   private
  63.     Image: TfpgImage;
  64.     BtnAgain: TfpgButton;
  65.   protected
  66.     procedure HandlePaint; override;
  67.   public
  68.     constructor Create(AOwner: TComponent;
  69.       x, y, w, h: Integer); overload;
  70.   end;
  71.  
  72.   TMainForm = class(TfpgForm)
  73.   private
  74.     MainWin: TMainWin;
  75.     MenuWin: TMenuWin;
  76.     VictoryWin: TVictoryWin;
  77.     FailureWin: TFailureWin;
  78.     FIsClosed: Boolean;
  79.     FSounds: array of TWavePlayer;
  80.     procedure Win;
  81.     procedure Lose;
  82.     procedure CloseForm(Sender: TObject;
  83.       var CloseAction: TCloseAction);
  84.   public
  85.     constructor Create(AOwner: TComponent); override;
  86.     destructor Destroy; override;
  87.     procedure BtnStartClick(Sender: TObject);
  88.     procedure BtnYesClick(Sender: TObject);
  89.     procedure BtnNoClick(Sender: TObject);
  90.     procedure BtnAgainClick(Sender: TObject);
  91.     procedure ProcessSounds;
  92.     property IsClosed: Boolean read FIsClosed;
  93.   end;
  94.  
  95. var
  96.   MainForm: TMainForm;
  97.  
  98. constructor TMenuWin.Create(AOwner: TComponent;
  99.   x, y, w, h: Integer);
  100. begin
  101.   inherited Create(AOwner);
  102.   SetPosition(x, y, w, h);
  103.   Focusable := True;
  104.   Focused := True;
  105.  
  106.   TitleImage := LoadImage_BMP('img/doge.bmp');
  107.  
  108.   BtnStart := TfpgButton.Create(self);
  109.  
  110.   with BtnStart do
  111.   begin
  112.     Text := 'Start';
  113.     OnClick := @MainForm.BtnStartClick;
  114.     BackgroundColor := clLightGray;
  115.     Width := 100;
  116.     Height := 30;
  117.     Left := (Parent.Width - BtnStart.Width) div 2;
  118.     Top := Parent.Height - BtnStart.Height * 2
  119.   end
  120.  
  121. end;
  122.  
  123. procedure TMenuWin.HandlePaint;
  124. begin
  125.   inherited;
  126.  
  127.   Canvas.BeginDraw;
  128.   Canvas.Clear(BackgroundColor);
  129.   Canvas.DrawImage(0, 0, TitleImage);
  130.   Canvas.EndDraw
  131. end;
  132.  
  133. procedure TMainWin.UpdateHappiness;
  134. begin
  135.   LblHappiness.Text := Format('Happiness: %D%%', [FHappiness])
  136. end;
  137.  
  138. constructor TMainWin.Create(AOwner: TComponent;
  139.   x, y, w, h: Integer);
  140. begin
  141.   inherited Create(AOwner);
  142.   SetPosition(x, y, w, h);
  143.   Focusable := True;
  144.   Focused := True;
  145.  
  146.   BackgroundColor := clLightGray;
  147.  
  148.   Image := LoadImage_BMP('img/doge2.bmp');
  149.  
  150.   LblHappiness := TfpgLabel.Create(self);
  151.   FHappiness := 0;
  152.   UpdateHappiness;
  153.  
  154.   with LblHappiness do
  155.   begin
  156.     Alignment := taCenter;
  157.     Width := 120;
  158.     Left := 480;
  159.     Top := 20;
  160.     BackgroundColor := clLightBlue;
  161.   end;
  162.  
  163.   LblPet := TfpgLabel.Create(self);
  164.  
  165.   with LblPet do
  166.   begin
  167.     Text := 'Do you want to pet the doge?';
  168.     Alignment := taCenter;
  169.     Width := Parent.Width;
  170.     Left := 0;
  171.     Top := 380
  172.   end;
  173.  
  174.   BtnYes := TfpgButton.Create(self);
  175.  
  176.   with BtnYes do
  177.   begin
  178.     Text := 'Yes';
  179.     OnClick := @MainForm.BtnYesClick;
  180.     BackgroundColor := clGreen;
  181.     Width := 100;
  182.     Height := 30;
  183.     Left := 180;
  184.     Top := 420
  185.   end;
  186.  
  187.   BtnNo := TfpgButton.Create(self);
  188.  
  189.   with BtnNo do
  190.   begin
  191.     Text := 'No';
  192.     OnClick := @MainForm.BtnNoClick;
  193.     BackgroundColor := clRed;
  194.     Width := 100;
  195.     Height := 30;
  196.     Left := 360;
  197.     Top := 420
  198.   end
  199.  
  200. end;
  201.  
  202. procedure TMainWin.HandlePaint;
  203. begin
  204.   inherited;
  205.  
  206.   Canvas.BeginDraw;
  207.   Canvas.Clear(BackgroundColor);
  208.   Canvas.DrawImage(0, 0, Image);
  209.   Canvas.EndDraw
  210. end;
  211.  
  212. procedure TVictoryWin.HandlePaint;
  213. begin
  214.   inherited
  215.  
  216.   Canvas.BeginDraw;
  217.   Canvas.Clear(BackgroundColor);
  218.   Canvas.DrawImage(0, 0, Image);
  219.   Canvas.EndDraw
  220. end;
  221.  
  222. constructor TVictoryWin.Create(AOwner: TComponent;
  223.   x, y, w, h: Integer);
  224. begin
  225.   inherited Create(AOwner);
  226.   SetPosition(x, y, w, h);
  227.   Focusable := True;
  228.   Focused := True;
  229.  
  230.   Image := LoadImage_BMP('img/dogewin.bmp');
  231.  
  232.   BtnAgain := TfpgButton.Create(self);
  233.  
  234.   with BtnAgain do
  235.   begin
  236.     Text := 'Play again';
  237.     BackgroundColor := clLightGray;
  238.     OnClick := @MainForm.BtnAgainClick;
  239.     Width := 100;
  240.     Height := 30;
  241.     Left := 80;
  242.     Top := 400
  243.   end
  244.  
  245. end;
  246.  
  247. procedure TFailureWin.HandlePaint;
  248. begin
  249.   inherited
  250.  
  251.   Canvas.BeginDraw;
  252.   Canvas.Clear(BackgroundColor);
  253.   Canvas.DrawImage(0, 0, Image);
  254.   Canvas.EndDraw
  255. end;
  256.  
  257. constructor TFailureWin.Create(AOwner: TComponent;
  258.   x, y, w, h: Integer);
  259. begin
  260.   inherited Create(AOwner);
  261.   SetPosition(x, y, w, h);
  262.   Focusable := True;
  263.   Focused := True;
  264.  
  265.   Image := LoadImage_BMP('img/dogedie.bmp');
  266.  
  267.   BtnAgain := TfpgButton.Create(self);
  268.  
  269.   with BtnAgain do
  270.   begin
  271.     Text := 'Try again?';
  272.     BackgroundColor := clRed;
  273.     OnClick := @MainForm.BtnAgainClick;
  274.     Width := 100;
  275.     Height := 30;
  276.     Left := (Parent.Width - Width) div 2;
  277.     Top := 400
  278.   end
  279.  
  280. end;
  281.  
  282. procedure TMainForm.Win;
  283. begin
  284.   MainWin.Visible := False;
  285.   VictoryWin.Visible := True
  286. end;
  287.  
  288. procedure TMainForm.Lose;
  289. begin
  290.   MainWin.Visible := False;
  291.   FailureWin.Visible := True;
  292.   FSounds[0].Stop;
  293.   FSounds[3].Play
  294. end;
  295.  
  296. procedure TMainForm.CloseForm(Sender: TObject;
  297.   var CloseAction: TCloseAction);
  298. begin
  299.   FIsClosed := True
  300. end;
  301.  
  302. procedure TMainForm.BtnStartClick(Sender: TObject);
  303. begin
  304.   MenuWin.Visible := False;
  305.   MainWin.Visible := True
  306. end;
  307.  
  308. procedure TMainForm.BtnYesClick(Sender: TObject);
  309. begin
  310.   FSounds[1].Stop;
  311.   FSounds[1].Play;
  312.  
  313.   MainWin.Happiness := Min(MainWin.Happiness + 23, 100);
  314.   MainWin.UpdateHappiness;
  315.  
  316.   if MainWin.Happiness >= 100 then
  317.     Win
  318.  
  319. end;
  320.  
  321. procedure TMainForm.BtnNoClick(Sender: TObject);
  322. begin
  323.   FSounds[2].Stop;  
  324.   FSounds[2].Play;
  325.  
  326.   MainWin.Happiness := Max(MainWin.Happiness - 13, 0);
  327.   MainWin.UpdateHappiness;
  328.  
  329.   if MainWin.Happiness <= 0 then
  330.     Lose
  331.  
  332. end;
  333.  
  334. procedure TMainForm.BtnAgainClick(Sender: TObject);
  335. begin
  336.   FSounds[0].Stop;
  337.   FSounds[3].Stop;
  338.  
  339.   VictoryWin.Visible := False;
  340.   FailureWin.Visible := False;
  341.   MenuWin.Visible := True;
  342.  
  343.   MainWin.Happiness := 0;
  344.   MainWin.UpdateHappiness;
  345.  
  346.   FSounds[0].Play
  347. end;
  348.  
  349. constructor TMainForm.Create(AOwner: TComponent);
  350. begin
  351.   inherited Create(AOwner);
  352.  
  353.   SetPosition(0, 0, 640, 480);
  354.   WindowPosition := wpScreenCenter;
  355.   WindowTitle := 'Doge Simulator 2013 Dx';
  356.   Sizeable := False;
  357.  
  358.   FIsClosed := False;
  359.   OnClose := @CloseForm;
  360.  
  361.   MainWin := TMainWin.Create(self, 0, 0, Width, Height);
  362.   MainWin.Visible := False;
  363.  
  364.   VictoryWin := TVictoryWin.Create(self, 0, 0, Width, Height);
  365.   VictoryWin.Visible := False;
  366.  
  367.   FailureWin := TFailureWin.Create(self, 0, 0, Width, Height);
  368.   FailureWin.Visible := False;
  369.  
  370.   MenuWin := TMenuWin.Create(self, 0, 0, Width, Height);
  371.  
  372.   SetLength(FSounds, 4);
  373.   FSounds[0] := TWavePlayer.Create('snd/doge.wav');
  374.   FSounds[1] := TWavePlayer.Create('snd/bark1.wav');
  375.   FSounds[2] := TWavePlayer.Create('snd/bark2.wav');
  376.   FSounds[3] := TWavePlayer.Create('snd/dogedie.wav');
  377.  
  378.   FSounds[0].Loop := True;
  379.   FSounds[0].Play;
  380.  
  381.   Show
  382. end;
  383.  
  384. destructor TMainForm.Destroy;
  385. begin
  386.   FSounds[0].Free;
  387.   FSounds[1].Free;
  388.   FSounds[2].Free;
  389.   FSounds[3].Free;
  390.  
  391.   inherited
  392. end;
  393.  
  394. procedure TMainForm.ProcessSounds;
  395. begin
  396.   FSounds[0].Process;
  397.   FSounds[1].Process;
  398.   FSounds[2].Process;
  399.   FSounds[3].Process
  400. end;
  401.  
  402. begin
  403.   fpgApplication.Initialize;
  404.   fpgApplication.CreateForm(TMainForm, MainForm);
  405.  
  406.   repeat
  407.     fpgApplication.ProcessMessages;
  408.     MainForm.ProcessSounds
  409.   until MainForm.IsClosed;
  410.  
  411.   MainForm.Free;
  412. end.