Стартовый пул

bgrabitmap/test/test4lcl_opengl/tux_game/mainunit.lfm

@@ -0,0 +1,104 @@
+object Form1: TForm1
+  Left = 388
+  Height = 600
+  Top = 110
+  Width = 800
+  HorzScrollBar.Page = 399
+  VertScrollBar.Page = 299
+  Caption = 'BGRABitmapPack + LCL + OpenGL'
+  ClientHeight = 600
+  ClientWidth = 800
+  OnClose = FormClose
+  OnCreate = FormCreate
+  OnKeyDown = FormKeyDown
+  OnKeyUp = FormKeyUp
+  OnResize = FormResize
+  LCLVersion = '1.4.0.4'
+  object Panel1: TPanel
+    Left = 0
+    Height = 29
+    Top = 0
+    Width = 800
+    Align = alTop
+    ClientHeight = 29
+    ClientWidth = 800
+    TabOrder = 2
+    object Label1: TLabel
+      Left = 8
+      Height = 15
+      Top = 4
+      Width = 39
+      Caption = 'Games:'
+      ParentColor = False
+    end
+    object Button1: TButton
+      Left = 56
+      Height = 25
+      Top = 0
+      Width = 32
+      Caption = '1'
+      Enabled = False
+      OnClick = Button1Click
+      TabOrder = 1
+      TabStop = False
+    end
+    object Button2: TButton
+      Left = 90
+      Height = 25
+      Top = 0
+      Width = 32
+      Caption = '2'
+      OnClick = Button2Click
+      TabOrder = 0
+      TabStop = False
+    end
+    object Label2: TLabel
+      Left = 140
+      Height = 15
+      Top = 4
+      Width = 265
+      Caption = 'Use arrow keys to move parent tux in game 1 (top)'
+      ParentColor = False
+    end
+  end
+  object BGLVirtualScreen1: TBGLVirtualScreen
+    Left = 0
+    Height = 563
+    Top = 29
+    Width = 800
+    OnRedraw = BGLVirtualScreen1Redraw
+    Align = alClient
+    BevelWidth = 0
+    Color = clNone
+    ParentColor = False
+    RedrawOnIdle = True
+    TabOrder = 0
+    UseDockManager = False
+    OnElapse = BGLVirtualScreen1Elapse
+    OnFramesPerSecond = BGLVirtualScreen1FramesPerSecond
+    OnLoadTextures = BGLVirtualScreen1LoadTextures
+    OnUnloadTextures = BGLVirtualScreen1UnloadTextures
+    OnMouseDown = BGLVirtualScreen1MouseDown
+    OnMouseMove = BGLVirtualScreen1MouseMove
+    OnMouseUp = BGLVirtualScreen1MouseUp
+  end
+  object BGLVirtualScreen2: TBGLVirtualScreen
+    Left = 0
+    Height = 8
+    Top = 592
+    Width = 800
+    OnRedraw = BGLVirtualScreen2Redraw
+    Align = alBottom
+    BevelWidth = 0
+    Color = clNone
+    ParentColor = False
+    RedrawOnIdle = True
+    TabOrder = 1
+    UseDockManager = False
+    OnClick = BGLVirtualScreen2Click
+    OnElapse = BGLVirtualScreen2Elapse
+    OnFramesPerSecond = BGLVirtualScreen2FramesPerSecond
+    OnLoadTextures = BGLVirtualScreen2LoadTextures
+    OnUnloadTextures = BGLVirtualScreen2UnloadTextures
+  end
+end

bgrabitmap/test/test4lcl_opengl/tux_game/mainunit.pas

@@ -0,0 +1,272 @@
+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.
+

bgrabitmap/test/test4lcl_opengl/tux_game/tux_game.lpi

