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

   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

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

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

    end

   blks[m].row:=i; 

   blks[m].col:=j; 

  end

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

  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].rightor (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

  end 

else 

  begin 

   tmp:=begpos; 

   for i:=begpos+1 to endpos do 

    begin 

     if (snake[i].right<>snake[tmp].rightor (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

  end

end

 

function TGameBoard.IsHit:boolean; 

begin 

result:=false; 

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

  result:=true 

else if (rev=-1and (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

  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_ESCAPEand 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

  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

  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

  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

  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

  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

  end

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

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

   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 

end 

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

 

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