Game Tetris

GAME TETRIS

Membuat game tetris dengan foxpro itu susah susah gampang. Tapi saya saranin coba aj dlu...
Langkah-langkah memuat game tetris ini sbb:

1. buka foxpro nya
2. buat project baru n kasi nama to project
3. liat project manager n klik tab code
4. copy kode yg d bwh ini k itu tmpat....

PUBLIC ff
ff = CreateObject('frm')
ff.visible = .T.
RETURN


#DEFINE tetris 4
#DEFINE c0 128 && color constant
#DEFINE c1 196 && color constant
#DEFINE sqee_width 20
#DEFINE sqee_height 20
#DEFINE bucketWidth 12
#DEFINE bucketHeight 24
#DEFINE dropInterval 200 && millisecond
#DEFINE keyLeft 19
#DEFINE keyRight 4
#DEFINE keyDrop 32
#DEFINE keyRotate 5

DEFINE CLASS sqee As Shape
Owner = 0 && (0)empty, (1)debris, all others - Figure.Mode
Width = sqee_width
Height = sqee_height
BorderColor = RGB (240,240,255)
BackColor = RGB(255,255,255)
ENDDEFINE

DEFINE CLASS figure As Custom
DIMEN arrX [tetris]
DIMEN arrY [tetris]
dY = 1
dX = 1
mode = 0
main = .F.
BackColor = 0
turned_counter = 0
turned_counter_dy = 0
turned_counter_dx = 0
turned_clockwise = 0
turned_clockwise_dy = 0
turned_clockwise_dx = 0

PROCEDURE init
THIS.BackColor = THIS.get_color()
THIS.after_init
ENDPROC

PROCEDURE assign_neighbours (tl, tly, tlx, tr, try, trx)
THIS.turned_counter = tl
THIS.turned_counter_dy = tly
THIS.turned_counter_dx = tlx
THIS.turned_clockwise = tr
THIS.turned_clockwise_dy = try
THIS.turned_clockwise_dx = trx
ENDPROC

PROCEDURE init_arr (y1,x1, y2,x2, y3,x3, y4,x4)
THIS.arrX [1] = x1
THIS.arrX [2] = x2
THIS.arrX [3] = x3
THIS.arrX [4] = x4
THIS.arrY [1] = y1
THIS.arrY [2] = y2
THIS.arrY [3] = y3
THIS.arrY [4] = y4
ENDPROC

PROCEDURE reset_figure
STORE 1 TO THIS.dY, THIS.dX
ENDPROC

FUNCTION get_color ()
DO CASE
CASE INLIST (THIS.mode, 1,11)
RETURN RGB (c1,c0,c0)
CASE THIS.mode = 2
RETURN RGB (c1,c1,c0)
CASE INLIST (THIS.mode, 3,31,32,33)
RETURN RGB (c1,c0,c1)
CASE INLIST (THIS.mode, 4,41)
RETURN RGB (c0,c1,c1)
CASE INLIST (THIS.mode, 5,51)
RETURN RGB (c0,c1,c0)
CASE INLIST (THIS.mode, 6,61,62,63)
RETURN RGB (c0,c0,c1)
CASE INLIST (THIS.mode, 7,71,72,73)
RETURN RGB (c0,c0,c0)
OTHER
RETURN RGB (c1,c1,c1)
ENDCASE
ENDFUNC

PROCEDURE set_state (numColor, numOwner)
LOCAL ii
FOR ii=1 TO tetris
WITH ThisForm.d.arr [ THIS.dY+THIS.arrY[ii], THIS.dX+THIS.arrX[ii] ]
.BackColor = numColor
.Owner = numOwner
ENDWITH
ENDFOR
ENDPROC

PROCEDURE set_visible
THIS.set_state (THIS.BackColor, THIS.mode)
ENDPROC

PROCEDURE set_free
THIS.set_state (THIS.Parent.BackColor, 0)
ENDPROC

PROCEDURE set_debris
THIS.set_state (THIS.BackColor, -1)
ENDPROC

PROCEDURE set_owner (numOwner)
LOCAL ii
FOR ii=1 TO tetris
WITH ThisForm.d.arr [ THIS.dY+THIS.arrY[ii], THIS.dX+THIS.arrX[ii] ]
.Owner = numOwner
ENDWITH
ENDFOR
ENDPROC

PROCEDURE conflict (dY,dX, allowedMode)
LOCAL ii
FOR ii=1 TO tetris
IF Not (BETW(dY+THIS.dY+THIS.arrY[ii], 1, bucketHeight);
And BETW(dX+THIS.dX+THIS.arrX[ii], 1, bucketWidth))
RETURN .T.
ENDIF

