Your trail:  ... HelloWorld MinnesotaFoxProUserGroupMembers NotATable SettingUpMTS _WillMicrosoftMarketVFP_Comments FoxTetris
Wiki Home

Fox Tetris

(Updated: 2001.08.16 08:23:42 PM)
Namespace: VB
Edit -Find- Recent Changes Categories Road Map [A-F] [G-P] [Q-Z] New Topic Home
Search:
Just for your fun.
Category Games Category Code Samples 
*| Here is Alexey Pajitnov's Tetris programmed in VFP. 
*| A sort of "Hello, World!" program, which should exist for every programming language. 
*| No scores, no levels -- a pure Tetris. 
*| Some 550 lines of code, may be too much; though it's squeezable.

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

Anatoliy Mogylevets
Category Code Samples

Edit -Find- Recent Changes Categories Road Map [A-F] [G-P] [Q-Z] New Topic Home
Search:
http://fox.wikis.com - a low-impedance, fat-free Visual Foxpro site. - 2010.07.31 06:45:42 PM EST