PureBasic Forums - English

Code: Select all

Macro BL(X):For I=0 To 3:X:Next:EndMacro:Dim G(14,28):Dim G2(14,28):Dim C(1);##
Macro IT:X+PX(PC,I,Rt),Y+PY(PC,I,Rt):EndMacro:Dim PX(6,3,3):Dim PY(6,3,3);#####
Macro F(X,Y):For X=0 To Y:EndMacro:Macro N:Next:EndMacro:Macro Q:EndIf:EndMacro
F(I,28):G(1,I)=1:G(13,I)=1:G(I%13,27)=1:N:F(Pe,6):eC=0:F(Eg,1):F(PL,3);########
If Val("$"+Mid("33F06336747172",2*Pe+1+Eg,1))&(1<<PL):F(Ag,3):Y=1-PL:A=1.57*Ag;
C=Cos(A):S=Sin(A):PX(Pe,eC,Ag)=C*Eg-S*Y:PY(Pe,eC,Ag)=S*Eg+C*Y:N:eC+1:Q:N:N:N;##
Macro K0:AddKeyboardShortcut:EndMacro:OpenWindow(0,0,0,208,432,"",$CF0001);####
K0(0,37,10):K0(0,40,32):K0(0,39,12):K0(0,38,16):X=7:Y=2:D=1000:C(0)=$FFFFFF;###
C(1)=$1:Ok=1:Repeat:Delay(1):Et=WindowEvent():StartDrawing(WindowOutput(0));###
F(A,28):F(B,14):Box(B*16-16,(A-1)*16,16,16,C(G(B,A)|G2(B,A))):N:N:StopDrawing()
If Ok:BL(G2(IT)=0):MN=0:If Et=13101:MN=EventMenu():If MN=32:CH!1:Q:Q;#######
EL=ElapsedMilliseconds():If EL>T Or CH:T=EL+D:Y+1:Q:CA=0:F(I,3):If G(IT):CA=1:Q
N:If CA:Y-1:CH=0:MN=0:BL(G(IT)=1):X=7:Y=2:SC+1:If D>100:D-10:Q:DY=0;###########
For Y3=26 To 0 Step -1:CM=1:For X3=1 To 12:If G(X3,Y3)=0:CM=0:Q;###############
G(X3,Y3+DY)=G(X3,Y3):N:If CM:DY+1:Q:If Y3-DY<=0:Break:Q:N:SC+(DY*(DY+1));######
SetWindowTitle(0,Str(SC)):PC=Random(6):Rt=Random(3):Ok=1:F(I,3):If G(IT):Ok=0:Q
N:Else:BL(G2(IT)=1):Q:BL(G2(IT)=0):NS=0:If MN&8:NS=MN-11:Q:If NS:X+NS:Q:C0=0;##
F(I,3):If G(IT):C0=1:Q:N:If C0:X-NS:Q:If MN&16:Rt+1:Rt&3:Q:C3=0:F(I,3):If G(IT)
C3=1:Q:N:If C3:Rt-1:Rt&3:Q:BL(G2(IT)=1):Q:Until Et=16;#########################

Code: Select all

InitKeyboard() : InitSprite() : InitSound()