WITH ThisForm.d.arr [ dY+THIS.dY+THIS.arrY[ii], dX+THIS.dX+THIS.arrX[ii] ]
IF Not (.Owner=0 Or .Owner=THIS.mode Or .Owner=allowedMode)
RETURN .T.
ENDIF
ENDWITH
ENDFOR
RETURN .F.
ENDPROC

FUNCTION move_ (dY,dX)
IF THIS.Conflict (dY,dX,0)
RETURN .F.
ELSE
THIS.set_free
THIS.dY = THIS.dY + dY
THIS.dX = THIS.dX + dX
THIS.set_visible
RETURN .T.
ENDIF
ENDPROC

PROCEDURE move_down
RETURN THIS.move_ (1,0)
ENDPROC

PROCEDURE move_left
RETURN THIS.move_ (0,-1)
ENDPROC

PROCEDURE move_right
RETURN THIS.move_ (0,1)
ENDPROC
ENDDEFINE

DEFINE CLASS f1 As figure && vertical stick
mode = 1
main = .T.
PROCEDURE after_init
THIS.init_arr (0,0, 1,0, 2,0, 3,0)
THIS.assign_neighbours (11,2,-1, 11,2,-2)
ENDPROC
ENDDEFINE

DEFINE CLASS f11 As figure && horizontal stick
mode = 11
main = .F.
PROCEDURE after_init
THIS.init_arr (0,0, 0,1, 0,2, 0,3)
THIS.assign_neighbours (1,-2,1, 1,-2,2)
ENDPROC
ENDDEFINE

DEFINE CLASS f2 As figure && square
mode = 2
main = .T.
PROCEDURE after_init
THIS.init_arr (0,0, 0,1, 1,0, 1,1)
THIS.assign_neighbours (2,0,0, 2,0,0)
ENDPROC
ENDDEFINE

DEFINE CLASS f3 As figure && t-bone
mode = 3
main = .T.
PROCEDURE after_init
THIS.init_arr (0,0, 0,1, 0,2, 1,1)
THIS.assign_neighbours (32,0,0, 31,0,0)
ENDPROC
ENDDEFINE

DEFINE CLASS f31 As figure && t-bone rotated
mode = 31
main = .F.
PROCEDURE after_init
THIS.init_arr (0,0, 1,0, 2,0, 1,1)
THIS.assign_neighbours (3,0,0, 33,0,0)
ENDPROC
ENDDEFINE

DEFINE CLASS f32 As figure && t-bone rotated
mode = 32
main = .F.
PROCEDURE after_init
THIS.init_arr (0,1, 1,1, 2,1, 1,0)
THIS.assign_neighbours (33,0,0, 3,0,0)
ENDPROC
ENDDEFINE

DEFINE CLASS f33 As figure && t-bone rotated
mode = 33
main = .F.
PROCEDURE after_init
THIS.init_arr (1,0, 1,1, 1,2, 0,1)
THIS.assign_neighbours (31,0,0, 32,0,0)
ENDPROC
ENDDEFINE

DEFINE CLASS f4 As figure && zed1
mode = 4
main = .T.
PROCEDURE after_init
THIS.init_arr (0,0, 0,1, 1,1, 1,2)
THIS.assign_neighbours (41,0,0, 41,0,0)
ENDPROC
ENDDEFINE

DEFINE CLASS f41 As figure && zed1 rotated
mode = 41
main = .F.
PROCEDURE after_init
THIS.init_arr (2,0, 1,0, 1,1, 0,1)
THIS.assign_neighbours (4,0,0, 4,0,0)
ENDPROC
ENDDEFINE

DEFINE CLASS f5 As figure && zed2
mode = 5
main = .T.
PROCEDURE after_init
THIS.init_arr (1,0, 1,1, 0,1, 0,2)
THIS.assign_neighbours (51,0,0, 51,0,0)
ENDPROC
ENDDEFINE

DEFINE CLASS f51 As figure && zed2 rotated
mode = 51
main = .F.
PROCEDURE after_init
THIS.init_arr (0,0, 1,0, 1,1, 2,1)
THIS.assign_neighbours (5,0,0, 5,0,0)
ENDPROC
ENDDEFINE

DEFINE CLASS f6 As figure && scrap1
mode = 6
main = .T.
PROCEDURE after_init
THIS.init_arr (0,0, 1,0, 2,0, 0,1)
THIS.assign_neighbours (62,0,0, 61,0,0)
ENDPROC
ENDDEFINE

