lasarus_compotents/bgrabitmap/test/test4lcl_opengl/tux_game/mainunit.pas

unit MainUnit;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, LCLProc, LResources, Forms, Controls, Graphics, Dialogs,
  ExtCtrls, StdCtrls, OpenGLContext, BGRAOpenGL, BGLVirtualScreen, UGame;

type
  { TForm1 }

  TForm1 = class(TForm)
    BGLVirtualScreen1: TBGLVirtualScreen;
    BGLVirtualScreen2: TBGLVirtualScreen;
    Button1: TButton;
    Button2: TButton;
    Label1: TLabel;
    Label2: TLabel;
    Panel1: TPanel;

    procedure BGLVirtualScreen2Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var {%H-}CloseAction: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);

    { HANDLE MOUSE AND KEY STROKES }
    procedure FormKeyDown(Sender: TObject; var Key: Word; {%H-}Shift: TShiftState);
    procedure FormKeyUp(Sender: TObject; var Key: Word; {%H-}Shift: TShiftState);
    procedure BGLVirtualScreen1MouseDown(Sender: TObject; Button: TMouseButton;
      {%H-}Shift: TShiftState; X, Y: Integer);
    procedure BGLVirtualScreen1MouseMove(Sender: TObject; {%H-}Shift: TShiftState;
      X, Y: Integer);
    procedure BGLVirtualScreen1MouseUp(Sender: TObject; Button: TMouseButton;
      {%H-}Shift: TShiftState; X, Y: Integer);

    { VIRTUAL SCREEN 1 }
    procedure BGLVirtualScreen1LoadTextures(Sender: TObject; BGLContext: TBGLContext);
    procedure BGLVirtualScreen1Redraw(Sender: TObject; BGLContext: TBGLContext);
    procedure BGLVirtualScreen1Elapse(Sender: TObject; BGLContext: TBGLContext; ElapsedMs: integer);
    procedure BGLVirtualScreen1FramesPerSecond(Sender: TObject; {%H-}BGLContext: TBGLContext; FramesPerSecond: integer);
    procedure BGLVirtualScreen1UnloadTextures(Sender: TObject; BGLContext: TBGLContext);

    { VIRTUAL SCREEN 2 }
    procedure BGLVirtualScreen2LoadTextures(Sender: TObject; BGLContext: TBGLContext);
    procedure BGLVirtualScreen2Redraw(Sender: TObject; BGLContext: TBGLContext);
    procedure BGLVirtualScreen2Elapse(Sender: TObject; BGLContext: TBGLContext; ElapsedMs: integer);
    procedure BGLVirtualScreen2FramesPerSecond(Sender: TObject; {%H-}BGLContext: TBGLContext; FramesPerSecond: integer);
    procedure BGLVirtualScreen2UnloadTextures(Sender: TObject; BGLContext: TBGLContext);
  protected
    procedure AdjustHeight;
  public
    GameContext1: TGameContext;
    GameContext2: TGameContext;
  end;

var
  Form1: TForm1; 

implementation

uses LCLType, BGRABitmapTypes;

{$R *.lfm}

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
  Position := poScreenCenter;
  ClientWidth := 800;
  ClientHeight := 600;
  Constraints.MaxWidth := Width;

  ResourceDir := {$IFDEF DARWIN}ExtractFilePath(Application.ExeName)+'../../../../'{$ELSE}
                 '..'+PathDelim{$ENDIF};
  GameContext1 := TGameContext.Create(False);
  GameContext2 := nil;
  { Textures are loaded in the LoadTextures event }

  AdjustHeight;
end;

procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
  { Textures must be freed while the virtual screens exist }
  if Assigned(GameContext1) then
  begin
    BGLVirtualScreen1.UnloadTextures;
    FreeAndNil(GameContext1);
  end;
  if Assigned(GameContext2) then
  begin
    BGLVirtualScreen2.UnloadTextures;
    FreeAndNil(GameContext2);
  end;
end;

procedure TForm1.BGLVirtualScreen2Click(Sender: TObject);
begin
  if not Assigned(GameContext2) then
    Button2Click(Sender);
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  AdjustHeight;
end;