@@ -0,0 +1,78 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="9"/>
+    <PathDelim Value="\"/>
+    <General>
+      <Flags>
+        <LRSInOutputDirectory Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="tux_game"/>
+      <ResourceType Value="res"/>
+      <Icon Value="0"/>
+    </General>
+    <BuildModes Count="1">
+      <Item1 Name="default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <IgnoreBinaries Value="False"/>
+      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+        <LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
+      </local>
+    </RunParams>
+    <RequiredPackages Count="3">
+      <Item1>
+        <PackageName Value="BGLControls"/>
+      </Item1>
+      <Item2>
+        <PackageName Value="BGRABitmapPack"/>
+      </Item2>
+      <Item3>
+        <PackageName Value="LCL"/>
+      </Item3>
+    </RequiredPackages>
+    <Units Count="3">
+      <Unit0>
+        <Filename Value="tux_game.lpr"/>
+        <IsPartOfProject Value="True"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="mainunit.pas"/>
+        <IsPartOfProject Value="True"/>
+        <ComponentName Value="Form1"/>
+        <HasResources Value="True"/>
+        <ResourceBaseClass Value="Form"/>
+      </Unit1>
+      <Unit2>
+        <Filename Value="ugame.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit2>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <SearchPaths>
+      <UnitOutputDirectory Value="lib"/>
+    </SearchPaths>
+    <Parsing>
+      <SyntaxOptions>
+        <UseAnsiStrings Value="False"/>
+      </SyntaxOptions>
+    </Parsing>
+    <Linking>
+      <Options>
+        <Win32>
+          <GraphicApplication Value="True"/>
+        </Win32>
+      </Options>
+    </Linking>
+  </CompilerOptions>
+</CONFIG>

bgrabitmap/test/test4lcl_opengl/tux_game/tux_game.lpr

@@ -0,0 +1,17 @@
+program tux_game;
+
+{$mode objfpc}{$H+}
+
+uses
+  Interfaces, // this includes the LCL widgetset
+  Forms
+  { add your units here }, MainUnit, UGame;
+
+{$R *.res}
+
+begin
+  Application.Initialize;
+  Application.CreateForm(TForm1, Form1);
+  Application.Run;
+end.
+

bgrabitmap/test/test4lcl_opengl/tux_game/ugame.pas

