' Alexander Artyukhov ' Anti-Tetris ' '-------------------------------------------------------------- ' Tetris bacteria grows up in your glass. Kill it by clicking a figure ' consisting on 3 or more bricks of the same color. Enjoy! '-------------------------------------------------------------- #COMPILER PBWIN 8 #COMPILE EXE "Anti-TetriS.exe" %IDD_MAIN = 101 %IDC_GRAPHIC = 1001 %IDC_PLAY = 1002 %IDC_LEVEL = 1004 %IDC_QUIT = 1003 '-------------- A small piece of WIN32API.INC ---------- %RED = &H0000FF??? %WHITE = &HFFFFFF??? %GWL_WNDPROC = -4 %WM_DESTROY = &H2 %WM_NCACTIVATE = &H086 %WM_COMMAND = &H111 %WM_LBUTTONDOWN = &H201 %WS_POPUP = &H80000000 %WS_CHILD = &H40000000 %WS_VISIBLE = &H10000000 %WS_CLIPSIBLINGS = &H04000000 %WS_CAPTION = &H00C00000 %WS_BORDER = &H00800000 %WS_DLGFRAME = &H00400000 %WS_SYSMENU = &H00080000 %WS_THICKFRAME = &H00040000 %WS_TABSTOP = &H00010000 %WS_MINIMIZEBOX = &H00020000 %WS_EX_LEFT = &H00000000 %WS_EX_LTRREADING = &H00000000 %WS_EX_RIGHTSCROLLBAR = &H00000000 %WS_EX_CONTROLPARENT = &H00010000 %WS_EX_STATICEDGE = &H00020000 %HWND_DESKTOP = 0 %BS_TEXT = &H0& %BS_PUSHBUTTON = &H0& %BS_CENTER = &H300& %BS_VCENTER = &HC00& %BS_FLAT = &H00008000& %BN_CLICKED = 0 %SS_NOTIFY = &H00000100 %DS_3DLOOK = &H0004& %DS_NOFAILCREATE = &H0010& %DS_SETFONT = &H0040& %DS_MODALFRAME = &H0080& %DS_CENTER = &H0800& '------------------------------ GLOBAL hDlg AS DWORD GLOBAL Level& GLOBAL Score&, MaxScore& GLOBAL CurColor& GLOBAL Arr&() GLOBAL ColorInd&() GLOBAL Game& GLOBAL Delay! GLOBAL ImEditProc& '------------------------------ DECLARE FUNCTION Check_3(x AS LONG,y AS LONG) AS LONG DECLARE CALLBACK FUNCTION ShowMAINProc() DECLARE FUNCTION ShowMAIN(BYVAL hParent AS DWORD) AS LONG DECLARE FUNCTION CBImage (BYVAL hCtl AS LONG, BYVAL wMsg AS LONG, BYVAL wParam AS LONG, BYVAL lParam AS LONG) AS LONG DECLARE FUNCTION CallWindowProc LIB "USER32.DLL" ALIAS "CallWindowProcA" (BYVAL lpPrevWndFunc AS DWORD, BYVAL hWnd AS DWORD, BYVAL uMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG DECLARE FUNCTION GetFocus LIB "USER32.DLL" ALIAS "GetFocus" () AS DWORD DECLARE FUNCTION SetFocus LIB "USER32.DLL" ALIAS "SetFocus" (BYVAL hWnd AS DWORD) AS LONG DECLARE FUNCTION SetWindowLong LIB "USER32.DLL" ALIAS "SetWindowLongA" (BYVAL hWnd AS DWORD, BYVAL nIndex AS LONG, BYVAL lNewLong AS LONG) AS LONG '------------------------------ FUNCTION PBMAIN() Level&=1: Delay!=2.5 MaxScore&=0: Score&=0 REDIM Arr&(17,11) ''' +1 for each dimension DIM ColorInd&(4,2) ColorInd&(0,1)=RGB(255,255,255): ColorInd&(0,2)=RGB(255,255,255) ' W ColorInd&(1,1)=RGB(250,250,0) : ColorInd&(1,2)=RGB(190,190,0) ' Y ColorInd&(2,1)=RGB(255,80,80) : ColorInd&(2,2)=RGB(120,0,0) ' R ColorInd&(3,1)=RGB(0,220,0) : ColorInd&(3,2)=RGB(0,150,0) ' G ColorInd&(4,1)=RGB(120,150,255): ColorInd&(4,2)=RGB(0,0,120) ' B ShowMAIN %HWND_DESKTOP END FUNCTION '---------------------------------- GAME main --------- SUB PlayGame REDIM Arr&(17,11) Game&=1: Score&=0 RANDOMIZE TIMER GRAPHIC CLEAR %WHITE CONTROL DISABLE hDlg, %IDC_PLAY DO FOR i&=1 TO 16 '''' Shift UP FOR j&=1 TO 10 Arr&(i&,j&)=Arr&(i&+1,j&) NEXT j& NEXT i& FOR j&=1 TO 10 '''' Fill last row Arr&(16,j&)=RND(1,4) NEXT j& CALL RefreshPicture FOR j&=1 TO 10 '''' Check END IF Arr&(1,j&)<>0 THEN EXIT DO NEXT j& t!=TIMER '''' Delay DO: DIALOG DOEVENTS: LOOP WHILE TIMER-t! MaxScore& THEN MaxScore&=Score& CONTROL ENABLE hDlg, %IDC_PLAY CALL PrintScore END SUB '-------------------------------- Graphic -------------------- SUB RefreshPicture GRAPHIC ATTACH hDlg, %IDC_GRAPHIC FOR i&=1 TO 16 FOR j&=1 TO 10 CALL DrawBox(j&,i&,Arr&(i&,j&)) NEXT j& NEXT i& GRAPHIC REDRAW END SUB '------------------------- SUB DrawBox(i&,j&,Clr&) x&=(i&-1)*20: y&=(j&-1)*20 GRAPHIC BOX (x&,y&)-(x&+20, y&+20),,ColorInd&(Clr&,2),ColorInd&(Clr&,1) GRAPHIC BOX (x&+2,y&+2)-(x&+17, y&+17),,ColorInd&(Clr&,2) END SUB '---------------------------------- Logic ---------------------- ''' Check if 3 or more squares of the same color clicked ''' FUNCTION Check_3&(x&,y&) CurColor&=Arr&(x&,y&): Sum&=1 IF CurColor&=0 THEN FUNCTION=0: EXIT FUNCTION i&=x& DO ' Down INCR i& IF Arr&(i&,y&)<>CurColor& THEN EXIT DO IF Arr&(i&,y&)=CurColor& THEN INCR Sum& IF Arr&(i&,y&+1)=CurColor& THEN INCR Sum& IF Arr&(i&,y&-1)=CurColor& THEN INCR Sum& LOOP WHILE i&<=16 i&=x& DO DECR i& 'Up IF Arr&(i&,y&)<>CurColor& THEN EXIT DO IF Arr&(i&,y&)=CurColor& THEN INCR Sum& IF Arr&(i&,y&+1)=CurColor& THEN INCR Sum& IF Arr&(i&,y&-1)=CurColor& THEN INCR Sum& LOOP WHILE i&>=1 i&=y& DO INCR i& ' Right IF Arr&(x&,i&)<>CurColor& THEN EXIT DO IF Arr&(x&,i&)=CurColor& THEN INCR Sum& IF Arr&(x&+1,i&)=CurColor& THEN INCR Sum& IF Arr&(x&-1,i&)=CurColor& THEN INCR Sum& LOOP WHILE i&<=10 i&=y& DO DECR i& ' Left IF Arr&(x&,i&)<>CurColor& THEN EXIT DO IF Arr&(x&,i&)=CurColor& THEN INCR Sum& IF Arr&(x&+1,i&)=CurColor& THEN INCR Sum& IF Arr&(x&-1,i&)=CurColor& THEN INCR Sum& LOOP WHILE i&>=1 IF Sum&>2 THEN Arr&(x&,y&)=9 FUNCTION=Sum& END FUNCTION '------------------------- ''' A simple way to mark all squares of CurColor for deletion SUB MarkChecked(x&,y&) FOR i&=1 TO 16 FOR j&=1 TO 10 IF Arr&(i&,j&)=9 THEN GOSUB Repl NEXT j& NEXT i& FOR i&=16 TO 1 STEP -1 FOR j&=10 TO 1 STEP -1 IF Arr&(i&,j&)=9 THEN GOSUB Repl NEXT j& NEXT i& EXIT SUB Repl: IF Arr&(i&-1,j&)=CurColor& THEN Arr&(i&-1,j&)=9: INCR Score& IF Arr&(i&+1,j&)=CurColor& THEN Arr&(i&+1,j&)=9: INCR Score& IF Arr&(i&,j&-1)=CurColor& THEN Arr&(i&,j&-1)=9: INCR Score& IF Arr&(i&,j&+1)=CurColor& THEN Arr&(i&,j&+1)=9: INCR Score& RETURN END SUB '------------------------- ''' Delete all marked squares in Arr&() & drop down the rest SUB DeleteChecked FOR i&=1 TO 10 FOR j&=1 TO 16 IF Arr&(j&,i&)=9 THEN FOR k&=j& TO 1 STEP-1: Arr&(k&,i&)=Arr&(k&-1,i&): NEXT k& END IF NEXT j& NEXT i& END SUB '---------------------------------------- Text --------------- SUB PrintCover GRAPHIC ATTACH hDlg, %IDC_GRAPHIC GRAPHIC BOX (20,100)-(180, 200),10,0,RGB(255,255,200) GRAPHIC COLOR %RED,RGB(255,255,200) GRAPHIC FONT "Arial", 14, 1 GRAPHIC SET POS (50,110) : GRAPHIC PRINT "Anti-TetriS" GRAPHIC COLOR 0,RGB(255,255,200) GRAPHIC FONT "Arial", 10, 0 GRAPHIC SET POS (30,150) : GRAPHIC PRINT "Click 3 or more bricks" GRAPHIC SET POS (45,165) : GRAPHIC PRINT "of the same color" GRAPHIC REDRAW END SUB '------------------------------ SUB PrintScore GRAPHIC ATTACH hDlg, %IDC_GRAPHIC GRAPHIC BOX (20,100)-(180, 200),10,0,RGB(255,255,200) GRAPHIC COLOR %RED,RGB(255,255,200) GRAPHIC FONT "Arial", 14, 1 GRAPHIC SET POS (45,110) : GRAPHIC PRINT "Game Over!" GRAPHIC COLOR 0,RGB(255,255,200) GRAPHIC FONT "Arial", 10, 0 GRAPHIC SET POS (45,150) : GRAPHIC PRINT "Score : " GRAPHIC SET POS (45,165) : GRAPHIC PRINT "Max Score : " GRAPHIC FONT "Arial", 10, 1 GRAPHIC SET POS (120,150): GRAPHIC PRINT STR$(Score&) GRAPHIC SET POS (120,165): GRAPHIC PRINT STR$(MaxScore&) GRAPHIC REDRAW END SUB '---------------------------------- Callbacks ------------------ CALLBACK FUNCTION ShowMAINProc() SELECT CASE AS LONG CBMSG CASE %WM_NCACTIVATE STATIC hWndSaveFocus AS DWORD IF ISFALSE CBWPARAM THEN hWndSaveFocus = GetFocus() ELSEIF hWndSaveFocus THEN SetFocus(hWndSaveFocus) hWndSaveFocus = 0 END IF CASE %WM_DESTROY SetWindowLong ImEditProc, %GWL_WNDPROC, CBHNDL CASE %WM_COMMAND SELECT CASE AS LONG CBCTL CASE %IDC_GRAPHIC CASE %IDC_PLAY IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN PlayGame END IF CASE %IDC_QUIT IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN DIALOG END CBHNDL END IF CASE %IDC_LEVEL IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN INCR Level&: IF Level&>5 THEN Level&=1 Delay!=2.5/Level& CONTROL SET TEXT CBHNDL,%IDC_LEVEL, "Level "+STR$(Level&) END IF END SELECT END SELECT END FUNCTION '------------------------------- ' PICTURE CLICK FUNCTION CBImage (BYVAL hCtl AS LONG, BYVAL wMsg AS LONG, _ BYVAL wParam AS LONG, BYVAL lParam AS LONG) AS LONG SELECT CASE wMsg CASE %WM_LBUTTONDOWN '''' IF Game&=0 THEN EXIT FUNCTION My&=LOWRD(lParam) : Mx&=HIWRD(lParam) y&=My&\20+1: x&=Mx&\20+1 ''' Array indexes IF Arr&(x&,y&)=0 THEN EXIT FUNCTION IF Check_3&(x&,y&)>2 THEN ''' 3 or more clicked: MarkChecked(x&,y&) ''' mark them, FOR i&=1 TO 16: FOR j&=1 TO 10 ''' paint white, IF Arr&(i&,j&)=9 THEN CALL DrawBox(j&,i&,0) NEXT j& : NEXT i& t!=TIMER ''' and make a small delay DO: DIALOG DOEVENTS: LOOP WHILE TIMER-t!<0.1 DeleteChecked ''' Delete: in Arr&(), RefreshPicture ''' on screen END IF END SELECT FUNCTION = CallWindowProc(BYVAL ImEditProc,hCtl,wMsg,wParam,lParam) END FUNCTION '----------------------------------- Dialog -------------------------- FUNCTION ShowMAIN(BYVAL hParent AS DWORD) AS LONG LOCAL lRslt AS LONG LOCAL hWndIm AS DWORD DIALOG NEW PIXELS, hParent, " Anti-TetriS", 200, 100, 220, 380, %WS_POPUP OR _ %WS_BORDER OR %WS_DLGFRAME OR %WS_THICKFRAME OR %WS_CAPTION OR _ %WS_SYSMENU OR %WS_MINIMIZEBOX OR %WS_CLIPSIBLINGS OR %WS_VISIBLE OR _ %DS_MODALFRAME OR %DS_CENTER OR %DS_3DLOOK OR %DS_NOFAILCREATE OR _ %DS_SETFONT, %WS_EX_CONTROLPARENT OR %WS_EX_LEFT OR _ %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR, TO hDlg DIALOG SET COLOR hDlg, -1, RGB(95, 175, 175) CONTROL ADD BUTTON, hDlg, %IDC_PLAY, "Play Game", 10, 340, 70, 24, _ %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %BS_TEXT OR _ %BS_PUSHBUTTON OR %BS_FLAT OR %BS_CENTER OR %BS_VCENTER, _ %WS_EX_STATICEDGE OR %WS_EX_LEFT OR %WS_EX_LTRREADING CONTROL ADD BUTTON, hDlg, %IDC_LEVEL, "Level 1", 80, 340, 60, 24, _ %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %BS_TEXT OR _ %BS_PUSHBUTTON OR %BS_FLAT OR %BS_CENTER OR %BS_VCENTER, _ %WS_EX_STATICEDGE OR %WS_EX_LEFT OR %WS_EX_LTRREADING CONTROL ADD BUTTON, hDlg, %IDC_QUIT, "Back to Job", 140, 340, 70, 24, _ %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %BS_TEXT OR _ %BS_PUSHBUTTON OR %BS_FLAT OR %BS_CENTER OR %BS_VCENTER, _ %WS_EX_STATICEDGE OR %WS_EX_LEFT OR %WS_EX_LTRREADING CONTROL ADD GRAPHIC, hDlg, %IDC_GRAPHIC, "", 10, 10, 200, 320, %WS_CHILD OR _ %WS_VISIBLE OR %WS_BORDER OR %SS_NOTIFY GRAPHIC ATTACH hDlg, %IDC_GRAPHIC, REDRAW GRAPHIC CLEAR %WHITE CONTROL HANDLE hDlg, %IDC_GRAPHIC TO hWndIm ImEditProc = SetWindowLong(hWndIm,%GWL_WNDPROC,BYVAL CODEPTR(CBImage)) CALL PrintCover DIALOG SHOW MODAL hDlg, CALL ShowMAINProc TO lRslt FUNCTION = lRslt END FUNCTION '--------------------------------- EOJ ------------------------------------------ --- Cut END ------------------------ -- SY: Alex