Nibbles - joguinho completo

Top Previous Next

const

F_NIB:integer=2;

F_SNAKE:integer=4;

F_PREV:integer=8;

F_BLOCK:integer=16;

F_REDRAWCELL:integer=32;

colcnt:integer=39;

rowcnt:integer=30;

blkscr:integer=10;

var

GameBoard: TGameBoard;

implementation

{$R *.DFM}

procedure TGameBoard.Initialize(alife:integer=3;ascore:integer=0);

begin

zeromemory(@matrix,sizeof(matrix));

xoff:=gamegrid.left; yoff:=gamegrid.top;

cellsize:=gamegrid.width div colcnt;

ptime:=0; sklength:=5; nlength:=5; glength:=1;

begpos:=0; endpos:=sklength-1;

rev:=1; stop:=true;

blkcnt:=10; blkidx:=0;

paused:=false;

gscore:=ascore; scorelab.caption:=inttostr(gscore);

lives:=alife; lifelab.caption:=inttostr(lives);

end;

procedure TGameBoard.InitializeEngines;

begin

TextEngine:=TTextEngine.Create(gamegrid);

txtidx[0]:=TextEngine.AddText('Press Enter to begin',1);

txtidx[1]:=TextEngine.AddText('Paused',0);

txtidx[2]:=TextEngine.AddText('Game Over',0);

txtidx[3]:=TextEngine.AddText('Lost a life',0);

end;

procedure TGameBoard.InvalidateRects;

var

i,j:integer;

cliprect:trect;

begin

zeromemory(@cliprect,sizeof(Trect));

for i:=0 to rowcnt-1 do

for j:=0 to colcnt-1 do

begin

if matrix[i,j] and F_REDRAWCELL>0 then

begin

matrix[i,j]:=matrix[i,j] xor F_REDRAWCELL;

unionrect(cliprect,cliprect,cellrect(i,j));

end;

offsetrect(cliprect,xoff,yoff);

InvalidateRect(handle,@cliprect,false);

end;

function TGameBoard.CellRect(arow,acol:integer):Trect;

begin

with result do

begin

top:=cellsize*arow;

bottom:=cellsize*arow+cellsize;

left:=cellsize*acol;

right:=cellsize*acol+cellsize;

end;

procedure TGameBoard.Finalize;

begin

freeandnil(TextEngine);

end;

procedure TGameBoard.LoadMap;

var

i:integer;

begin

i:=5;

while i<=35 do

begin

matrix[15,i]:=F_BLOCK or F_REDRAWCELL;

i:=i+3;

end;

procedure TGameBoard.Clear;

begin

gamegrid.canvas.pen.color:=clblack;

gamegrid.canvas.brush.color:=clblack;

gamegrid.canvas.rectangle(gamegrid.clientrect);

end;

procedure TGameBoard.SetScore;

var

cval:longword;

begin

cval:=GetTickCount;

cval:=cval-gtime-ptime;

gscore:=gscore+max(round(blkscr*(1-cval/10000))*10,0);

Scorelab.caption:=inttostr(gscore);

gtime:=GetTickCount;

end;

procedure TGameBoard.InitializeBlocks;

var

m,n,i,j:integer;

begin

randomize;

for m:=0 to 9 do

begin

n:=random(colcnt*rowcnt);

i:=n div colcnt;

j:=n mod colcnt;

while(matrix[i,j] and 16>0) do

begin

j:=j+1;

if(j>=colcnt) then

begin

j:=0;

i:=i+1;

end;

blks[m].row:=i;

blks[m].col:=j;

end;

procedure TGameBoard.Grow;

begin

if nlength=sklength then

exit;

if rev=-1 then

begin

if sklength<90 then

begin

snake[sklength].down:=snake[endpos].down;

snake[sklength].right:=snake[endpos].right;

snake[sklength].row:=snake[sklength-1].row-snake[sklength-1].down;

snake[sklength].col:=snake[sklength-1].col-snake[sklength-1].right;