win_id1 = OpenWindow(#PB_Any,#PB_Default,#PB_Default,176,352,"Tetris example",#PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_MaximizeGadget|#PB_Window_ScreenCentered)
screen_id1 = OpenWindowedScreen(WindowID(win_id1),0,0,176,352,0,0,0)
gadget_id1 = ImageGadget(#PB_Any,0,0,176,352,0) ;workaround for mouse

;load sounds
row_snd = LoadSound(#PB_Any,"applaus.wav") : fall_snd = LoadSound(#PB_Any,"click.wav")
dead_snd = LoadSound(#PB_Any,"glassbreak.wav") : level_snd = LoadSound(#PB_Any,"drip.wav")

;load wall images
wall_v_id = LoadSprite(#PB_Any,"wall_v.bmp") : wall_h_id = LoadSprite(#PB_Any,"wall_h.bmp") : wall_id = LoadSprite(#PB_Any,"wall.bmp")

;load tetris blocks
red_id = LoadSprite(#PB_Any,"red.bmp") : dblue_id = LoadSprite(#PB_Any,"blue.bmp") : green_id = LoadSprite(#PB_Any,"green.bmp")
lblue_id = LoadSprite(#PB_Any,"light_blue.bmp") :  orange_id = LoadSprite(#PB_Any,"orange.bmp")
purple_id = LoadSprite(#PB_Any,"purple.bmp") : yellow_id = LoadSprite(#PB_Any,"yellow.bmp") : black_id = LoadSprite(#PB_Any,"black.bmp")

;array <game_area> reflects the actual game area itself given a cell size of 16 with the total width being 176, and height being 352
;-2 = walls, -1 = empty space, 1 - 7 = fallen blocks. This array will be used for collision checking as well as row elimination
;1 = red, 2 = dblue, 3 = green, 4 = lblue, 5 = orange, 6 = purple, 7 = yellow. Grid cell size = 16. Center x = 80
;red block   dblue block  green block   lblue block   orange block    purple block    yellow block
;    [][]      [][]        [][][]         [][][]          [][]             []
;  [][]          [][]          []         []              [][]           [][][]        [][][][]
Global Dim game_area.i(11,22) : Global Dim block_sprites.i(8)
block_sprites(0) = black_id : block_sprites(1) = red_id : block_sprites(2) = dblue_id : block_sprites(3) = green_id
block_sprites(4) = lblue_id : block_sprites(5) = orange_id : block_sprites(6) = purple_id : block_sprites(7) = yellow_id
For count1 = 0 To 21 Step 1
 For count2 = 0 To 10 Step 1
  If count2 = 0 Or count2 = 10 : game_area(count2,count1) = -2 : EndIf
  If count2 > 0 And count2 < 10 : game_area(count2,count1) = 0 : EndIf : If count1 = 21 : game_area(count2,count1) = -2 : EndIf
 Next count2
Next count1

;<blocks> array will hold the positions for blocks in any of the four directions for use in collision checking
Structure blocks_struc : positions.i[8] : EndStructure
Global Dim blocks.blocks_struc(7,4)
Restore CollisionData
For count1 = 0 To 6 Step 1
 For count2 = 0 To 3 Step 1
  With blocks(count1,count2)
   For count3 = 0 To 7 Step 1
    Read.i \positions[count3]
   Next count3
  EndWith
 Next count2
Next count1

;direction can range from 0-3 depending on the value of <active_block>
Global x, y, active_block, direction : x = 80 : y = 0 : active_block = 4 : direction = 0 : xprevious = x : yprevious = y

Procedure.i CheckCollision(check_x.i,check_y.i,check_direction.i)
collision = 0
 With blocks(active_block - 1,check_direction)
  For count1 = 0 To 7 Step 2
   temp_x = check_x / 16 + \positions[count1] : temp_y = check_y / 16 + \positions[count1+1]
   If temp_y > 21 Or temp_y < 0 Or temp_x > 10 Or temp_y < 0 : ProcedureReturn -1 : EndIf ;exception handler for array out of bounds reference
   If game_area(temp_x,temp_y) = 0 : collision + 1 : EndIf
  Next count1
 EndWith
 If collision = 4 : ProcedureReturn 0 : Else : ProcedureReturn 1 : EndIf
EndProcedure

timer1 = ElapsedMilliseconds() : timer2 = timer1 : timer_delay = 500 : score = 0 : game_end = 0
keytimer1 = ElapsedMilliseconds() : keytimer2 = keytimer1 : keytimer_delay = 60

Repeat
 event = WindowEvent()
 
 ExamineKeyboard() : ClearScreen(RGB(192,192,192))
 
 timer2 = ElapsedMilliseconds() : If timer2 - timer1 >= timer_delay : timer1 = timer2 : y + 16 : EndIf
 keytimer2 = ElapsedMilliseconds()
 
 If active_block > 0
  If KeyboardReleased(#PB_Key_Up) = 1 ;rotate falling blocks
   direction + 1 : If direction > 3 : direction = 0 : EndIf
   If CheckCollision(x,y,direction) = 1 : direction - 1 : EndIf : If direction < 0 : direction = 3 : EndIf
  EndIf
  If keytimer2 - keytimer1 >= keytimer_delay
   If KeyboardPushed(#PB_Key_Down) : If CheckCollision(x,y+16,direction) = 0 : y + 16 : EndIf : EndIf
   If KeyboardPushed(#PB_Key_Right) : If CheckCollision(x+16,y,direction) = 0 : x + 16 : EndIf : EndIf
   If KeyboardPushed(#PB_Key_Left) : If CheckCollision(x-16,y,direction) = 0 : x - 16 : EndIf : EndIf
   keytimer1 = keytimer2
  EndIf  
  With blocks(active_block - 1,direction) ;draw falling blocks
   For count1 = 0 To 7 Step 2
    temp_x = x + \positions[count1] * 16 : temp_y = y + \positions[count1+1] * 16
    DisplaySprite(block_sprites(active_block),temp_x,temp_y)
   Next count1
  EndWith
  If CheckCollision(x,y,direction) = 1 ;turn falling blocks into fallen blocks
   y - 16 : lowest_line = 0
   With blocks(active_block - 1,direction)
    For count1 = 0 To 7 Step 2
     temp_x = x / 16 + \positions[count1] : temp_y = y / 16 + \positions[count1+1]
     If temp_y > lowest_line : lowest_line = temp_y : EndIf ;<lowest_line> is needed for eliminating rows later on
     If temp_y < 0 : game_end = 1 : PlaySound(dead_snd) : EndIf ;game over
     If temp_y >= 0 : game_area(temp_x,temp_y) = active_block : EndIf
    Next count1 : PlaySound(fall_snd)
   EndWith   
   active_block = -1
  EndIf
 EndIf
 
 If game_end = 0 And active_block = -1 ;eliminate any rows then generate new random falling block
  rows = 0
  For count1 = lowest_line To 0 Step -1
   blocks = 0 : For count2 = 1 To 9 Step 1 : If game_area(count2,lowest_line) >= 1 : blocks + 1 : EndIf : Next count2
   If blocks = 9 ;eliminate that row and shift all rows above down one line
    score + 10 : rows + 1 : For count2 = 1 To 9 Step 1 : game_area(count2,lowest_line) = -1 : Next count2
    For count2 = 1 To 9 Step 1
     For count3 = lowest_line To 1 Step -1
      temp = game_area(count2,count3 - 1) : game_area(count2,count3) = temp
     Next count3
    Next count2
   Else
    lowest_line - 1
   EndIf
  Next count1
  If rows > 0 : PlaySound(row_snd) : EndIf
  x = 80 : y = 0 : direction = 0 : active_block = Random(6)+1
  If score >= 100 : score = 0 : timer_delay - 50 : PlaySound(level_snd) : EndIf : If timer_delay < 150 : timer_delay = 150 : EndIf ;fall faster
 EndIf
 
 If game_end = 1 ;restart game
  MessageRequester("","Game Over") : x = 80 : y = 0 : direction = 0 : active_block = Random(6)+1 : score = 0
  timer1 = ElapsedMilliseconds() : timer2 = timer1 : timer_delay = 500 : score = 0 : game_end = 0
  For count1 = 0 To 21 Step 1
   For count2 = 0 To 10 Step 1
    If count2 = 0 Or count2 = 10 : game_area(count2,count1) = -2 : EndIf
    If count2 > 0 And count2 < 10 : game_area(count2,count1) = 0 : EndIf : If count1 = 21 : game_area(count2,count1) = -2 : EndIf
   Next count2
  Next count1
 EndIf
 
 ;draw fallen blocks
 For count1 = 1 To 9 Step 1
  For count2 = 0 To 20 Step 1
   If game_area(count1,count2) > 0 : DisplaySprite(block_sprites(game_area(count1,count2)),count1 * 16,count2 * 16) : EndIf
  Next count2
 Next count1
 
 ;draw walls around game area
 For count1 = 0 To 320 Step 16 : DisplaySprite(wall_v_id,0,count1) : DisplaySprite(wall_v_id,160,count1) : Next count1
 For count1 = 16 To 144 Step 16 : DisplaySprite(wall_h_id,count1,336) : Next count1
 DisplaySprite(wall_id,0,336) : DisplaySprite(wall_id,160,336)
 
 FlipBuffers()
 
Until KeyboardPushed(#PB_Key_Escape) Or event = #PB_Event_CloseWindow

DataSection
 CollisionData:
 Data.i 0, 0,-1, 0, 0,-1, 1,-1, 0, 0, 0,-1, 1, 0, 1, 1, 0, 0,-1, 0, 0,-1, 1,-1, 0, 0, 0,-1, 1, 0, 1, 1 ;red block = 1 
 Data.i 0, 0, 1, 0, 0,-1,-1,-1, 0, 0, 0, 1, 1, 0, 1,-1, 0, 0, 1, 0, 0,-1,-1,-1, 0, 0, 0, 1, 1, 0, 1,-1 ;dblue block = 2 
 Data.i 0, 0,-1, 0, 1, 0, 1, 1, 0, 0, 0,-1, 0, 1,-1, 1, 0, 0,-1, 0, 1, 0,-1,-1, 0, 0, 0,-1, 0, 1, 1,-1 ;green block = 3
 Data.i 0, 0, 1, 0,-1, 0,-1, 1, 0, 0, 0, 1, 0,-1,-1,-1, 0, 0, 1, 0,-1, 0, 1,-1, 0, 0, 0,-1, 0, 1, 1, 1 ;lblue block = 4
 Data.i 0, 0,-1, 0,-1,-1, 0,-1, 0, 0,-1, 0,-1,-1, 0,-1, 0, 0,-1, 0,-1,-1, 0,-1, 0, 0,-1, 0,-1,-1, 0,-1 ;orange block = 5 
 Data.i 0, 0, 1, 0,-1, 0, 0,-1, 0, 0, 0,-1, 0, 1, 1, 0, 0, 0, 0, 1,-1, 0, 1, 0, 0, 0, 0,-1, 0, 1,-1, 0 ;purple block = 6
 Data.i 0, 0, 1, 0,-1, 0,-2, 0, 0, 0, 0, 1, 0,-1, 0,-2, 0, 0, 1, 0,-1, 0,-2, 0, 0, 0, 0, 1, 0,-1, 0,-2 ;yellow block = 7
EndDataSection

End