DEFINE CLASS f61 As figure && scrap1 rotated
mode = 61
main = .F.
PROCEDURE after_init
THIS.init_arr (1,0, 1,1, 1,2, 0,0)
THIS.assign_neighbours (6,0,0, 63,0,0)
ENDPROC
ENDDEFINE

DEFINE CLASS f62 As figure && scrap1 rotated
mode = 62
main = .F.
PROCEDURE after_init
THIS.init_arr (0,0, 0,1, 0,2, 1,2)
THIS.assign_neighbours (63,0,0, 6,0,0)
ENDPROC
ENDDEFINE

DEFINE CLASS f63 As figure && scrap1 rotated
mode = 63
main = .F.
PROCEDURE after_init
THIS.init_arr (0,1, 1,1, 2,1, 2,0)
THIS.assign_neighbours (61,0,0, 62,0,0)
ENDPROC
ENDDEFINE

DEFINE CLASS f7 As figure && scrap2
mode = 7
main = .T.
PROCEDURE after_init
THIS.init_arr (0,0, 0,1, 1,1, 2,1)
THIS.assign_neighbours (72,0,0, 71,0,0)
ENDPROC
ENDDEFINE

DEFINE CLASS f71 As figure && scrap2 rotated
mode = 71
main = .F.
PROCEDURE after_init
THIS.init_arr (0,0, 0,1, 0,2, 1,0)
THIS.assign_neighbours (7,0,0, 73,0,0)
ENDPROC
ENDDEFINE

DEFINE CLASS f72 As figure && scrap2 rotated
mode = 72
main = .F.
PROCEDURE after_init
THIS.init_arr (1,0, 1,1, 1,2, 0,2)
THIS.assign_neighbours (73,0,0, 7,0,0)
ENDPROC
ENDDEFINE

DEFINE CLASS f73 As figure && scrap2 rotated
mode = 73
main = .F.
PROCEDURE after_init
THIS.init_arr (0,0, 1,0, 2,0, 2,1)
THIS.assign_neighbours (71,0,0, 72,0,0)
ENDPROC
ENDDEFINE

DEFINE CLASS bucket As Container
max_mode = 7
current_mode = 0
BackColor = RGB(255,255,255)

DIMEN ff [100]
ADD OBJECT ff[ 1] As f1
ADD OBJECT ff[11] As f11
ADD OBJECT ff[ 2] As f2
ADD OBJECT ff[ 3] As f3
ADD OBJECT ff[31] As f31
ADD OBJECT ff[32] As f32
ADD OBJECT ff[33] As f33
ADD OBJECT ff[ 4] As f4
ADD OBJECT ff[41] As f41
ADD OBJECT ff[ 5] As f5
ADD OBJECT ff[51] As f51
ADD OBJECT ff[ 6] As f6
ADD OBJECT ff[61] As f61
ADD OBJECT ff[62] As f62
ADD OBJECT ff[63] As f63
ADD OBJECT ff[ 7] As f7
ADD OBJECT ff[71] As f71
ADD OBJECT ff[72] As f72
ADD OBJECT ff[73] As f73

arr_size = bucketWidth * bucketHeight
DIMEN arr [bucketHeight, bucketWidth]

PROCEDURE Init
THIS.AddSquees
THIS.Width = sqee_width * bucketWidth
THIS.Height = sqee_height * bucketHeight
ENDPROC

PROCEDURE AddSquees
LOCAL lnY, lnX, lcName
FOR lnY=1 TO bucketHeight
FOR lnX=1 TO bucketWidth
lcName = STRTRAN('arr'+STR(lnY,2) + '_' + STR(lnX,2), ' ','0')
THIS.AddObject (lcName, 'sqee')
THIS.arr [lnY,lnX] = EVAL('THIS.'+lcName)
WITH THIS.arr [lnY,lnX]
.left = (lnX-1) * sqee_width
.top = (lnY-1) * sqee_height
.Owner = 0
.visible = .T.
ENDWITH
ENDFOR
ENDFOR
ENDPROC

PROCEDURE RemoveSquees
LOCAL lnY, lnX, lcName
FOR lnY=1 TO bucketHeight
FOR lnX=1 TO bucketWidth
lcName = STRTRAN('arr'+STR(lnY,2) + '_' + STR(lnX,2), ' ','0')
THIS.RemoveObject (lcName)
ENDFOR
ENDFOR
ENDPROC

FUNCTION init_figure
THIS.current_mode = INT (RAND() * THIS.max_mode) + 1
IF NOT BETW(THIS.current_mode, 1,THIS.max_mode)
THIS.current_mode = 1
ENDIF
WITH THIS.ff [THIS.current_mode]
.reset_figure
IF .conflict (0,0,0)
RETURN .F.
ENDIF
.set_visible
ENDWITH
RETURN .T.
ENDFUNC