end;

end

else

begin

if sklength<90 then

begin

movememory(@snake[1],@snake,sklength*sizeof(TSnakeinfo));

snake[0].down:=snake[1].down;

snake[0].right:=snake[1].right;

snake[0].row:=snake[1].row-snake[1].down;

snake[0].col:=snake[1].col-snake[1].right;

end;

sklength:=sklength+1;

endpos:=sklength-1;

end;

procedure TGameBoard.ReverseSnake;

var

i,tmp:integer;

begin

rev:=-rev;

for i:=begpos to endpos do

begin

snake[i].right:=-snake[i].right;

snake[i].down:=-snake[i].down;

end;

if rev=1 then

begin

tmp:=endpos;

for i:=endpos-1 downto begpos do

begin

if (snake[i].right<>snake[tmp].right) or (snake[i].down<>snake[tmp].down) then

begin

snake[i].right:=snake[tmp].right;

snake[i].down:=snake[tmp].down;

tmp:=i-1;

end;

end

else

begin

tmp:=begpos;

for i:=begpos+1 to endpos do

begin

if (snake[i].right<>snake[tmp].right) or (snake[i].down<>snake[tmp].down) then

begin

snake[i].right:=snake[tmp].right;

snake[i].down:=snake[tmp].down;

tmp:=i+1;

end;

function TGameBoard.IsHit:boolean;

begin

result:=false;

if (rev=1) and (matrix[snake[endpos].row,snake[endpos].col] and (8 or 16) >0) then

result:=true

else if (rev=-1) and (matrix[snake[begpos].row,snake[begpos].col] and (8 or 16) >0) then

result:=true;

end;

procedure TGameBoard.Reset;

var

i,j:integer;

begin

if lives>0 then

Initialize(lives,gscore)

else

Initialize;

stop:=false;

clear;

for i:=-1 to 30 do

begin

matrix[i,39]:=16;

matrix[i,-1]:=16;

end;

for j:=-1 to 39 do

begin

matrix[-1,j]:=16;

matrix[30,j]:=16;

end;

for i:=0 to sklength-1 do

begin

snake[i].col:=i;

snake[i].row:=0;

snake[i].down:=0;

snake[i].right:=1;

end;

LoadMap;

InitializeBlocks;

matrix[blks[blkidx].row,blks[blkidx].col]:=matrix[blks[blkidx].row,blks[blkidx].col] or F_NIB or F_REDRAWCELL;

gtime:=GetTickCount;

end;

function TGameBoard.Move:integer;

var

i,curpos:integer;

begin

result:=0;

if stop=true then exit;

if rev=1 then

begin

prevpos.row:=snake[begpos].row;

prevpos.col:=snake[begpos].col;

curpos:=endpos;

end

else

begin

prevpos.row:=snake[endpos].row;

prevpos.col:=snake[endpos].col;

curpos:=begpos;

end;

matrix[prevpos.row,prevpos.col]:=matrix[prevpos.row,prevpos.col] and (not F_PREV) or F_REDRAWCELL;

if matrix[snake[curpos].row,snake[curpos].col] and F_NIB > 0 then

begin

nlength:=sklength+glength;

blkidx:=blkidx+1;

if blkidx=10 then

blkidx:=0;

matrix[snake[curpos].row,snake[curpos].col]:=matrix[snake[curpos].row,snake[curpos].col] xor F_NIB or

F_REDRAWCELL;

matrix[blks[blkidx].row,blks[blkidx].col]:=matrix[blks[blkidx].row,blks[blkidx].col] or F_NIB or F_REDRAWCELL;

SetScore;

end;

Grow;

for i:=begpos to endpos do

begin

snake[i].row:=snake[i].row+1*snake[i].down;

snake[i].col:=snake[i].col+1*snake[i].right;

matrix[snake[i].row,snake[i].col]:=matrix[snake[i].row,snake[i].col] or F_SNAKE or F_REDRAWCELL;

