// Arkanoid test game engine. // developed for iPhone test samples // // Author: Dmitry 'skalogryz' Boyarintsev 2009 // // Arkanoid is an arcade game developed by Taito in 1986 // http://en.wikipedia.org/wiki/Arkanoid // // You're free to use this unit in anyway you want unit gameengine; {$mode objfpc}{$H+} interface uses Classes, SysUtils; const ballVelocity = 18; type TGameItem = record x, y : single; // coodinates dx, dy : single; // velocity vector sticked: Boolean; end; TBrick = record bounds : TRect; health : Integer; flash : Integer; end; { TArkanoid } TArkanoid = class(TObject) private fPaddleX : single; protected procedure BallMove(var move: TGameItem; atime: single); procedure ResetPaddle; procedure SetPaddleX(const AValue: single); public bricks : array [0..99] of TBrick; brickCount : Integer; balls : array [0..9] of TGameItem; ballcount : Integer; width : Integer; height : Integer; PaddleY : single; PaddleW : single; constructor Create(awidth, aheight: Integer); procedure InitBricks; procedure Init; procedure Move; function AnySticked: Boolean; procedure LaunchSticked; property PaddleX: single read fPaddleX write SetPaddleX; end; type TMoveRecord = packed record sx, sy : single; dx, dy : single; k : single; // y = kx + b divk : single; b : single; end; THitSide = (hs_LeftRight, hs_TopBottom); THitSides = set of THitSide; procedure InitMoveRecord(sx, sy, dx, dy: single; var r: TMoveRecord); function HitRect(const r: TRect; const mr: TMoveRecord; var hitpoint: TPoint; var HitSides: THitSides): Boolean; implementation { TArkanoid } procedure TArkanoid.SetPaddleX(const AValue: single); var dx : single; i : integer; begin dx := fPaddleX - AValue; for i := 0 to ballcount - 1 do begin if balls[i].sticked then balls[i].x:=balls[i].x-dx; end; fPaddleX := AValue; end; procedure InitMoveRecord(sx, sy, dx, dy: single; var r: TMoveRecord); var diff : single; begin r.sx:=sx; r.sy:=sy; r.dx:=dx; r.dy:=dy; diff:=dx-sx; if diff<>0 then begin r.k:=(dy-sy) / diff; if r.k<>0 then r.divk:=1/r.k else r.divk:=0; end else begin r.k:=0; r.divk:=0; end; r.b:=sy-sx*r.k; end; function InRange(p, r1,r2: Integer): Boolean; overload; inline; begin if r1=r1) and (p=r2) and (p=r1) and (p=r2) and (p= Top) and (ch < Bottom); if hitside then begin hitpoint:=Point(c, ch); Include(HitSides, hs_LeftRight) end; if sy<=dy then begin c:=Top end else begin c:=Bottom; end; if k <> 0 then ch:=Round((c-b)/k) else ch:=Round(sx); hittop:=inRange(c, sy, dy) and (ch>=Left) and (ch width then begin cx := width; dx := -dx; end; p.x := Round(x); p.y := Round(y); hitidx:=-1; hitlen:=0; for i := 0 to brickCount - 1 do begin if (bricks[i].health > 0) and HitRect(bricks[i].bounds, mr, hpnt, hsides) then begin hlen:=SqrLen(hpnt, p); if (hitidx<0) or (hlen=0 then begin if hs_TopBottom in hitsides then move.dy:=-move.dy; if hs_LeftRight in hitsides then move.dx:=-move.dx; bricks[hitidx].flash:=2; cx:=hitpnt.x; cy:=hitpnt.y; dec(bricks[hitidx].health); end; br:=Bounds( Round(PaddleX), Round(PaddleY), Round(PaddleW), 2); if HitRect(br, mr, hpnt, hsides) then begin t := (hpnt.x - PaddleX) / PaddleW; t:=pi*(1-(t*0.8+0.1)); dx := cos(t)*ballVelocity; dy := -sin(t)*ballVelocity; cy := hpnt.y; cx := hpnt.x; end else if cy > height then begin ResetPaddle; Exit; end; x:=cx; y:=cy; end; end; procedure TArkanoid.ResetPaddle; var i : integer; a : single; begin PaddleW := width / 5; PaddleY := height - 10; fPaddleX := width / 2 - PaddleW / 2; ballcount := 1; for i := 0 to ballcount - 1 do with Balls[i] do begin x := PaddleX+PaddleW/2; y := PaddleY-5; a := random*pi/4 + (pi/2 - pi/8); if cos(a)*5 < 0.1 then a := a + pi/5; dx := ballVelocity*cos(a); dy := ballVelocity*sin(a); sticked:=true; end; end; constructor TArkanoid.Create(awidth, aheight: Integer); begin width := awidth; height := aheight; end; procedure TArkanoid.InitBricks; var i : Integer; x, y : integer; begin brickCount := 8*8; for i := 0 to brickCount - 1 do begin x := (i mod 8) * 40; y := (i div 8) * 20 + 40; bricks[i].bounds:=Bounds(x,y,40,20); end; for i:=0 to brickCount - 1 do begin bricks[i].health := random(4)+1; bricks[i].flash:=0; end; end; procedure TArkanoid.Init; begin InitBricks; ResetPaddle; end; procedure TArkanoid.Move; var i : Integer; const time : single = 1; begin for i := 0 to ballcount - 1 do BallMove(balls[i], time); end; function TArkanoid.AnySticked: Boolean; var i : Integer; begin Result := false; for i := 0 to ballcount - 1 do if balls[i].sticked then begin Result:=true; exit; end; end; procedure TArkanoid.LaunchSticked; var i : integer; begin for i := 0 to ballcount - 1 do if balls[i].sticked then begin balls[i].sticked:=false; if balls[i].dy > 0 then balls[i].dy := - balls[i].dy; end; end; end.