unit unit1;
{$mode delphi}
interface
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Classes, SysUtils, AndroidWidget,
Laz_And_GLESv2_Canvas, Laz_And_GLESv2_Canvas_h, Laz_And_Controls;
type
{ TAndroidModule1 }
TAndroidModule1 = class(jForm)
CanvasES21: jCanvasES2;
Timer1: jTimer;
procedure AndroidModule1JNIPrompt(Sender: TObject);
procedure CanvasES21GLCreate(Sender: TObject);
procedure CanvasES21GLDown(Sender: TObject; Touch: TMouch);
procedure CanvasES21GLDraw(Sender: TObject);
procedure CanvasES21GLUp(Sender: TObject; Touch: TMouch);
procedure Timer1Timer(Sender: TObject);
private
{private declarations}
public
{public declarations}
procedure DeployBuffer(B: PDWord; T: TxgElement; W, H: Integer);
procedure DrawTexture(T: TxgElement; A, x1, y1, x0, y0: Single);
end;
{ TMyOwnPrimitives }
TMyOwnPrimitives = class
private
Data: PDWord;
Len: Integer;
Alpha: DWord;
Color: DWord;
AlphaMater: Single;
PencilColor: DWord;
BackgroundColor: DWord;
W,H,X: Integer;
Texture: TxgElement;
TheDimensionsHaveChanged: Boolean;
public
constructor Create; virtual;
procedure Update; virtual;
procedure UpdateColor; virtual;
procedure UpdateDimensions(NewWidth, NewHeight: Integer); virtual;
procedure SetTheBufferUp;
procedure SetPencilColor(NewColor: DWord);
procedure SetBackgroundColor(NewColor: Dword);
function GetWidth: Integer;
function GetHeight: Integer;
function GetBuffer: PDWord;
function GetAlpha: Single;
function GetTexture: TxgElement;
procedure MoveToInitialPoint;
procedure MoveTo(NewX, Newy: Integer);
procedure DrawHorizontal(Lenght: Integer);
procedure Clean;
end;
{ TChessBoard }
TChessBoard = class(TMyOwnPrimitives)
private
TotalSquaresByWidth: Integer;
TotalSquaresByHeight: Integer;
LenghtOfSquareSide: Integer;
DoubleSquareSize: Integer;
Mask: Integer;
Remainder: Integer;
public
constructor Create; override;
procedure Update; override;
procedure UpdateDimensions(Width, Height: Integer); override;
procedure SetSquareSize(SquareSize: Integer);
procedure DrawTwoSquareRows;
procedure DrawSquareRow;
procedure DrawLine; virtual;
procedure DrawTwoSquares;
procedure MoveToNextLine;
procedure WalkASquare;
procedure GoASquareBack;
end;
{ TGradiant }
TGradiant = class(TChessBoard)
private
Gradiant: DWord;
Numerator: Integer;
public
constructor Create; override;
procedure Update; override;
procedure UpdateColor; override;
procedure DrawLine; override;
procedure CalculateGradiant;
procedure DecrementGradianteAndNumerator;
end;
{ TFilledCircle }
TFilledCircle = class(TMyOwnPrimitives)
private
TheShorter: Integer;
MaximumRadius, Radius: Integer;
ClippedRadius: Integer;
Increment, InitialRadius: Integer;
Numerator: Integer;
public
constructor Create; override;
procedure Update; override;
procedure DrawExpandedCircle;
procedure DrawACircleWhereTheFingerTouches;
procedure UpdateRadius;
procedure DecreaseTheOpacity;
procedure DecreaseNumeratorAndAlpha;
function TheAlphaChannelIsTooLow: Boolean;
procedure ResetOpacityAndRadius;
procedure ResetRadius;
procedure SetBackGroundTransparent;
procedure SetPencilTransparent;
procedure GetClippedRadius;
function TheRadiusExceedsTheTopSide: Boolean;
function TheRadiusExceedsTheLeftSide: Boolean;
function TheRadiusExceedsTheBottomSide: Boolean;
function TheRadiusExceedsTheRightSide: Boolean;
procedure ClipTheTopSide;
procedure ClipTheLeftSide;
procedure ClipTheBottomSide;
procedure ClipTheRightSide;
procedure DrawFilledCircle(Radius: Integer);
procedure WhichIsShorterBetweenHAndW;
procedure CirclePoints(Cx, Cy: Integer); Virtual;
end;
{ TBanner }
TBanner = class(TMyOwnPrimitives)
private
Text: String;
T, Remainder: Integer;
public
constructor Create; override;
procedure Update; override;
procedure ResetTextIndex;
procedure DrawBanner;
procedure DrawBannerLine;
procedure NextBannerLine;
procedure PutTextPixel;
procedure NextTextPixel;
procedure CalculateRemainder;
end;
var
AndroidModule1: TAndroidModule1;
Layers: Array[0..3] of TMyOwnPrimitives;
isPressing: Boolean = False;
FingerX: Integer = 100;
FingerY: Integer = 100;
TextBanner: String =
' 00 00 00 0 00 '
+ '0000000 00 00000 00 00000 0 00 '
+ ' 0 00 0 00 00 0 00 '
+ ' 0 0000 0 0 0000 000000 00 0000 0 00 0000 0000 00000 0000 00000 00000 0000 0 0 00 00 0000 0 0000 00000 0 00 0000 00 00 0 00000 '
+ ' 0 00 00 0 0 00 00 0 00 00 00 00 00 00 00 00 00 00 00 00 0 00 00 00 00 00 0 0 00 00 0 00 00 00 0 000 0 00 00'
+ ' 0 0 00 0 0 0 00 0 000 00 00 0 0 0 0 0 00 00 0 00 00 00 00 00 0 00 00 0 0 0 00 00 0 00 0 000 00 0 00'
+ ' 0 0 00 0 0 0 00 0 00 00 0 000000 000000 0 00 00000 0 00 00 00 00000 00 0 00 00 0 000000 00 00 0 00000 00 0 0 00 0 00'
+ ' 0 0 00 0 0 0 00 0 0 00 0 0 0 0 00 00 00 0 00 00 00 00 00 0 0 00 00 0 0 00 00 0 00 00 000 000 0 00'
+ ' 0 00 00 00 00 00 00 0 0 00 0 00 00 0 00 0 00 0 00 0 00 0 00 00 0 00 0 0 00 0 00 0 0 00 00 000 0 00'
+ ' 0 0000 00000 0000 00 0 00000 0000 0 00000 00000 0 00 000000 0 00 00000 000000 00000 0 00 0000 0 00000 00000 0 00000 00 00 0 00';
const
FullyOpaque = $ff000000;
FullyTransparent = $00000000;
PartiallyTransparent = $80000000;
BlackColor = $00000000;
WhiteColor = $00bfbfbf;
GoldenBrown = $001e5b89;
PrussianBlue = $00543500;
Olivine = $0080c4b8;
PinkLavander = $00c1afdb;
FULLY_OPAQUE = 1.00;
PARTIALLY_TRANSPARENT = 0.25;
RightCorner = 1.00;
LeftCorner = -1.00;
TopCorner = 1.00;
DownCorner = -1.00;
Square32x32pixels = 5;
Square16x16pixels = 4;
Square64x64pixels = 6;
OneLevelOfTrransparency = $01000000;
EightLevelOfTrransparency = $08000000;
DifferentLevelsOfTransparency = 255;
Infinite = $7fffffff;
_120FPS = 8;
_60FPS = 17;
_50FPS = 20;
_30FPS = 33;
_25FPS = 40;
HeightBanner = 10;
WidthBanner = 196;
implementation
{$R *.lfm}
{ TAndroidModule1 }
procedure TAndroidModule1.Timer1Timer(Sender: TObject);
begin
CanvasES21.Refresh;
end;
procedure TAndroidModule1.AndroidModule1JNIPrompt(Sender: TObject);
var i: Integer;
begin
Layers[0]:= TChessBoard.Create;
Layers[1]:= TGradiant.Create;
Layers[2]:= TBanner.Create;
Layers[3]:= TFilledCircle.Create;
for i:= 0 to High(Layers) do with Layers[i] do begin
UpdateDimensions(CanvasES21.GetWidth, CanvasES21.GetHeight);
SetTheBufferUp;
end;
Timer1.Interval:= _50FPS;
Timer1.Enabled:= True;
end;
procedure TAndroidModule1.CanvasES21GLCreate(Sender: TObject);
var i: Integer;
begin
CanvasES21.Shader_Compile('simon_Vert', 'simon_Frag');
CanvasES21.Shader_Link;
for i:= 0 to High(Layers) do glGenTextures(1, @Layers[i].Texture.ID);
end;
procedure TAndroidModule1.CanvasES21GLDown(Sender: TObject; Touch: TMouch);
begin
isPressing:= True;
FingerX:= round(Touch.Pt.X);
FingerY:= round(Touch.Pt.Y);
end;
procedure TAndroidModule1.CanvasES21GLDraw(Sender: TObject);
var i: Integer;
begin
CanvasES21.MVP:= cID4x4;
CanvasES21.SetMVP(CanvasES21.MVP);
CanvasES21.Screen_Setup(CanvasES21.GetWidth, CanvasES21.GetHeight);
for i:= 0 to High(Layers) do with Layers[i] do begin
UpdateDimensions(CanvasES21.GetWidth, CanvasES21.GetHeight);
Update;
DeployBuffer(GetBuffer, GetTexture, GetWidth, GetHeight);
DrawTexture(GetTexture, GetAlpha, RightCorner, TopCorner, LeftCorner, DownCorner);
end;
end;
procedure TAndroidModule1.CanvasES21GLUp(Sender: TObject; Touch: TMouch);
begin
isPressing:= False;
Touch.Pt.X:= Touch.Pt.X;
end;
procedure TAndroidModule1.DeployBuffer(B: PDWord; T: TxgElement; W, H: Integer);
begin
glDisable (GL_DEPTH_BUFFER_BIT);
glBindTexture (GL_TEXTURE_2D, T.ID);
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST);
glTexparameteri(GL_Texture_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE);
glTexparameteri(GL_Texture_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE);
glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, W, H, 0, GL_RGBA, GL_UNSIGNED_BYTE, B);
end;
procedure TAndroidModule1.DrawTexture(T: TxgElement; A, x1, y1, x0, y0: Single);
begin
CanvasES21.DrawTexture(T, _xy4CW(x1,y0, x0,y0, x0,y1, x1,y1), 0, A);
end;
{ TMyOwnPrimitives }
constructor TMyOwnPrimitives.Create;
begin
Data:= Nil;
Len:=0;
W:= 0; H:=0; X:=0;
Alpha:= FullyOpaque;
AlphaMater:= FULLY_OPAQUE;
SetBackgroundColor(BlackColor);
TheDimensionsHaveChanged:= True;
end;
procedure TMyOwnPrimitives.Update;
begin
end;
procedure TMyOwnPrimitives.UpdateDimensions(NewWidth, NewHeight: Integer);
begin
TheDimensionsHaveChanged:= ((W xor NewWidth) or (H xor NewHeight)) <> 0;
W:= NewWidth; H:= NewHeight;
end;
procedure TMyOwnPrimitives.SetTheBufferUp;
begin
Len:= W*H;
GetMem(Data, Len*SizeOf(DWord));
end;
procedure TMyOwnPrimitives.SetPencilColor(NewColor: DWord);
begin
PencilColor:= NewColor;
UpdateColor;
end;
procedure TMyOwnPrimitives.UpdateColor;
begin
Color:= PencilColor or Alpha;
end;
procedure TMyOwnPrimitives.SetBackgroundColor(NewColor: Dword);
begin
BackgroundColor:= NewColor or Alpha;
end;
function TMyOwnPrimitives.GetWidth: Integer;
begin
Result:= W;
end;
function TMyOwnPrimitives.GetHeight: Integer;
begin
Result:= H;
end;
function TMyOwnPrimitives.GetBuffer: PDWord;
begin
Result:= Data;
end;
function TMyOwnPrimitives.GetAlpha: Single;
begin
Result:= AlphaMater;
end;
function TMyOwnPrimitives.GetTexture: TxgElement;
begin
Result:= Texture;
end;
procedure TMyOwnPrimitives.MoveToInitialPoint;
begin
X:= 0;
end;
procedure TMyOwnPrimitives.MoveTo(NewX, Newy: Integer);
begin
X:= NewX + W*NewY;
end;
procedure TMyOwnPrimitives.DrawHorizontal(Lenght: Integer);
begin
FillDWord(Data[X], Lenght, Color);
Inc(X, Lenght);
end;
procedure TMyOwnPrimitives.Clean;
begin
FillDWord(Data^, Len, BackgroundColor);
end;
{ TChessBoard }
constructor TChessBoard.Create;
begin
inherited Create;
SetSquareSize(Square32x32pixels);
SetPencilColor(GoldenBrown);
end;
procedure TChessBoard.SetSquareSize(SquareSize: Integer);
begin
DoubleSquareSize:= SquareSize + 1;
LenghtOfSquareSide:= 1 shl SquareSize;
Mask:= (1 shl DoubleSquareSize) - 1;
end;
procedure TChessBoard.UpdateDimensions(Width, Height: Integer);
begin
inherited UpdateDimensions(Width, Height);
TotalSquaresByHeight:= H shr DoubleSquareSize;
TotalSquaresByWidth:= W shr DoubleSquareSize;
Remainder:= W and Mask;
end;
procedure TChessBoard.Update;
var i: Integer;
begin
Clean;
MoveToInitialPoint;
for i:= 1 to TotalSquaresByHeight do DrawTwoSquareRows;
end;
procedure TChessBoard.DrawTwoSquareRows;
begin
DrawSquareRow;
WalkASquare;
DrawSquareRow;
GoASquareBack;
end;
procedure TChessBoard.DrawSquareRow;
var i: Integer;
begin
for i:= 1 to LenghtOfSquareSide do DrawLine;
end;
procedure TChessBoard.DrawLine;
var i: Integer;
begin
for i:= 1 to TotalSquaresByWidth do DrawTwoSquares;
MoveToNextLine;
end;
procedure TChessBoard.DrawTwoSquares;
begin
DrawHorizontal(LenghtOfSquareSide);
WalkASquare;
end;
procedure TChessBoard.MoveToNextLine;
begin
Inc(X, Remainder);
end;
procedure TChessBoard.WalkASquare;
begin
Inc(X, LenghtOfSquareSide);
end;
procedure TChessBoard.GoASquareBack;
begin
Dec(X, LenghtOfSquareSide);
end;
{ TGradiant }
constructor TGradiant.Create;
begin
inherited Create;
SetPencilColor(PrussianBlue);
end;
procedure TGradiant.Update;
begin
Gradiant:= FullyOpaque;
inherited Update;
end;
procedure TGradiant.UpdateColor;
begin
Color:= PencilColor or (Gradiant);
end;
procedure TGradiant.DrawLine;
begin
CalculateGradiant;
UpdateColor;
inherited DrawLine;
end;
procedure TGradiant.CalculateGradiant;
begin
If Numerator > H then DecrementGradianteAndNumerator;
Inc(Numerator, DifferentLevelsOfTransparency);
end;
procedure TGradiant.DecrementGradianteAndNumerator;
begin
Dec(Gradiant, OneLevelOfTrransparency);
Dec(Numerator, H);
end;
{ TFilledCircle }
constructor TFilledCircle.Create;
begin
inherited Create;
ClippedRadius:= Infinite;
end;
procedure TFilledCircle.Update;
begin
UpdateRadius;
SetBackGroundTransparent;
if isPressing then DrawExpandedCircle
else ResetOpacityAndRadius;
end;
procedure TFilledCircle.DrawExpandedCircle;
begin
Inc(Radius, Increment);
GetClippedRadius;
if Radius > ClippedRadius then ResetOpacityAndRadius;
DrawACircleWhereTheFingerTouches;
DecreaseTheOpacity;
end;
procedure TFilledCircle.UpdateRadius;
begin
WhichIsShorterBetweenHAndW;
InitialRadius:= TheShorter shr 3;
MaximumRadius:= TheShorter shr 2 + InitialRadius;
Increment:= TheShorter shr 7;
end;
procedure TFilledCircle.DrawACircleWhereTheFingerTouches;
begin
MoveTo(FingerX, FingerY);
SetPencilColor(PinkLavander);
DrawFilledCircle(Radius);
end;
procedure TFilledCircle.DecreaseTheOpacity;
begin
while Numerator > InitialRadius do DecreaseNumeratorAndAlpha;
Inc(Numerator, InitialRadius);
end;
procedure TFilledCircle.DecreaseNumeratorAndAlpha;
begin
Dec(Numerator, InitialRadius);
if TheAlphaChannelIsTooLow then Alpha:= 0
else Dec(Alpha, EightLevelOfTrransparency);
end;
function TFilledCircle.TheAlphaChannelIsTooLow: Boolean;
begin
Result:= Alpha <= EightLevelOfTrransparency;
end;
procedure TFilledCircle.GetClippedRadius;
begin
ClippedRadius:= MaximumRadius;
if TheRadiusExceedsTheTopSide then ClipTheTopSide;
if TheRadiusExceedsTheLeftSide then ClipTheLeftSide;
if TheRadiusExceedsTheBottomSide then ClipTheBottomSide;
if TheRadiusExceedsTheRightSide then ClipTheRightSide;
end;
function TFilledCircle.TheRadiusExceedsTheTopSide: Boolean;
begin
Result:= FingerY < ClippedRadius;
end;
function TFilledCircle.TheRadiusExceedsTheLeftSide: Boolean;
begin
Result:= FingerX < ClippedRadius;
end;
function TFilledCircle.TheRadiusExceedsTheBottomSide: Boolean;
begin
Result:= (H - FingerY) < ClippedRadius;
end;
function TFilledCircle.TheRadiusExceedsTheRightSide: Boolean;
begin
Result:= (W - FingerX) < ClippedRadius;
end;
procedure TFilledCircle.ClipTheTopSide;
begin
ClippedRadius:= FingerY;
end;
procedure TFilledCircle.ClipTheLeftSide;
begin
ClippedRadius:= FingerX;
end;
procedure TFilledCircle.ClipTheBottomSide;
begin
ClippedRadius:= H - FingerY;
end;
procedure TFilledCircle.ClipTheRightSide;
begin
ClippedRadius:= W - FingerX;
end;
procedure TFilledCircle.ResetOpacityAndRadius;
begin
Alpha:= FullyOpaque;
Numerator:= DifferentLevelsOfTransparency;
ResetRadius;
end;
procedure TFilledCircle.ResetRadius;
begin
if InitialRadius > ClippedRadius then Radius:= ClippedRadius
else Radius:= InitialRadius;
end;
procedure TFilledCircle.WhichIsShorterBetweenHAndW;
begin
if W > H then TheShorter:= H
else TheShorter:= W;
end;
procedure TFilledCircle.SetBackGroundTransparent;
begin
BackgroundColor:= FullyTransparent;
Clean;
end;
procedure TFilledCircle.SetPencilTransparent;
begin
Color:= FullyTransparent;
end;
procedure TFilledCircle.DrawFilledCircle(Radius: Integer);
var
CircleX, CircleY, d, deltaE, deltaSE: Integer;
begin
CircleX:= 0;
CircleY:= Radius;
d:= 1 - Radius;
deltaE:= 3;
deltaSE:= 5 -(Radius shl 1);
CirclePoints(CircleX, CircleY);
while CircleY > CircleX do begin
if d < 0 then begin
Inc(d, deltaE);
Inc(deltaE, 2);
Inc(deltaSE,2);
Inc(CircleX);
end else begin
Inc(d, deltaSE);
Inc(deltaE, 2);
Inc(deltaSE, 4);
Inc(CircleX);
Dec(CircleY);
end;
CirclePoints(CircleX, CircleY);
end;
end;
procedure TFilledCircle.CirclePoints(Cx, Cy: Integer);
var Wx, Wy: Integer;
begin
Wx:= W*Cx; Wy:= W*Cy;
FillDWord(Data[X-Cx+Wy], Cx shl 1, Color);
FillDWord(Data[X-Cx-Wy], Cx shl 1, Color);
FillDWord(Data[X-Cy+Wx], Cy shl 1, Color);
FillDWord(Data[X-Cy-Wx], Cy shl 1, Color);
end;
{ TBanner }
constructor TBanner.Create;
begin
inherited Create;
Text:= TextBanner;
SetPencilColor(WhiteColor);
BackgroundColor:= FullyTransparent;
end;
procedure TBanner.Update;
begin
Clean;
ResetTextIndex;
MoveTo(50, 50);
DrawBanner;
end;
procedure TBanner.ResetTextIndex;
begin
T:= 1;
end;
procedure TBanner.DrawBanner;
var i: Integer;
begin
CalculateRemainder;
for i:=1 to HeightBanner do DrawBannerLine;
end;
procedure TBanner.DrawBannerLine;
var i: Integer;
begin
for i:= 1 to WidthBanner do PutTextPixel;
NextBannerLine;
end;
procedure TBanner.PutTextPixel;
begin
if Text[T] = '0' then begin
Data[X]:= Color;
Data[X+1]:= Color;
Data[X+W]:= Color;
Data[X+W+1]:= Color;
end;
NextTextPixel;
end;
procedure TBanner.NextBannerLine;
begin
Inc(X, Remainder);
end;
procedure TBanner.NextTextPixel;
begin
Inc(T);
Inc(X, 2);
end;
procedure TBanner.CalculateRemainder;
begin
Remainder:= 3*W - 2*WidthBanner;
end;
end.
Recent