end;

if IsHit then

begin

stop:=true;

result:=-1;

exit;

end;

if rev=1 then

begin

for i:=begpos to endpos-1 do

begin

matrix[snake[i].row,snake[i].col]:=matrix[snake[i].row,snake[i].col] and (not F_PREV) or F_REDRAWCELL;

snake[i].right:=snake[i+1].right;

snake[i].down:=snake[i+1].down;

end;

end

else if rev=-1 then

begin

for i:=endpos downto begpos+1 do

begin

matrix[snake[i].row,snake[i].col]:=matrix[snake[i].row,snake[i].col] and (not F_PREV) or F_REDRAWCELL;

snake[i].right:=snake[i-1].right;

snake[i].down:=snake[i-1].down;

end;

InvalidateRects;

end;

procedure TGameBoard.FormKeyDown(Sender: TObject; var Key: Word;

Shift: TShiftState);

var

curpos:integer;

begin

if (key=VK_RETURN) and stop then

begin

TextEngine.ShowText(false);

StartGameLoop;

end;

if stop then exit;

pausech:=false;

if rev=1 then

curpos:=endpos

else

curpos:=begpos;

if (key=VK_ESCAPE) and not stop then

begin

pausech:=true;

paused:=not paused;

if paused then

begin

TextEngine.ShowText(true,txtidx[1]);

ptime:=gettickcount

end

else

begin

ptime:=gettickcount-ptime;

TextEngine.ShowText(false,txtidx[1]);

end;

if paused then

exit;

if key=VK_DOWN then

begin

if snake[curpos].down=-1 then

reversesnake

else

begin

snake[curpos].right:=0;

snake[curpos].down:=1;

end;

if key=VK_UP then

begin

if snake[curpos].down=1 then

reversesnake

else

begin

snake[curpos].right:=0;

snake[curpos].down:=-1;

end;

if key=VK_LEFT then

begin

if snake[curpos].right=1 then

reversesnake

else

begin

snake[curpos].right:=-1;

snake[curpos].down:=0;

end;

if key=VK_RIGHT then

begin

if snake[curpos].right=-1 then

reversesnake

else

begin

snake[curpos].right:=1;

snake[curpos].down:=0;

end;

key:=0;

end;

procedure TGameBoard.StartGameLoop;

var

stime:longword;

begin

reset;

stime:=GetTickCount;

while true do

begin

if (GetTickCount-stime)>20 then

begin

if not paused and (move=-1) then

begin

lives:=lives-1;

if lives>0 then

TextEngine.ShowText(true,txtidx[3])

else

TextEngine.ShowText(true,txtidx[2]);

TextEngine.ShowText(true,txtidx[0]);

lifelab.caption:=inttostr(lives);

break;

end;

application.ProcessMessages;

stime:=gettickcount;

end;

procedure TGameBoard.FormCloseQuery(Sender: TObject;

var CanClose: Boolean);

begin

if (not stop) or (lives>0) then

begin

if MessageBox(handle,'Do you want to quit the current game?','Quit game?',MB_YESNO)=ID_YES then

stop:=true

else

canclose:=false;

end;

procedure TGameBoard.FormClose(Sender: TObject; var Action: TCloseAction);

begin

Finalize;

end;

procedure TGameBoard.GameGridPaint(Sender: TObject);

var

i,j:integer;

t1:trect;

begin

for i:=0 to rowcnt-1 do

for j:=0 to colcnt-1 do

begin

t1:=CellRect(i,j);

if (i=prevpos.row) and (j=prevpos.col) then

begin

gamegrid.canvas.Brush.Color:=clblack;

gamegrid.canvas.fillrect(t1);

end;

if (matrix[i,j] and F_NIB>0) then

begin

gamegrid.canvas.Brush.Color:=clred;

gamegrid.canvas.pen.Color:=clwhite;

gamegrid.canvas.Rectangle(t1);

end;

if (matrix[i,j] and F_SNAKE>0) then