procedure TForm1.AdjustHeight;
begin
  if Assigned(GameContext2) then
  begin
    BGLVirtualScreen2.Height := (ClientHeight-Panel1.Height) div 2;
    BGLVirtualScreen2.Cursor := crDefault;
  end
  else
  begin
    BGLVirtualScreen2.Height := 8;
    BGLVirtualScreen2.Cursor := crHandPoint;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Button1.Enabled := false;
  Button2.Enabled := true;

  if Assigned(GameContext2) then
  begin
    BGLVirtualScreen2.UnloadTextures;
    FreeAndNil(GameContext2);
    AdjustHeight;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  Button1.Enabled := true;
  Button2.Enabled := false;

  if not Assigned(GameContext2) then
  begin
    GameContext2 := TGameContext.Create(True);
    BGLVirtualScreen2.QueryLoadTextures; //query the event LoadTextures
    AdjustHeight;
  end;
end;

{---------------- HANDLE MOUSE AND KEY STROKES --------------}

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  GameContext1.KeyDown(Key,Shift);
end;

procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  GameContext1.KeyUp(Key,Shift);
end;

procedure TForm1.BGLVirtualScreen1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  GameContext1.MouseDown(Button,X,Y);
end;

procedure TForm1.BGLVirtualScreen1MouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
  GameContext1.MouseMove(X,Y);
end;

procedure TForm1.BGLVirtualScreen1MouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  GameContext1.MouseMove(X,Y);
  GameContext1.MouseUp(Button);
end;


{------------------ VIRTUAL SCREEN 1 ----------------}

procedure TForm1.BGLVirtualScreen1LoadTextures(Sender: TObject;
  BGLContext: TBGLContext);
begin
  if Assigned(GameContext1) then
    GameContext1.LoadTextures(BGLContext);
end;

procedure TForm1.BGLVirtualScreen1Redraw(Sender: TObject;
  BGLContext: TBGLContext);
begin
  if Assigned(GameContext1) then
    GameContext1.Render(BGLContext);
end;

procedure TForm1.BGLVirtualScreen1Elapse(Sender: TObject; BGLContext: TBGLContext; ElapsedMs: integer);
begin
  if Assigned(GameContext1) then
    GameContext1.Elapse(BGLContext, ElapsedMs);
end;

procedure TForm1.BGLVirtualScreen1FramesPerSecond(Sender: TObject;
  BGLContext: TBGLContext; FramesPerSecond: integer);
begin
  if Assigned(GameContext1) then
    GameContext1.FPS := FramesPerSecond;
end;

procedure TForm1.BGLVirtualScreen1UnloadTextures(Sender: TObject;
  BGLContext: TBGLContext);
begin
  if Assigned(GameContext1) then
    GameContext1.UnloadTextures(BGLContext);
end;

{-------------------- VIRTUAL SCREEN 2 -----------------}

procedure TForm1.BGLVirtualScreen2LoadTextures(Sender: TObject;
  BGLContext: TBGLContext);
begin
  if Assigned(GameContext2) then
    GameContext2.LoadTextures(BGLContext);
end;

procedure TForm1.BGLVirtualScreen2Redraw(Sender: TObject;
  BGLContext: TBGLContext);
begin
  if Assigned(GameContext2) then
  begin
    //draw an horizontal line to seperate visually from the other game
    BGLContext.Canvas.Line(0,0,BGLContext.Width-1,0,BGRABlack,True);
    BGLContext.Canvas.Translate(0,1);
    GameContext2.Render(BGLContext);
  end else
  begin
    //draw a handle to indicate it is reduced
    BGLContext.Canvas.Fill(ColorToBGRA(clBtnFace));
    BGLContext.Canvas.Line(1,3,BGLContext.Width-2,3, ColorToBGRA(clBtnHighlight));
    BGLContext.Canvas.Line(1,4,BGLContext.Width-2,4, ColorToBGRA(clBtnShadow));
  end;
end;

procedure TForm1.BGLVirtualScreen2Elapse(Sender: TObject;
  BGLContext: TBGLContext; ElapsedMs: integer);
begin
  if Assigned(GameContext2) then
    GameContext2.Elapse(BGLContext, ElapsedMs);
end;

procedure TForm1.BGLVirtualScreen2FramesPerSecond(Sender: TObject;
  BGLContext: TBGLContext; FramesPerSecond: integer);
begin
  if Assigned(GameContext2) then
    GameContext2.FPS := FramesPerSecond;
end;

procedure TForm1.BGLVirtualScreen2UnloadTextures(Sender: TObject;
  BGLContext: TBGLContext);
begin
  if Assigned(GameContext2) then
    GameContext2.UnloadTextures(BGLContext);
end;



end.