little Tetris Game
-
- PureBasic Guru
- Posts: 16777133
- Joined: Tue Apr 22, 2003 7:42 pm
Restored from previous forum. Originally posted by freak.
Hi everyone.
I just coded a little Tetris Game for fun yesterday. I was curious, how small i could get it.
It is only 27.5 KB in size (including a 1Kb Icon)
If you want to play it, or look at the source, go here:
http://www.reelmediaproductions.com/pb/apps/Tetris.zip
Timo
Hi everyone.
I just coded a little Tetris Game for fun yesterday. I was curious, how small i could get it.
It is only 27.5 KB in size (including a 1Kb Icon)
If you want to play it, or look at the source, go here:
http://www.reelmediaproductions.com/pb/apps/Tetris.zip
Timo
-
- PureBasic Guru
- Posts: 16777133
- Joined: Tue Apr 22, 2003 7:42 pm
-
- PureBasic Guru
- Posts: 16777133
- Joined: Tue Apr 22, 2003 7:42 pm
-
- PureBasic Guru
- Posts: 16777133
- Joined: Tue Apr 22, 2003 7:42 pm
-
- PureBasic Guru
- Posts: 16777133
- Joined: Tue Apr 22, 2003 7:42 pm
-
- PureBasic Guru
- Posts: 16777133
- Joined: Tue Apr 22, 2003 7:42 pm
Restored from previous forum. Originally posted by freak.
Thanks for the nice words.
However, there was a small Bug hiding in it. The new Version is allready up at the Recource site, so just download the same Link again, to get the fixed one.
> Any chance of a networkable version?
Why not? (But not at 27 kb )
Timo
Thanks for the nice words.
However, there was a small Bug hiding in it. The new Version is allready up at the Recource site, so just download the same Link again, to get the fixed one.
> Any chance of a networkable version?
Why not? (But not at 27 kb )
Timo
-
- PureBasic Guru
- Posts: 16777133
- Joined: Tue Apr 22, 2003 7:42 pm
I made this code for the purepuch contest but I can't compile the instructions no more to respect the rules of the contest : 10 lines max.
So, the code of this simple Tetris game contains only 19 complete lines (80 chars per line)
I saw the size of the executable 18.4KB
So, the code of this simple Tetris game contains only 19 complete lines (80 chars per line)
I saw the size of the executable 18.4KB
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;#########################
- Fluid Byte
- Addict
- Posts: 2336
- Joined: Fri Jul 21, 2006 4:41 am
- Location: Berlin, Germany
The post is from 2003 ...gabriel wrote:link is dead, can you refresh
Besides, use your brain and check the link. The website still exists!
Windows 10 Pro, 64-Bit / Whose Hoff is it anyway?
Ollivier's code is cool
but I can't make sense of it
, so I coded my own tetris game from scratch. Tetris still rocks.
Download tetris.zip
Sourcecode (note : you need the media files to run this program) :
This program won't even be applicable in a PurePunch contest but atleast it's readable 



Download tetris.zip
Sourcecode (note : you need the media files to run this program) :
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

-
- New User
- Posts: 8
- Joined: Thu Feb 23, 2012 1:06 pm
Re:
Oliver, this is just SO AWESOME!Ollivier wrote:I made this code for the purepuch contest but I can't compile the instructions no more to respect the rules of the contest : 10 lines max.
So, the code of this simple Tetris game contains only 19 complete lines (80 chars per line)
I saw the size of the executable 18.4KBCode: 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;#########################
I can hardly believe it! Amazing! Do you share this code as opensource?