begin

gamegrid.canvas.Brush.Color:=clblue;

gamegrid.canvas.pen.Color:=clyellow;

gamegrid.canvas.Rectangle(t1);

matrix[i,j]:=(matrix[i,j] xor F_SNAKE) or F_PREV;

end;

if (paused or stop) and (matrix[i,j] and F_PREV >0) then

begin

gamegrid.canvas.Brush.Color:=clblue;

gamegrid.canvas.pen.Color:=clyellow;

gamegrid.canvas.Rectangle(t1);

end;

if (matrix[i,j] and F_BLOCK>0) then

begin

gamegrid.canvas.Brush.Color:=clgreen;

gamegrid.canvas.pen.Color:=clwhite;

gamegrid.canvas.Rectangle(t1);

end;

if paused or stop then

TextEngine.DrawText(gamegrid.canvas.cliprect,SRCPAINT);

end;

procedure TGameBoard.FormCreate(Sender: TObject);

begin

Initialize;

InitializeEngines;

TextEngine.ShowText(true,txtidx[0]);

end;

end.

-----------------------------DFM File------------------------

object GameBoard: TGameBoard

Left = 195

Top = 54

BorderIcons = [biSystemMenu]

BorderStyle = bsSingle

Caption = 'Nibbles'

ClientHeight = 416

ClientWidth = 497

Color = clBlack

Font.Charset = DEFAULT_CHARSET

Font.Color = clWindowText

Font.Height = -11

Font.Name = 'MS Sans Serif'

Font.Style = []

OldCreateOrder = False

OnClose = FormClose

OnCloseQuery = FormCloseQuery

OnCreate = FormCreate

OnKeyDown = FormKeyDown

PixelsPerInch = 96

TextHeight = 16

object Shape2: TShape

Left = 5

Top = 383

Width = 183

Height = 31

Brush.Color = clBlack

Pen.Color = 8454016

end

object Shape1: TShape

Left = 4

Top = 2

Width = 488

Height = 378

Brush.Style = bsClear

Pen.Color = 14383356

Pen.Width = 3

end

object Label1: TLabel

Left = 10

Top = 388

Width = 49

Height = 20

Caption = 'Score:'

Color = clBlack

Font.Charset = DEFAULT_CHARSET

Font.Color = clYellow

Font.Height = -16

Font.Name = 'MS Sans Serif'

Font.Style = []

ParentColor = False

ParentFont = False

end

object Scorelab: TLabel

Left = 66

Top = 386

Width = 119

Height = 21

AutoSize = False

Caption = '0'

Color = clBlack

Font.Charset = DEFAULT_CHARSET

Font.Color = clYellow

Font.Height = -20

Font.Name = 'MS Sans Serif'

Font.Style = [fsBold]

ParentColor = False

ParentFont = False

end

object GameGrid: TPaintBox

Left = 7

Top = 6

Width = 482

Height = 371

Color = clNone

ParentColor = False

OnPaint = GameGridPaint

end

object Shape3: TShape

Left = 310

Top = 383

Width = 184

Height = 31

Brush.Color = clBlack

Pen.Color = 8454016

end

object Label2: TLabel

Left = 315

Top = 388

Width = 45

Height = 20

Caption = 'Lives:'

Color = clBlack

Font.Charset = DEFAULT_CHARSET

Font.Color = clYellow

Font.Height = -16

Font.Name = 'MS Sans Serif'

Font.Style = []

ParentColor = False

ParentFont = False

end

object lifelab: TLabel

Left = 370

Top = 385

Width = 119

Height = 21

AutoSize = False

Caption = '0'

Color = clBlack

Font.Charset = DEFAULT_CHARSET

Font.Color = clYellow

Font.Height = -20

Font.Name = 'MS Sans Serif'

Font.Style = [fsBold]

ParentColor = False

ParentFont = False

end

-----------------------------------------------------

No levels are added to this game. It would be nice if some one added more levels to this game