FUNCTION debris_line (num) && if there is at least one line of debris
LOCAL ii
FOR ii=1 TO bucketWidth
IF THIS.arr [num, ii].Owner <> -1
RETURN .F.
ENDIF
ENDFOR
RETURN .T.
ENDFUNC

FUNCTION find_debris_line
LOCAL jj
FOR jj=bucketHeight TO 1 STEP -1
IF THIS.debris_line (jj)
RETURN jj
ENDIF
ENDFOR
RETURN 0
ENDFUNC

PROCEDURE shake_debris
LOCAL num, jj, ii, savedColor
num = THIS.find_debris_line()
IF num = 0
RETURN
ENDIF

* release line
FOR ii=1 TO bucketWidth
THIS.arr[num, ii].Owner = 0
THIS.arr[num, ii].BackColor = THIS.BackColor
ENDFOR

* drop all other lines
FOR jj=num-1 TO 1 STEP -1
FOR ii=1 TO bucketWidth
IF THIS.arr[jj,ii].Owner = -1
savedColor = THIS.arr [jj, ii].BackColor
THIS.arr [jj, ii].BackColor = THIS.BackColor
THIS.arr [jj, ii].Owner = 0
THIS.arr [jj+1, ii].BackColor = savedColor
THIS.arr [jj+1, ii].Owner = -1
ENDIF
ENDFOR
ENDFOR
ENDPROC

PROCEDURE rotate_figure (newMode, dY,dX)
LOCAL obj
WITH THIS.ff [THIS.current_mode]
obj = THIS.ff [.turned_clockwise]
obj.dY = .dY + .turned_clockwise_dY
obj.dX = .dX + .turned_clockwise_dX
ENDWITH

IF Not obj.Conflict (0,0,THIS.current_mode)
THIS.ff [THIS.current_mode].set_free
THIS.current_mode = obj.mode
THIS.ff [THIS.current_mode].set_visible
RETURN .T.
ELSE
RETURN .F.
ENDIF
ENDPROC

PROCEDURE rotate
WITH THIS.ff [THIS.current_mode]
DO WHILE .T.
IF THIS.rotate_figure (.turned_clockwise, .turned_clockwise_dY, .turned_clockwise_dX)
EXIT
ELSE
IF Not .move_right()
EXIT
ENDIF
ENDIF
ENDDO
ENDWITH
ENDPROC

PROCEDURE rotate_counter_clockwise
WITH THIS.ff [THIS.current_mode]
THIS.rotate (.turned_counter, .turned_counter_dY, .turned_counter_dX)
ENDWITH
ENDPROC
ENDDEFINE

DEFINE CLASS frm As Form
Caption = 'Tetris'
MaxButton = .F.
BorderStyle = 2
KeyPreview = .T.
ADD OBJECT d As bucket
ADD OBJECT t As Timer

PROCEDURE Init
WITH THIS.d
STORE 0 TO .top, .left
THIS.Width = .Width
THIS.Height = .Height
ENDWITH
THIS.d.init_figure
THIS.t.Interval = dropInterval && setting speed
ENDPROC

PROCEDURE Destroy
THIS.d.RemoveSquees
ENDPROC

PROCEDURE KeyPress
LPARAMETERS nKeyCode, nShiftAltCtrl
DO CASE
CASE nKeyCode=27
THIS.release
CASE nKeyCode=keyLeft
THIS.d.ff [THIS.d.current_mode].move_left
CASE nKeyCode=keyRight
THIS.d.ff [THIS.d.current_mode].move_right
CASE nKeyCode=keyDrop
DO WHILE THIS.d.ff [THIS.d.current_mode].move_down()
ENDDO
CASE nKeyCode=keyRotate
THIS.d.rotate
ENDCASE
ENDPROC

PROCEDURE t.Timer
LOCAL obj
WITH ThisForm.d
obj = .ff [.current_mode]
IF Not obj.move_down()
obj.set_debris
IF .init_figure()
obj = .ff [.current_mode]
ELSE
ThisForm.release && here you lost
ENDIF
ENDIF
.shake_debris
ENDWITH
ENDPROC
ENDDEFINE



5. terakhir klik run


Sorri blm sempurna to game,....
buat yg bs sempurnain kasih gw y.....

referensi:
http://d3mi-unsyiah.forumi.biz/foxpro-f45/membuat-game-tetris-dengan-vfp-t13.htm