@@ -0,0 +1,549 @@
+unit UGame;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, sysutils, BGRAGraphics, BGRABitmap, BGRABitmapTypes,
+  BGRAOpenGL, Controls;
+
+const
+  FrameDurationMs = 15;
+
+type
+  TTux = class;
+
+  { TGameContext }
+
+  TGameContext = class
+  protected
+    TexturesLoaded: boolean;
+    LeftKey,RightKey,UpKey: boolean;
+    texWalking,texGround: IBGLTexture;
+    tux,smallTux: TTux;
+    elapsedMs: single;
+    sun: IBGLTexture;
+    font, bubbleFont: IBGLRenderedFont;
+    CenterOnSmallTux: boolean;
+    infoTextAnimTime: single;
+    procedure AddGround(x,y,w: single);
+    function FindGround(x: single; var y: single): boolean;
+
+  public
+    FPS: integer;
+    constructor Create(ACenterOnSmallTux: boolean);
+    destructor Destroy; override;
+
+    procedure LoadTextures({%H-}ctx: TBGLContext);
+    procedure UnloadTextures({%H-}ctx: TBGLContext);
+    procedure Render(ctx: TBGLContext);
+    procedure Elapse(ctx: TBGLContext; ms: single);
+
+    procedure MouseDown({%H-}Button: TMouseButton; {%H-}X,{%H-}Y: integer);
+    procedure MouseMove({%H-}X,{%H-}Y: integer);
+    procedure MouseUp({%H-}Button: TMouseButton);
+    procedure KeyDown(var Key: Word; {%H-}Shift: TShiftState);
+    procedure KeyUp(var Key: Word; {%H-}Shift: TShiftState);
+  end;
+
+  { TTextBubble }
+
+  TTextBubble = class
+  protected
+    FText: string;
+    FFont: IBGLFont;
+  public
+    constructor Create(AText: string; AFont: IBGLFont);
+    procedure Draw(AXCenter, AYBottom: single);
+  end;
+
+  { TTux }
+
+  TTux = class(TBGLSprite)
+    Speed: TPointF;
+    LookingLeft: boolean;
+    Context: TGameContext;
+    Autoplay: boolean;
+    Parent: TTux;
+    OnTheGround: boolean;
+    Bubble,BubbleTooFar: TTextBubble;
+    BubbleTime: integer;
+    ShowBubbleTooFar: boolean;
+    goRight,goLeft,goUp: boolean;
+    waiting: integer;
+    JumpStrength: single;
+    procedure OnInit; override;
+    procedure OnDraw; override;
+    procedure OnTimer; override;
+    constructor Create(ATexture: IBGLTexture; AContext: TGameContext);
+    destructor Destroy; override;
+  end;
+
+  { TSmallTux }
+
+  TSmallTux = class(TTux)
+    procedure OnInit; override;
+    procedure OnTimer; override;
+  end;
+
+  { TGround }
+
+  TGround = class(TBGLSprite)
+    constructor Create(ATexture: IBGLTexture; AX,AY: Single; AFrame: integer);
+    procedure OnInit; override;
+  end;
+
+var
+  ResourceDir : string;
+
+implementation
+
+uses LCLType;
+
+{ TTextBubble }
+
+constructor TTextBubble.Create(AText: string; AFont: IBGLFont);
+begin
+  FText := AText;
+  FFont := AFont;
+end;
+
+procedure TTextBubble.Draw(AXCenter, AYBottom: single);
+const horizMargin = 6; vertMargin = 4;
+var tw,x,y,tx,ty: integer;
+begin
+  tw := round(FFont.TextWidth(FText));
+  tx := tw+horizMargin*2;
+  ty := round(FFont.TextHeight(FText))+2*vertMargin;
+  x := round(AXCenter)-tx div 2;
+  y := round(AYBottom)-ty;
+  BGLCanvas.RoundRect(x,y,x+tx,y+ty,12,12,BGRABlack, BGRA(255,255,250));
+  FFont.SetGradientColors(CSSBlack,CSSBlack,CSSDodgerBlue,CSSDodgerBlue);
+  FFont.TextOut(x+horizMargin,y+vertMargin,FText, taLeftJustify, tlTop, BGRABlack);
+  FFont.GradientColors := false;
+end;
+
+{ TSmallTux }
+
+procedure TSmallTux.OnInit;
+begin
+  inherited OnInit;
+  Autoplay:= true;
+  H := H*0.75;
+  W := W*0.75;
+  LookingLeft := true;
+  Bubble := TTextBubble.Create('Where are my parents?',Context.bubbleFont);
+  BubbleTooFar := TTextBubble.Create('Please stay close to me!',Context.bubbleFont);
+  //JumpStrength := 4;
+end;
+
+procedure TSmallTux.OnTimer;
+begin
+  inherited OnTimer;
+  if Parent = nil then
+  begin
+    if sqr(X-Context.tux.X)+sqr(Y-Context.tux.Y) < sqr(50) then
+    begin
+      Parent := Context.tux;
+      FreeAndNil(Bubble);
+      Bubble := TTextBubble.Create('Hey my parent!',Context.bubbleFont);
+      BubbleTime := 400;
+    end;
+  end;
+end;
+
+{ TGameContext }
+
+constructor TGameContext.Create(ACenterOnSmallTux: boolean);
+begin
+  LeftKey := false;
+  RightKey := false;
+  UpKey := false;
+  TexturesLoaded:= false;
+  CenterOnSmallTux:= ACenterOnSmallTux;
+  infoTextAnimTime := 0;
+end;
+
+destructor TGameContext.Destroy;
+begin
+  inherited Destroy;
+end;
+
+procedure TGameContext.LoadTextures({%H-}ctx: TBGLContext);
+var sunBmp: TBGLBitmap;
+begin
+  if TexturesLoaded then exit;
+  Randomize;
+  texWalking := BGLTexture(ResourceDir+'tux_walking.png');
+  texWalking.SetFrameSize(64,64);
+
+  texGround := BGLTexture(ResourceDir+'ground.png');
+  texGround.SetFrameSize(32,32);
+
+  font := BGLFont('Arial', 20, CSSLightYellow,CSSBlack, [fsBold]);
+  bubbleFont := BGLFont('Arial', 16);
+  bubbleFont.HorizontalAlign := taCenter;
+  bubbleFont.Justify:= true;
+  bubbleFont.Padding := RectF(10,10,10,10);
+
+  AddGround(32,128,200);
+  AddGround(400,128,200);
+  AddGround(200,250,200);
+  AddGround(-32,250,150);
+  AddGround(400,380,200);
+  AddGround(300,500,150);
+  AddGround(-32,600-32,800+64);
+
+  tux := TTux.Create(texWalking,self);
+  tux.Location := PointF(128,128);
+
+  smallTux := TSmallTux.Create(texWalking,self);
+  smallTux.Location := PointF(450,128);
+
+  sunBmp := TBGLBitmap.Create(100,100);
+  sunBmp.FillEllipseLinearColorAntialias(50,50,49,49,BGRA(255,255,random(100)),BGRA(255,random(200),0));
+  sun := sunBmp.MakeTextureAndFree;
+  TBGLSprite.Create(sun,-2).Location := PointF(random(200),0);
+
+  TexturesLoaded:= true;
+end;
+
+procedure TGameContext.Render(ctx: TBGLContext);
+const infoText = 'Welcome to this demo showing how to use BGRABitmap with OpenGL';
+var ofsX,ofsY,h: single;
+  r:TRectF;
+  alpha: byte;
+begin
+  ctx.Canvas.FillRectLinearColor(Rect(0,0,ctx.Width,ctx.Height),
+       CSSSkyBlue,CSSSkyBlue,MergeBGRA(CSSSkyBlue,CSSBlue),MergeBGRA(CSSSkyBlue,CSSBlue));
+
+  if CenterOnSmallTux then
+  begin
+    ofsX := smallTux.X;
+    ofsY := smallTux.Y;
+  end else
+  begin
+    ofsX := tux.X;
+    ofsY := tux.Y;
+  end;
+  ofsX -= ctx.Width div 2;
+  ofsY -= ctx.Height div 2;
+  if ofsX > 800-ctx.Width then ofsX := 800-ctx.Width;
+  if ofsY > 600-ctx.Height then ofsY := 600-ctx.Height;
+  if ofsX < 0 then ofsX := 0;
+  if ofsY < 0 then ofsY := 0;
+
+  ctx.Canvas.Translate(-ofsX,-ofsY);
+  ctx.Sprites.OnDraw;
+  ctx.Canvas.Translate(ofsX,ofsY);
+
+  if infoTextAnimTime <= 500 then
+    alpha := round(infoTextAnimTime*255/500)
+  else if infoTextAnimTime <= 3500 then
+    alpha := 255
+  else if infoTextAnimTime <= 4000 then
+    alpha := round((4000-infoTextAnimTime)*255/500)
+  else
+    alpha := 0;
+
+  if alpha <> 0 then
+  begin
+    h := bubbleFont.TextHeight(infoText, 300)+bubbleFont.Padding.Top+bubbleFont.Padding.Bottom+4;
+    if infoTextAnimTime <= 500 then
+      h := h*infoTextAnimTime/500;
+    r.Left := ctx.Width/2-150;
+    r.Right := r.Left + 300;
+    r.Top := ctx.Height/2-h/2;
+    r.Bottom := r.Top + h;
+    ctx.Canvas.FillRect(r, BGRA(0,0,0,alpha div 2));
+    bubbleFont.Clipped:= true;
+    bubbleFont.TextRect(r, infoText, BGRA(255,255,255,alpha));
+    bubbleFont.Clipped:= false;
+  end;
+
+  if FPS <> 0 then
+     font.TextOut(ctx.Width-5,0,inttostr(FPS)+' FPS',taRightJustify);
+end;
+
+procedure TGameContext.UnloadTextures(ctx: TBGLContext);
+begin
+  if TexturesLoaded then
+  begin
+    ctx.Sprites.Clear;
+    TexturesLoaded := false;
+  end;
+end;
+
+procedure TGameContext.AddGround(x, y, w: single);
+begin
+  TGround.Create(texGround,x,y,1);
+  x += 32;
+  w -= 32;
+  while w > 32 do
+  begin
+    TGround.Create(texGround,x,y,2);
+    x += 32;
+    w -= 32;
+  end;
+  TGround.Create(texGround,x,y,3);
+end;
+
+procedure TGameContext.Elapse(ctx: TBGLContext; ms: single);
+begin
+  infoTextAnimTime += ms;
+  elapsedMs += ms;
+  while elapsedMs > FrameDurationMs do
+  begin
+    ctx.Sprites.OnTimer;
+    elapsedMs -= FrameDurationMs;
+  end;
+end;
+
+function TGameContext.FindGround(x: single; var y: single): boolean;
+var
+  i: Integer;
+  s: TBGLSprite;
+  g: TGround;
+begin
+  for i := 0 to BGLSpriteEngine.Count-1 do
+  begin
+    s := BGLSpriteEngine.Sprite[i] as TBGLSprite;
+    if s is TGround then
+    begin
+      g := TGround(s);
+      if (x >= g.X-g.W/2) and (x <= g.X+g.W/2) then
+      begin
+        if (y >= g.Y-4) and (Y <= g.Y-4+16) then
+        begin
+          result := true;
+          y := g.Y-4;
+          exit;
+        end;
+      end;
+    end;
+  end;
+  result := false;
+end;
+
+procedure TGameContext.MouseDown(Button: TMouseButton; X, Y: integer);
+begin
+
+end;
+
+procedure TGameContext.MouseMove(X, Y: integer);
+begin
+
+end;
+
+procedure TGameContext.MouseUp(Button: TMouseButton);
+begin
+
+end;
+
+procedure TGameContext.KeyDown(var Key: Word; Shift: TShiftState);
+begin
+  If Key = VK_LEFT then begin LeftKey := true; Key := 0; end;
+  If Key = VK_RIGHT then begin RightKey := true; Key := 0; end;
+  If Key = VK_UP then begin UpKey := true; Key := 0; end;
+end;
+
+procedure TGameContext.KeyUp(var Key: Word; Shift: TShiftState);
+begin
+  If Key = VK_LEFT then begin LeftKey := false; Key := 0; end;
+  If Key = VK_RIGHT then begin RightKey := false; Key := 0; end;
+  If Key = VK_UP then begin UpKey := false; Key := 0; end;
+end;
+
+{ TGround }
+
+constructor TGround.Create(ATexture: IBGLTexture; AX, AY: Single;
+  AFrame: integer);
+begin
+  inherited Create(ATexture, -1);
+  Location := PointF(AX,AY+4);
+  Frame := AFrame;
+end;
+
+procedure TGround.OnInit;
+begin
+  HorizontalAlign := taCenter;
+  VerticalAlign := tlCenter;
+end;
+
+{ TTux }
+
+procedure TTux.OnInit;
+begin
+  HorizontalAlign := taCenter;
+  VerticalAlign := tlBottom;
+  Frame := 1;
+  Speed := PointF(0,0);
+  FrameLoopStart := 1;
+  FrameLoopEnd := 10;
+  LookingLeft:= false;
+  goRight:= false;
+  goLeft:= false;
+  goUp := false;
+  waiting := 0;
+  JumpStrength:= 5;
+  Parent := nil;
+  Autoplay:= false;
+end;
+
+procedure TTux.OnDraw;
+begin
+  if lookingLeft then Texture.ToggleFlipX;
+  inherited OnDraw;
+  if lookingLeft then Texture.ToggleFlipX;
+  if Bubble <> nil then
+  begin
+    if BubbleTime mod 500 > 400 then
+    begin
+      if ShowBubbleTooFar then
+        BubbleTooFar.Draw(x,y-H)
+      else
+        Bubble.Draw(x,y-H);
+    end;
+  end;
+end;
+
+procedure TTux.OnTimer;
+var curY: single;
+  nearParent: boolean;
+begin
+  if not OnTheGround then
+  begin
+    //jumping
+  end else
+  begin
+    nearParent:= false;
+    if Autoplay then
+    begin
+      if waiting > 0 then
+        dec(waiting)
+      else
+      begin
+        goRight:= false;
+        goLeft:= false;
+        goUp := false;
+        if Parent<> nil then
+          nearParent := (abs(X-Parent.X) < 100) and (abs(Y-Parent.Y) < 150);
+
+        ShowBubbleTooFar := (Parent <> nil) and not nearParent;
+        if (Parent<> nil) and (abs(X-Parent.X) < 200) and (abs(Y-Parent.Y) < 200) then
+        begin
+          if BubbleTime > 500 then
+          begin
+            if not nearParent then
+              BubbleTime := 0
+            else
+              BubbleTime := 500;
+          end;
+          if (abs(X-Parent.X) > 40) then
+          begin
+            waiting := random(150);
+            if X > Parent.X then goLeft := true
+            else goRight := true;
+          end else
+          if (Parent.Y < Y-40) and (Parent.Y > Y-200) then
+          begin
+            waiting := random(150);
+            goUp := true;
+            waiting := 0;
+          end;
+        end else
+        begin
+          waiting := random(300);
+          case random(10) of
+            0..2: goLeft:= true;
+            3..5: goRight:= true;
+            9: begin goUp:= true; waiting := 0; end;
+          end;
+        end;
+      end;
+      curY := Y+5;
+      if goLeft and (X < 1) then
+      begin
+        goLeft := false;
+        waiting:= 0;
+      end;
+      if goRight and (X > 799) then
+      begin
+        goRight := false;
+        waiting:= 0;
+      end;
+      if not nearParent then
+      begin
+        if goLeft and not Context.FindGround(X-20,curY) then
+        begin
+          goLeft:= false;
+          waiting:= 0;
+        end;
+        if goRight and not Context.FindGround(X+20,curY) then
+        begin
+          goRight:= false;
+          waiting := 0;
+        end;
+      end else
+      if (Parent <> nil) and (abs(X-Parent.X) < 5) then
+      begin
+        goLeft:= false;
+        goRight:= false;
+      end;
+    end else
+    begin
+      goRight:= Context.RightKey;
+      goLeft:= Context.LeftKey;
+      goUp := Context.UpKey;
+    end;
+    if not goRight and not goLeft and not goUp then
+    begin
+      speed.X := speed.X*0.9;
+      if abs(speed.X)<0.1 then speed.X := 0;
+    end else
+    begin
+      //on the ground and can move
+      if goRight then Speed.X += 0.1;
+      if Speed.X > 1.3 then Speed.X := 1.3;
+      if goLeft then Speed.X -= 0.1;
+      if Speed.X < -1.3 then Speed.X := -1.3;
+      if goUp then Speed.Y := -JumpStrength;
+
+      if (Speed.X < 0) and not LookingLeft and (round(Frame) = 1) then
+        lookingLeft:= true;
+      if (Speed.X > 0) and LookingLeft and (round(Frame) = 1) then
+        lookingLeft := false;
+    end;
+    if LookingLeft xor (Speed.X < 0) then
+      Frame := Frame-Speed.X*0.5
+    else
+      Frame := Frame+Speed.X*0.5;
+  end;
+
+  Speed.Y += 0.1;
+  Location := Location+Speed;
+  curY := Y;
+  OnTheGround:= Context.FindGround(X,curY);
+  if OnTheGround then Speed.Y := 0;
+  Y := curY;
+  if X < 0 then X := 0;
+  if X > 800 then X := 800;
+  inc(BubbleTime);
+end;
+
+constructor TTux.Create(ATexture: IBGLTexture; AContext: TGameContext);
+begin
+  Context := AContext;
+  inherited Create(ATexture, 0);
+end;
+
+destructor TTux.Destroy;
+begin
+  FreeAndNil(Bubble);
+  FreeAndNil(BubbleTooFar);
+  inherited Destroy;
+end;
+
+end.
+