home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.alaska-software.com
/
2014.06.ftp.alaska-software.com.tar
/
ftp.alaska-software.com
/
acsn
/
XPPTRIS11E.ZIP
/
XPPTRIS.PRG
< prev
Wrap
Text File
|
2007-10-25
|
46KB
|
1,277 lines
******************************************************************
* Langage : Clipper 5.0 VF
* Fichier : Cliptris.prg
* Author : Philippe BONNARDEL
* <<< This program is placed in the public domain >>>
* Version : 1.0
* Date : 08/04/95
* Compil. : /L/N/W
* Link : None
* Description : Tetris Game
* Information : Questions, Problems,...? My CIS-ID : 100604,1637
*
* modify for Xbase++ GUI by AUGE_OHR, Jimmy
* Date : 24.10.2007
* Compile : /W
* Link : /PM:PM
* Note : compile with /DXPPGUI or use #define XPPGUI .T.
******************************************************************
#include "box.ch"
#include "inkey.ch"
#include "Common.ch"
*#define XPPGUI .T.
#IFDEF XPPGUI // Xpp GUI
#include "Appevent.ch"
#include "Gra.ch"
#include "Xbp.ch"
#include "Font.ch"
#include "DLL.ch"
#define aPRES_PARAM { ; // Presentation Parameter fuer den Browser
{XBP_PP_COL_DA_FGCLR , XBPSYSCLR_WINDOWSTATICTEXT }, ;
{XBP_PP_COL_DA_BGCLR , XBPSYSCLR_WINDOW }, ;
{XBP_PP_COL_DA_HILITE_FGCLR , GRA_CLR_BLACK },; // don∩t show
{XBP_PP_COL_DA_HILITE_BGCLR , GRA_CLR_BLACK },; // Cursor here
{XBP_PP_COL_DA_COMPOUNDNAME , FONT_DEFPROP_SMALL }, ;
{XBP_PP_COL_DA_ROWHEIGHT , 18 }, ;
{XBP_PP_COL_DA_ROWWIDTH , 10 }, ;
{XBP_PP_COL_DA_FRAMELAYOUT , XBPFRAME_NONE }, ;
{XBP_PP_COL_DA_CELLFRAMELAYOUT, XBPFRAME_BOX }, ;
{XBP_PP_COL_DA_CELLHEIGHT , 32 }, ;
{XBP_PP_COL_DA_CELLWIDTH , 8 }}
#ENDIF
#define C_VERSION "1.1"
#define C_YEAR "2007"
#define WIN_UP 2
#define WIN_LEFT 17
#define BD_HEIGHT 18
#define BD_WIDTH 20
#define ST_WIDTH 23
#define N_ROW_TEXT WIN_UP + 2
#define N_COL_TEXT WIN_LEFT + BD_WIDTH + 3
#define N_LEN_TEXT 12
#define N_COL_SCORE N_COL_TEXT + N_LEN_TEXT
#define N_LEN_DISP ST_WIDTH - N_LEN_TEXT - 1
#define N_NEXT_BLOCK_ROW WIN_UP + 8
// aEnv
#define LEN_ENV 4 //
#define ENV_SCREEN 1 // DOS/Hybrid settings
#define ENV_CURSOR 2 //
#define ENV_COLOR 3 //
#define ENV_ROW 4 // not avaiable in GUI
// aCargo
#define LEN_A_CARGO 16
#define CG_N_GAME 1 // show Game Status (Play,Pause,Game Over)
#define CG_N_HIGH_SCORE 2 // show High Score
#define CG_N_INIT_SCORE 3
#define CG_N_SCORE 4 // show actual Game Score
#define CG_N_COUNT_LINES 5 // show Lines
#define CG_N_COUNT_BLOCKS 6 // show Blocks
#define CG_N_LEVEL 7 // show Level
#define CG_N_CUR_WAIT 8 // Wait = 1000
#define CG_N_CUR_BLOCK 9 // 1
#define CG_N_NEXT_BLOCK 10 // 1
#define CG_N_BLOCK_SIZE 11 // 4 new Block
#define CG_N_BLOCK_ROW 12 // 0
#define CG_N_BLOCK_COL 13 // 10
#define CG_N_RANDOM 14 // 184
#define CG_N_INIT_TIK 15 // 22924.25
#define CG_N_MAX_BLOCKS 16 // 16
// CG_N_GAME
#define N_GAME_OVER 1
#define N_PLAYED 2
#define N_PAUSED 3
#define A_C_STATUS {"Game Over", "Play", "Pause"}
// Misc.
#define N_MIN_LEVEL 1
#define N_INIT_MAX_BLOCKS 7
#define N_LEVEL_ADD_BLOCKS 7 // which level Preview :show()
#define N_PT_PER_BLOCK 1
#define N_PT_PER_LINE 5
#define N_BLOCKS_PER_LEVEL 25
#define N_INIT_WAIT 1100 // start time will decrase
#define N_TIME_PER_LEVEL 100 // each level make Game faster
#define C_ELEMENT "██" // 2 Charactar !!!
#define N_EMPTY 0
#define N_BORDURE -1 // DOS/Hybrid
#define C_MASK "░a▒a▒a▓a▓a▓a▒a▒a░a"
#define C_BOARD_CLR "N"
#define C_FILE_NAME "CLIPTRIS.INI" // High Score
#define N_LEN_SCORE 5
#define NTRIM(nVal) LTRIM(STR(nVal))
#define NPADL(nVal) PADR(NTRIM(nVal), N_LEN_DISP)
// aScore
#define A_STATE {;
{00, "High Score:", "R/" , {|aCargo| NPADL(aCargo[CG_N_HIGH_SCORE])}},;
{02, "Status :", "R/" , {|aCargo| PADR(A_C_STATUS[aCargo[CG_N_GAME]],N_LEN_DISP)}},;
{04, "Score :", "R+/", {|aCargo| NPADL(aCargo[CG_N_SCORE])}},;
{11, "Level :", "GR+/",{|aCargo| NPADL(aCargo[CG_N_LEVEL])}},;
{13, "Lines :", "G+/", {|aCargo| NPADL(aCargo[CG_N_COUNT_LINES])}},;
{14, "Blocks :", "G+/", {|aCargo| NPADL(aCargo[CG_N_COUNT_BLOCKS])}},;
{15, "Speed :", "G+/", {|aCargo| NPADL(INT(N_INIT_WAIT/N_INIT_WAIT) +;
INT((N_INIT_WAIT - aCargo[CG_N_CUR_WAIT]) / 100))}}}
******************************************************************
*Xbase++ MAIN
******************************************************************
MEMVAR aPlayground , np, aPView, nPV // PRIVATE
MEMVAR ID_USER, ID_VERSION, ZPATH // for ErrorSys
#IFDEF XPPGUI
#pragma Library( "XppUi2.lib" ) // XbpBrowse
PROCEDURE APPSYS
LOCAL cTitle := "XppTris"
LOCAL hWndDlg := DllCall("User32.dll",DLL_STDCALL,"FindWindowA",0,cTitle)
IF !(hWndDlg == 0)
DllCall("User32.dll",DLL_STDCALL,"SetForegroundWindow",hWndDlg)
DllCall("User32.dll",DLL_STDCALL,"BringWindowToTop",hWndDlg)
DllCall("User32.dll",DLL_STDCALL,"ShowWindow",hWndDlg,1)
DllCall("User32.dll",DLL_STDCALL,"UpdateWindow",hWndDlg)
QUIT // It is a second instance. Bye Bye
ENDIF
RETURN
PROCEDURE MAIN
LOCAL nEvent, mp1, mp2, oXbp
LOCAL oBrowse
LOCAL oPView
LOCAL oCol, i, iMax
LOCAL bBlock
LOCAL oDlg
LOCAL aPos := { 0, 0}
LOCAL aSize := {400,550}
LOCAL aEnv, aBlocks, aBoard, aCurBlock, aColor, aCargo
LOCAL nKey, cKey, lAllDrop, lNoExit
LOCAL nCol, nRow
LOCAL aText := {}
LOCAL bKeyHandler
LOCAL cRes := GETENV("XPPRESOURCE")
LOCAL bPP := {{XBP_PP_FGCLR,GRA_CLR_YELLOW},;
{XBP_PP_BGCLR,GRA_CLR_BLACK }}
LOCAL cPP := {{XBP_PP_FGCLR,GRA_CLR_BLACK },;
{XBP_PP_BGCLR,XBPSYSCLR_TRANSPARENT}}
*LOCAL aControls := {} // Array which XbPart
*LOCAL oNew // Pushbutton New
PRIVATE aPlayground := LeerArray() // Playfield
PRIVATE np := 1 // index pointer into array
PRIVATE aPView := LeerPView() // Preview
PRIVATE nPV := 1 // index pointer into array
PRIVATE ID_USER := "Tetris" // for XppError
PRIVATE ID_VERSION := C_VERSION+"e"
PRIVATE ZPATH := LEFT(AppName(.t.),LEN(AppName(.t.)) - LEN(AppName(.f.)))
// center Window
aPos := CenterPos(aSize,AppDesktop():currentSize())
oDlg := XbpDialog():new( ,,aPos, aSize,, .F. )
oDlg:Icon := 1004
oDlg:taskList := .T.
oDlg:title := "XppTris"
oDlg:maxButton := .F.
oDlg:minButton := .F.
oDlg:border := XBPDLG_DLGBORDER // no resize
oDlg:drawingArea:setFontCompoundName( FONT_DEFPROP_SMALL )
oDlg:drawingArea:bitmap := LoadBMP(cRes,"flash.BMP",aSize)
oDlg:drawingArea:LbDown := {| aPos, uNIL, self | PostAppEvent(xbeP_Keyboard,xbeK_LEFT ,,self:setparent()) }
oDlg:drawingArea:RbDown := {| aPos, uNIL, self | PostAppEvent(xbeP_Keyboard,xbeK_RIGHT,,self:setparent()) }
// rotate with Wheel
oDlg:drawingArea:wheel := {| aPos, aWheel, self | WheelUpDn(aWheel,aCargo,self) }
// can "click" on Wheel too !
oDlg:drawingArea:mbDown := {| aPos, uNIL, self | PostAppEvent(xbeP_Keyboard,xbeK_SPACE,,self:setparent()) }
oDlg:create()
nCol := aSize[2] - 55
iMax := LEN(A_STATE)
FOR i := 1 TO iMax
nCol := nCol - 50
nRow := aSize[1]-160
oXbp := XbpStatic():new(oDlg:drawingArea,,{nRow,nCol},{60,24},cPP,.T.)
oXbp:caption := A_STATE[i,2]
oXbp:options := XBPSTATIC_TEXT_LEFT+XBPSTATIC_TEXT_VCENTER
oXbp:create()
nRow := aSize[1]-100
oXbp := XbpStatic():new(oDlg:drawingArea,,{nRow,nCol},{60,24},bPP,.T.)
oXbp:options := XBPSTATIC_TEXT_CENTER+XBPSTATIC_TEXT_VCENTER
oXbp:caption := ""
oXbp:create()
AADD(aText,oXbp) // add to Array
NEXT
oBrowse := XbpBrowse():new( oDlg:drawingArea,,{10,40},{aSize[1]-200 ,aSize[2]-121 }, aPRES_PARAM )
oBrowse:hScroll := .F.
oBrowse:vScroll := .F.
oBrowse:sizeCols := .F.
oBrowse:cursorMode:= XBPBRW_CURSOR_NONE
oBrowse:create()
oBrowse:skipBlock := {|nSkip| -np + (np := MAX(1, MIN(LEN(aPlayground), np + nSkip))) }
oBrowse:goTopBlock := {|| np := 1}
oBrowse:goBottomBlock := {|| np := LEN(aPlayground) }
oBrowse:posBlock := {|| np }
oBrowse:phyPosBlock := {|| np }
oBrowse:lastPosBlock := {|| Len( aPlayground ) }
oBrowse:firstPosBlock := {|| 1 }
iMax := LEN(aPlayground[1])
FOR i := 1 TO iMax
oCol := XbpColumn():new(,,,,aPRES_PARAM)
bBlock := "{|xVal| IF(xVal == NIL, aPlayground[np][" +STR(i,3)+ "], aPlayground[np][" +STR(i,3)+ "] := xVal) }"
oCol:dataLink := &bBlock
oCol:colorBlock := {|xVal| IF(xVal == "0" ,{GRA_CLR_BLACK ,GRA_CLR_BLACK } ,;
IF(xVal == "1" ,{GRA_CLR_CYAN ,GRA_CLR_CYAN } ,;
IF(xVal == "2" ,{GRA_CLR_BLUE ,GRA_CLR_BLUE } ,;
IF(xVal == "3" ,{GraMakeRGBColor({255,138,025}), GraMakeRGBColor({255,138,025})} ,;
IF(xVal == "4" ,{GraMakeRGBColor({136,030,250}), GraMakeRGBColor({136,030,250})} ,;
IF(xVal == "5" ,{GRA_CLR_RED ,GRA_CLR_RED } ,;
IF(xVal == "6" ,{GRA_CLR_GREEN ,GRA_CLR_GREEN } ,;
IF(xVal == "7" ,{GRA_CLR_YELLOW ,GRA_CLR_YELLOW } ,;
IF(xVal == "8" ,{GRA_CLR_DARKGREEN,GRA_CLR_DARKGREEN} ,;
IF(xVal == "9" ,{GRA_CLR_WHITE ,GRA_CLR_WHITE } ,;
IF(xVal == "10",{GRA_CLR_DARKRED ,GRA_CLR_DARKRED } ,;
IF(xVal == "11",{GRA_CLR_PINK ,GRA_CLR_PINK } ,;
IF(xVal == "12",{GRA_CLR_DARKCYAN ,GRA_CLR_DARKCYAN } ,;
IF(xVal == "13",{GRA_CLR_BROWN ,GRA_CLR_BROWN } ,;
IF(xVal == "14",{GRA_CLR_DARKBLUE ,GRA_CLR_DARKBLUE } ,;
{GRA_CLR_BLACK,GRA_CLR_PALEGRAY} ))))))))))))))) }
oCol:create()
oBrowse:addColumn( oCol )
NEXT
* oBrowse:LbDown := {| aPos,y,obj | SetAppFocus( oDlg )} // disable Click
* oBrowse:RbDown := {| aPos,y,obj | SetAppFocus( oDlg )} // disable Click
// Preview
oPView := PVIEW(oDlg,{300,40},{60,80})
// must reach Level 7
oPView:hide()
oDlg:show()
oBrowse:show()
* AADD(aControls,oDlg) // control to keyhandler
* AADD(aControls,oBrowse) // control to keyhandler
* AADD(aControls,oPView) // control to keyhandler
Make_Env_Win(@aEnv,oDlg)
Make_Var(@aBlocks, @aBoard, @aColor, @aCargo)
Disp_Score(aBlocks, aColor, aCargo, oBrowse, aText)
* //
* // install keyboard handler
* //
* bKeyHandler := {| nKey,uNIL,obj | DlgKeys(nKey,obj,;
* oDlg, aBlocks, aColor, aCargo, oBrowse, aText,;
* aBoard, @aCurBlock, oPView, @lAllDrop, @lNoExit )}
* AEVAL(aControls,{| o | o:keyBoard := bKeyHandler})
lAllDrop := .F.
lNoExit := .T.
SetAppFocus( oDlg )
* oNew := oDlg:drawingArea:childlist()[18]:childlist()[2]
* SetAppFocus( oNew )
DO WHILE nEvent <> xbeP_Close .AND. lNoExit
IF .NOT. lAllDrop
nEvent := AppEvent( @mp1, @mp2, @oXbp,(aCargo[CG_N_CUR_WAIT]/10) )
ENDIF
DO CASE
CASE nEvent == xbe_None // need for Tic_Tac
CASE nEvent == xbeP_Keyboard
nKey := mp1
cKey := UPPER(CHR(nKey))
DO CASE
CASE nKey = xbeK_ESC
EXIT
CASE nKey = xbeK_F12 .AND. aCargo[CG_N_GAME] != N_GAME_OVER
aCargo[CG_N_SCORE] := 1000
aCargo[CG_N_COUNT_LINES] := 50
aCargo[CG_N_COUNT_BLOCKS] := 150
aCargo[CG_N_LEVEL] := 7
Disp_Score(aBlocks, aColor, aCargo, oBrowse, aText)
CASE cKey == "R" .AND. aCargo[CG_N_GAME] = N_GAME_OVER
RandomTest(aText)
CASE cKey == "N"
Init_Game(aBlocks, aBoard, @aCurBlock, aCargo, oPView)
oPView:hide()
Draw_Block(aCurBlock, aColor, aCargo, .T.,oBrowse)
CASE aCargo[CG_N_GAME] == N_GAME_OVER
// does flicker on Screen
* Disp_Score(aBlocks, aColor, aCargo, oBrowse, aText)
CASE aCargo[CG_N_GAME] != N_GAME_OVER
DO CASE
CASE aCargo[CG_N_GAME] == N_PAUSED .AND. nKey != 0
aCargo[CG_N_GAME] := N_PLAYED
CASE cKey == "P"
aCargo[CG_N_GAME] := N_PAUSED
// does flicker on Screen
* Disp_Score(aBlocks, aColor, aCargo, oBrowse, aText)
CASE nKey == xbeK_UP .OR. nKey == xbeK_DOWN
Draw_Block(aCurBlock, aColor, aCargo, .F.,oBrowse)
Rotate_Block(@aCurBlock, aCargo, IF(nKey == xbeK_UP, K_LEFT, K_RIGHT))
IF Hit_Block(aBoard, aCurBlock, aCargo)
Rotate_Block(@aCurBlock, aCargo, IF(nKey == xbeK_UP, K_RIGHT, K_LEFT))
ENDIF
Draw_Block(aCurBlock, aColor, aCargo, .T.,oBrowse)
CASE nKey == xbeK_LEFT .OR. nKey == xbeK_RIGHT
Draw_Block(aCurBlock, aColor, aCargo, .F.,oBrowse)
aCargo[CG_N_BLOCK_COL] += IF(nKey == xbeK_LEFT, -2, 2)
IF Hit_Block(aBoard, aCurBlock, aCargo)
aCargo[CG_N_BLOCK_COL] += IF(nKey == xbeK_LEFT, 2, -2)
ENDIF
Draw_Block(aCurBlock, aColor, aCargo, .T.,oBrowse)
CASE nKey == xbeK_SPACE
lAllDrop := .T.
ENDCASE
ENDCASE
OTHERWISE
oXbp:handleEvent( nEvent, mp1, mp2 )
ENDCASE
IF aCargo[CG_N_GAME] == N_PLAYED
IF lAllDrop .OR. Tic_Tac(aCargo[CG_N_CUR_WAIT], aCargo[CG_N_INIT_TIK])
Draw_Block(aCurBlock, aColor, aCargo, .F.,oBrowse)
aCargo[CG_N_BLOCK_ROW]++
IF Hit_Block(aBoard, aCurBlock, aCargo)
aCargo[CG_N_BLOCK_ROW]--
Draw_Block(aCurBlock, aColor, aCargo, .T.,oBrowse)
Place_Block(aBlocks, aBoard, @aCurBlock, aColor, aCargo,oBrowse,oPView)
lAllDrop := .F.
ENDIF
Draw_Block(aCurBlock, aColor, aCargo, .T.,oBrowse)
aCargo[CG_N_INIT_TIK] := SECONDS()
Disp_Score(aBlocks, aColor, aCargo, oBrowse, aText)
ENDIF
ENDIF
ENDDO
Rest_Env(aEnv, aCargo)
RETURN
STATIC FUNCTION WheelUpDn(aWheel,aCargo,oDraw)
IF aCargo[CG_N_GAME] != N_GAME_OVER
IF aWheel[2] > 0
PostAppEvent(xbeP_Keyboard,xbeK_UP ,,oDraw:setparent() )
ELSE
PostAppEvent(xbeP_Keyboard,xbeK_DOWN,,oDraw:setparent() )
ENDIF
ENDIF
RETURN NIL
STATIC FUNCTION LeerArray()
LOCAL aPlayground[18][20]
LOCAL i
FOR i = 1 TO 18
AFILL(aPlayground[i],"0")
NEXT
RETURN aPlayground
STATIC FUNCTION CENTERPOS(aSize,aRefSize)
RETURN {INT((aRefSize[1] - aSize[1]) / 2) ;
,INT((aRefSize[2] - aSize[2]) / 2)}
STATIC FUNCTION ISINFIELD(nRow,nCol)
IF nRow < 1 .OR. nRow > LEN(aPlayground) .OR.;
nCol < 1 .OR. nCol > LEN(aPlayground[1])
TONE(500,1)
RETURN .F.
ENDIF
RETURN .T.
STATIC FUNCTION LeerPView()
LOCAL aPView[4][7]
LOCAL i
FOR i = 1 TO 4
AFILL(aPView[i],"0")
NEXT
RETURN aPView
STATIC FUNCTION PVIEW(oDlg,aPos,aSize)
LOCAL oPView
LOCAL oCol, i, iMax
LOCAL bBlock
oPView := XbpBrowse():new( oDlg:drawingArea,,aPos,aSize , aPRES_PARAM )
oPView:hScroll := .F.
oPView:vScroll := .F.
oPView:sizeCols := .F.
oPView:cursorMode:= XBPBRW_CURSOR_NONE
oPView:create()
oPView:skipBlock := {|nSkip| -nPV + (nPV := MAX(1, MIN(LEN(aPView), nPV + nSkip))) }
oPView:goTopBlock := {|| nPV := 1}
oPView:goBottomBlock := {|| nPV := LEN(aPView) }
oPView:posBlock := {|| nPV }
oPView:phyPosBlock := {|| nPV }
oPView:lastPosBlock := {|| Len( aPView ) }
oPView:firstPosBlock := {|| 1 }
iMax := LEN(aPView[1])
FOR i := 1 TO iMax
oCol := XbpColumn():new(,,,,aPRES_PARAM)
bBlock := "{|xVal| IF(xVal == NIL, aPView[nPV][" +STR(i,3)+ "], aPView[nPV][" +STR(i,3)+ "] := xVal) }"
oCol:dataLink := &bBlock
oCol:colorBlock := {|xVal| IF(xVal == "0" ,{GRA_CLR_BLACK ,GRA_CLR_BLACK } ,;
IF(xVal == "1" ,{GRA_CLR_CYAN ,GRA_CLR_CYAN } ,;
IF(xVal == "2" ,{GRA_CLR_BLUE ,GRA_CLR_BLUE } ,;
IF(xVal == "3" ,{GraMakeRGBColor({255,138,025}), GraMakeRGBColor({255,138,025})} ,;
IF(xVal == "4" ,{GraMakeRGBColor({136,030,250}), GraMakeRGBColor({136,030,250})} ,;
IF(xVal == "5" ,{GRA_CLR_RED ,GRA_CLR_RED } ,;
IF(xVal == "6" ,{GRA_CLR_GREEN ,GRA_CLR_GREEN } ,;
IF(xVal == "7" ,{GRA_CLR_YELLOW ,GRA_CLR_YELLOW } ,;
IF(xVal == "8" ,{GRA_CLR_DARKGREEN,GRA_CLR_DARKGREEN} ,;
IF(xVal == "9" ,{GRA_CLR_WHITE ,GRA_CLR_WHITE } ,;
IF(xVal == "10",{GRA_CLR_DARKRED ,GRA_CLR_DARKRED } ,;
IF(xVal == "11",{GRA_CLR_PINK ,GRA_CLR_PINK } ,;
IF(xVal == "12",{GRA_CLR_DARKCYAN ,GRA_CLR_DARKCYAN } ,;
IF(xVal == "13",{GRA_CLR_BROWN ,GRA_CLR_BROWN } ,;
IF(xVal == "14",{GRA_CLR_DARKBLUE ,GRA_CLR_DARKBLUE } ,;
{GRA_CLR_BLACK,GRA_CLR_WHITE} ))))))))))))))) }
oCol:create()
oPView:addColumn( oCol )
NEXT
oPView:rowPos := LEN(aPView)
oPView:colPos := LEN(aPView[1])
RETURN oPView
PROCEDURE DlgKeys(nKey,obj, oDlg, aBlocks, aColor, aCargo, oBrowse, aText, aBoard, aCurBlock, oPView, lAllDrop, lNoExit)
LOCAL cKey
cKey := UPPER(CHR(nKey))
DO CASE
CASE nKey = xbeK_ESC
lNoExit := .F.
CASE nKey = xbeK_F12 .AND. aCargo[CG_N_GAME] != N_GAME_OVER
aCargo[CG_N_SCORE] := 1000
aCargo[CG_N_COUNT_LINES] := 50
aCargo[CG_N_COUNT_BLOCKS] := 150
aCargo[CG_N_LEVEL] := 7
Disp_Score(aBlocks, aColor, aCargo, oBrowse, aText)
CASE nKey = xbeK_F2 .or. cKey == "N"
Init_Game(aBlocks, aBoard, @aCurBlock, aCargo, oPView)
oPView:hide()
Draw_Block(aCurBlock, aColor, aCargo, .T.,oBrowse)
CASE aCargo[CG_N_GAME] == N_GAME_OVER
Disp_Score(aBlocks, aColor, aCargo, oBrowse, aText)
CASE aCargo[CG_N_GAME] != N_GAME_OVER
DO CASE
CASE aCargo[CG_N_GAME] == N_PAUSED .AND. nKey != 0
aCargo[CG_N_GAME] := N_PLAYED
CASE cKey == "P"
aCargo[CG_N_GAME] := N_PAUSED
Disp_Score(aBlocks, aColor, aCargo, oBrowse, aText)
CASE nKey == xbeK_UP .OR. nKey == xbeK_DOWN
Draw_Block(aCurBlock, aColor, aCargo, .F.,oBrowse)
Rotate_Block(@aCurBlock, aCargo, IF(nKey == xbeK_UP, K_LEFT, K_RIGHT))
IF Hit_Block(aBoard, aCurBlock, aCargo)
Rotate_Block(@aCurBlock, aCargo, IF(nKey == xbeK_UP, K_RIGHT, K_LEFT))
ENDIF
Draw_Block(aCurBlock, aColor, aCargo, .T.,oBrowse)
CASE nKey == xbeK_LEFT .OR. nKey == xbeK_RIGHT
Draw_Block(aCurBlock, aColor, aCargo, .F.,oBrowse)
aCargo[CG_N_BLOCK_COL] += IF(nKey == xbeK_LEFT, -2, 2)
IF Hit_Block(aBoard, aCurBlock, aCargo)
aCargo[CG_N_BLOCK_COL] += IF(nKey == xbeK_LEFT, 2, -2)
ENDIF
Draw_Block(aCurBlock, aColor, aCargo, .T.,oBrowse)
CASE nKey == xbeK_SPACE
* TONE(500,1)
lAllDrop := .T.
ENDCASE
ENDCASE
Setappfocus(oDlg)
RETURN
STATIC FUNCTION RAND( nLimit )
LOCAL nRes :=0
DEFAULT nLimit TO 1
DO WHILE nRes < 1
nRes := BaseRandom( nLimit*3 ) - nLimit
If nRes > nLimit
nRes := 0
ENDIF
ENDDO
RETURN( nRes )
// BaseRandom Function is example Random Function from Alaska, but
// it has a decided tendancy to avoid numbers near the edge of the range!
STATIC FUNCTION BaseRandom( nLimit )
STATIC snRandom := Nil
LOCAL nDecimals, cLimit
IF snRandom == NIL
snRandom := Seconds() / Exp(1)
ENDIF
snRandom := Log( snRandom + Sqrt(2) ) * Exp(3)
snRandom := Val( Str(snRandom - Int(snRandom), 17, 15 ) )
cLimit := Transform( nLimit, "@N" )
nDecimals := At(".", cLimit)
IF nDecimals > 0
nDecimals:= Len(cLimit)-nDecimals
ENDIF
RETURN Round( nLimit * snRandom, nDecimals )
STATIC FUNCTION RandomTest(aText)
LOCAL nVal := 0
LOCAL i,iMax
iMax := LEN(aText)
FOR i := 1 TO iMax
aText[i]:setCaption("0")
NEXT
FOR i := 1 TO 10000
nVal := INT(RAND(CG_N_RANDOM/2))
DO CASE
CASE nVal = 1 ; aText[1]:setCaption(NTRIM(VAL(aText[1]:caption)+1))
CASE nVal = 2 ; aText[2]:setCaption(NTRIM(VAL(aText[2]:caption)+1))
CASE nVal = 3 ; aText[3]:setCaption(NTRIM(VAL(aText[3]:caption)+1))
CASE nVal = 4 ; aText[4]:setCaption(NTRIM(VAL(aText[4]:caption)+1))
CASE nVal = 5 ; aText[5]:setCaption(NTRIM(VAL(aText[5]:caption)+1))
CASE nVal = 6 ; aText[6]:setCaption(NTRIM(VAL(aText[6]:caption)+1))
CASE nVal = 7 ; aText[7]:setCaption(NTRIM(VAL(aText[7]:caption)+1))
OTHERWISE
ENDCASE
NEXT
RETURN NIL
STATIC FUNCTION LoadBMP(cRes,cBMP,aSize)
LOCAL oBMP := ExXbpBitmap():new():create()
LOCAL nPosi := AT(";",cRes)
LOCAL cFile
IF nPosi > 0
cFile := SUBSTR(cRes,1,nPosi-1)+"\"+cBMP
IF FILE(cFile)
oBMP:loadFile(cFile)
oBMP := BMP2BMP(oBMP,aSize)
ENDIF
ELSEIF FILE("fire.bmp")
oBMP:loadFile("fire.bmp")
oBMP := BMP2BMP(oBMP,aSize)
ENDIF
RETURN oBMP
STATIC FUNCTION BMP2BMP(oBMP,aXbpSize)
LOCAL oHuge, oTiny, oPS, oRet
IF aXbpSize[2] > 0
oHuge := oBMP
oTiny := XbpBitmap():New():Create()
oTiny:Make(aXbpSize[1],aXbpSize[2])
oPS := XbpPresSpace():new()
oTiny:presSpace(oPS)
oHuge:Draw(oPS,{0,0,aXbpSize[1],aXbpSize[2]},,,GRA_BLT_BBO_IGNORE)
oRet := oTiny
ELSE
oRet := oBMP
ENDIF
RETURN oRet
CLASS ExXbpBitmap FROM XbpBitmap
EXPORTED:
METHOD Load
ENDCLASS
METHOD ExXbpBitmap:Load(cDll,nID,cType)
LOCAL xResource
LOCAL lSuccess
DEFAULT cDll TO "WM9DLL.DLL"
IF EMPTY(cType)
lSuccess :=::XbpBitmap:load(cDll,nID)
ELSE
xResource := LoadResource(nID,cDll,cType)
lSuccess := !EMPTY(xResource)
::setBuffer(xResource)
ENDIF
RETURN (lSuccess)
******************************************************************
* original Hybrid Version
******************************************************************
#ELSE // __XPPGUI__
PROCEDURE MAIN
PRIVATE ID_USER := "Tetris" // for XppError
PRIVATE ID_VERSION := C_VERSION
PRIVATE ZPATH := LEFT(AppName(.t.),LEN(AppName(.t.)) - LEN(AppName(.f.)))
CLIP_TRIS()
RETURN
#ENDIF
FUNCTION CLIP_TRIS()
LOCAL aEnv, aBlocks, aBoard, aCurBlock, aColor, aCargo
LOCAL nKey, cKey, lAllDrop, lNoExit
Make_Env_Win(@aEnv)
Make_Var(@aBlocks, @aBoard, @aColor, @aCargo)
lAllDrop := .F.
lNoExit := .T.
DO WHILE lNoExit
#IFDEF CL50
BEGINPAINT()
#ELSE
#IFDEF XPPGUI
#ELSE
DISPBEGIN()
#ENDIF
#ENDIF
cKey := UPPER(CHR(nKey := INKEY()))
DO CASE
CASE nKey == K_ESC
lNoExit := .F.
CASE cKey == "N"
Init_Game(aBlocks, aBoard, @aCurBlock, aCargo)
Draw_Block(aCurBlock, aColor, aCargo, .T.)
CASE aCargo[CG_N_GAME] != N_GAME_OVER
DO CASE
CASE aCargo[CG_N_GAME] == N_PAUSED .AND. nKey != 0
aCargo[CG_N_GAME] := N_PLAYED
CASE cKey == "P"
aCargo[CG_N_GAME] := N_PAUSED
CASE nKey == K_UP .OR. nKey == K_DOWN
Draw_Block(aCurBlock, aColor, aCargo, .F.)
Rotate_Block(@aCurBlock, aCargo, IF(nKey == K_UP, K_LEFT, K_RIGHT))
IF Hit_Block(aBoard, aCurBlock, aCargo)
Rotate_Block(@aCurBlock, aCargo, IF(nKey == K_UP, K_RIGHT, K_LEFT))
ENDIF
Draw_Block(aCurBlock, aColor, aCargo, .T.)
CASE nKey == K_LEFT .OR. nKey == K_RIGHT
Draw_Block(aCurBlock, aColor, aCargo, .F.)
aCargo[CG_N_BLOCK_COL] += IF(nKey == K_LEFT, -2, 2)
IF Hit_Block(aBoard, aCurBlock, aCargo)
aCargo[CG_N_BLOCK_COL] += IF(nKey == K_LEFT, 2, -2)
ENDIF
Draw_Block(aCurBlock, aColor, aCargo, .T.)
CASE nKey == K_SPACE
lAllDrop := .T.
ENDCASE
ENDCASE
IF aCargo[CG_N_GAME] == N_PLAYED
IF lAllDrop .OR. Tic_Tac(aCargo[CG_N_CUR_WAIT], aCargo[CG_N_INIT_TIK])
Draw_Block(aCurBlock, aColor, aCargo, .F.)
aCargo[CG_N_BLOCK_ROW]++
IF Hit_Block(aBoard, aCurBlock, aCargo)
aCargo[CG_N_BLOCK_ROW]--
Draw_Block(aCurBlock, aColor, aCargo, .T.)
Place_Block(aBlocks, aBoard, @aCurBlock, aColor, aCargo)
lAllDrop := .F.
ENDIF
Draw_Block(aCurBlock, aColor, aCargo, .T.)
aCargo[CG_N_INIT_TIK] := SECONDS()
ENDIF
ENDIF
Disp_Score(aBlocks, aColor, aCargo)
#IFDEF CL50
ENDPAINT()
#ELSE
#IFDEF XPPGUI
SLEEP(10)
#ELSE
DISPEND()
#ENDIF
#ENDIF
ENDDO
Rest_Env(aEnv, aCargo)
RETURN (NIL)
STATIC FUNCTION SHADOW (nT, nL, nB, nR)
LOCAL cVerbuff, cHorBuff
RESTSCREEN (nT, nR - 1, nB - 1, nR, ;
TRANSFORM(cVerbuff := SAVESCREEN (nT, nR - 1, nB - 1, nR), ;
REPLICATE("X" + CHR(8), LEN(cVerBuff)/2)))
RESTSCREEN (nB, nL, nB, nR, ;
TRANSFORM(cHorBuff := SAVESCREEN (nB, nL, nB, nR), ;
REPLICATE("X" + CHR(8), LEN(cHorBuff)/2)))
RETURN (NIL)
STATIC FUNCTION MAKE_ENV_WIN(aEnv, oMain) // control to keyhandler
#IFDEF XPPGUI
LOCAL oDraw := oMain:drawingArea
LOCAL aSize := oDraw:currentsize()
LOCAL oXbp, oXbp1, oXbp2, oXbp3, oXbp4, oXbp5
LOCAL nCol, nRow
LOCAL aPP := {{XBP_PP_COMPOUNDNAME , FONT_DEFPROP_SMALL }, ;
{XBP_PP_FGCLR,GRA_CLR_BLACK},;
{XBP_PP_BGCLR,GraMakeRGBColor({153,199,255})}}
LOCAL bPP := {{XBP_PP_COMPOUNDNAME , FONT_DEFPROP_MEDIUM+FONT_STYLE_BOLD }, ;
{XBP_PP_FGCLR,GRA_CLR_BLACK},;
{XBP_PP_BGCLR,XBPSYSCLR_TRANSPARENT}}
LOCAL cPP := {{XBP_PP_COMPOUNDNAME , "12.Wingdings" }, ;
{XBP_PP_FGCLR,GRA_CLR_BLACK},;
{XBP_PP_BGCLR,GraMakeRGBColor({153,199,255})}}
aEnv := ARRAY(LEN_ENV)
nRow := 10
nCol := aSize[2] - 30
oXbp1 := XbpStatic():new(oDraw,,{nRow,nCol},{aSize[1]-20,24},bPP)
oXbp1:type := XBPSTATIC_TYPE_RAISEDRECT
oXbp1:create():show()
oXbp := XbpStatic():new(oXbp1,,{0,0},{aSize[1]-20,24},bPP)
oXbp:caption := "XppTris " + ID_VERSION + " for Xbase++ by AUGE_OHR"
oXbp:options := XBPSTATIC_TEXT_CENTER+XBPSTATIC_TEXT_VCENTER
oXbp:Lbdown := {| aPos,y,obj | MSGBOX("Yiu Software"+Chr(13)+;
"Siemensstrasse 14"+Chr(13)+;
"21509 Glinde"+Chr(13)+Chr(13)+;
"AUGE_OHR@WEB.DE","Info"),;
SetappFocus(oMain)}
oXbp:create():show()
nRow := 10
nCol := 2
oXbp1 := XbpStatic():new(oDraw,,{nRow,nCol},{aSize[1]-20,24},aPP)
oXbp1:caption := " " +;
" Rotation : Move : " +;
" Space Bar: Drop"
oXbp1:options := XBPSTATIC_TEXT_CENTER+XBPSTATIC_TEXT_VCENTER
oXbp1:create():show()
oXbp := XbpPushButton():new(oXbp1 , , { 0,0}, {30,24},aPP,.T.)
oXbp:caption := "~Esc"
oXbp:Tabstop := .T.
oXbp:create():Show()
oXbp:activate:= {|| PostAppEvent(xbeP_Keyboard,xbeK_ESC,,oDraw:setparent()), SetappFocus(oMain) }
oXbp := XbpPushButton():new(oXbp1 , , { 40,0}, {30,24},aPP,.T.)
oXbp:caption := "~New"
oXbp:Tabstop := .T.
oXbp:create():Show()
oXbp:activate:= {|| PostAppEvent(xbeP_Keyboard,ASC("N"),,oDraw:setparent()), SetappFocus(oMain) }
oXbp := XbpPushButton():new(oXbp1 , , { 80,0}, {40,24},aPP,.T.)
oXbp:caption := "~Pause"
oXbp:Tabstop := .T.
oXbp:create():Show()
oXbp:activate:= {|| PostAppEvent(xbeP_Keyboard,ASC("P"),,oDraw:setparent()), SetappFocus(oMain) }
oXbp2 := XbpStatic():new(oXbp1,,{176,0},{18,24},cPP,.T.)
oXbp2:caption := "ô"
oXbp2:options := XBPSTATIC_TEXT_CENTER+XBPSTATIC_TEXT_VCENTER
oXbp2:create():show()
oXbp3 := XbpStatic():new(oXbp1,,{234,0},{18,24},cPP,.T.)
oXbp3:caption := "ó"
oXbp3:options := XBPSTATIC_TEXT_CENTER+XBPSTATIC_TEXT_VCENTER
oXbp3:create():show()
#ELSE
aEnv := ARRAY(LEN_ENV)
aEnv[ENV_SCREEN] := SAVESCREEN (0, 0, MAXROW(), MAXCOL())
aEnv[ENV_CURSOR] := SETCURSOR(0)
aEnv[ENV_COLOR] := SETCOLOR("GR+/W")
aEnv[ENV_ROW] := ROW()
@ 0, 0 SAY PADC("ClipTris V" + C_VERSION + " - Philippe Bonnardel - " +;
C_YEAR, MAXCOL() + 1)
@ MAXROW(), 0 SAY PADC("Exit: Escape New: N Pause: P " +;
CHR(24) + "/" + CHR(25) + ": Rotation " +;
CHR(27) + "/" + CHR(26) + ": Move " +;
"Space Bar: Drop", MAXCOL() + 1)
RESTSCREEN (1, 0, MAXROW() - 1, MAXCOL(), ;
REPLICATE (C_MASK, ((MAXCOL() + 1) * (MAXROW() - 1)) / 2))
SETCOLOR("BG/" + C_BOARD_CLR)
@ WIN_UP, WIN_LEFT, WIN_UP + BD_HEIGHT + 1, ;
WIN_LEFT + BD_WIDTH + ST_WIDTH + 2 BOX B_SINGLE + SPACE(1)
SHADOW(WIN_UP + 1, WIN_LEFT + 2, WIN_UP + BD_HEIGHT + 2, ;
WIN_LEFT + BD_WIDTH + ST_WIDTH + 4)
@ WIN_UP, WIN_LEFT, WIN_UP + BD_HEIGHT + 1, WIN_LEFT + BD_WIDTH + 1 BOX B_SINGLE
@ WIN_UP, WIN_LEFT + BD_WIDTH + 1 SAY "┬"
@ WIN_UP + BD_HEIGHT + 1, WIN_LEFT + BD_WIDTH + 1 SAY "┴"
SETCOLOR("W+/" + C_BOARD_CLR)
AEVAL(A_STATE, {|x| SETPOS(N_ROW_TEXT + x[1], N_COL_TEXT), QQOUT(x[2])})
@ N_NEXT_BLOCK_ROW, N_COL_TEXT SAY "Next :"
#ENDIF
RETURN (NIL)
STATIC FUNCTION REST_ENV(aEnv, aCargo, ljustSave)
LOCAL nHandle
DEFAULT ljustSave TO .F.
IF aCargo[CG_N_INIT_SCORE] != aCargo[CG_N_HIGH_SCORE]
nHandle := FCREATE(C_FILE_NAME)
IF nHandle != - 1
FWRITE(nHandle, NTRIM(aCargo[CG_N_HIGH_SCORE]))
FCLOSE(nHandle)
ENDIF
ENDIF
#IFDEF XPPGUI
// nothing for GUI
#ELSE
IF .NOT. ljustSave
RESTSCREEN(0, 0, MAXROW(), MAXCOL(), aEnv[ENV_SCREEN])
SETCURSOR(aEnv[ENV_CURSOR])
SETCOLOR(aEnv[ENV_COLOR])
SETPOS(aEnv[ENV_ROW], 0)
ENDIF
#ENDIF
RETURN (NIL)
STATIC FUNCTION MAKE_VAR(aBlocks, aBoard, aColor, aCargo)
LOCAL cBuffer, nHandle
aBlocks := {{.F.,.T.,.F.,.F.,; // O
.F.,.T.,.F.,.F.,; // O
.F.,.T.,.F.,.F.,; // O
.F.,.T.,.F.,.F.},; // O
{.F.,.T.,.T.,; // XX
.F.,.T.,.F.,; // X
.F.,.T.,.F.},; // X
{.T.,.T.,.F.,; //OO
.F.,.T.,.F.,; // O
.F.,.T.,.F.},; // O
{.F.,.T.,.F.,; // X
.T.,.T.,.T.,; //XXX
.F.,.F.,.F.},; //
{.T.,.T.,.F.,; //OO
.F.,.T.,.T.,; // OO
.F.,.F.,.F.},; //
{.F.,.T.,.T.,; // XX
.T.,.T.,.F.,; //XX
.F.,.F.,.F.},; //
{.T.,.T.,; //OO
.T.,.T.},; //OO
{.F.,.T.,.T.,; // XX
.F.,.T.,.F.,; // X
.F.,.T.,.T.},; // XX
{.F.,.T.,.T.,; // OO
.F.,.T.,.F.,; // O
.T.,.T.,.F.},; //OO
{.F.,.T.,.T.,; // XX
.F.,.T.,.T.,; // XX
.F.,.T.,.F.},; // X
{.F.,.T.,.F.,; // O
.F.,.T.,.F.,; // O
.F.,.T.,.F.},; // O
{.T.,.T.,.F.,; //XX
.F.,.T.,.T.,; // XX
.F.,.F.,.T.},; // X
{.F.,.T.,.F.,; // O
.F.,.T.,.F.,; // O
.T.,.T.,.T.},; //OOO
{.F.,.T.,.F.,; // X
.T.,.T.,.F.,; //XX
.F.,.T.,.T.}} // XX
aColor := {"W+", "G+", "GR+", "R+", "BG+", "B+", "RB+", "RB", "B", "BG",;
"R" , "GR", "G", "B"}
aBoard := ARRAY(BD_HEIGHT + 1, BD_WIDTH + 3)
aCargo := ARRAY(LEN_A_CARGO)
aCargo[CG_N_GAME] := N_GAME_OVER
aCargo[CG_N_RANDOM] := INT(SECONDS() * 1000)
aCargo[CG_N_CUR_WAIT] := N_INIT_WAIT
Init_Score(aCargo)
aCargo[CG_N_INIT_SCORE] := aCargo[CG_N_HIGH_SCORE] := 0
IF FILE(C_FILE_NAME)
nHandle := FOPEN(C_FILE_NAME)
IF nHandle != - 1
cBuffer := SPACE(N_LEN_SCORE)
FREAD(nHandle, @cBuffer, N_LEN_SCORE)
FCLOSE(nHandle)
aCargo[CG_N_HIGH_SCORE] := VAL(cBuffer)
ENDIF
ENDIF
RETURN (NIL)
STATIC FUNCTION DISP_SCORE(aBlocks, aColor, aCargo, oBrowse,aText)
STATIC nLast := 0
#IFDEF XPPGUI
LOCAL i,Imax
LOCAL cText
LOCAL bBlock
iMax := LEN(aText)
FOR i := 1 TO iMax
bBlock := A_STATE[i][4]
cText := EVAL( bBlock,aCargo )
aText[i]:setCaption(cText)
NEXT
#ELSE
AEVAL(A_STATE, {|x| SETCOLOR(x[3]+C_BOARD_CLR), ;
SETPOS(N_ROW_TEXT + x[1], N_COL_SCORE), ;
QQOUT(EVAL(x[4],aCargo))})
#ENDIF
#IFDEF XPPGUI
/*
while Preview will update too much
i move it to PLACE_BLOCK()
*/
#ELSE
IF aCargo[CG_N_LEVEL] >= N_LEVEL_ADD_BLOCKS
REST_ENV( , aCargo, .T.)
Draw_Next_Block(aBlocks, aColor, aCargo, oBrowse)
ENDIF
#ENDIF
RETURN (NIL)
STATIC FUNCTION INIT_SCORE(aCargo)
aCargo[CG_N_SCORE] := 0
aCargo[CG_N_COUNT_LINES] := 0
aCargo[CG_N_COUNT_BLOCKS] := 0
aCargo[CG_N_LEVEL] := N_MIN_LEVEL
RETURN (NIL)
STATIC FUNCTION RANDOM_BLOCK(aCargo, nMax)
#define IM 7875
#define IA 421
#define IC 1663
LOCAL nVal := 1
#IFDEF XPPGUI
IF aCargo[CG_N_LEVEL] >= N_LEVEL_ADD_BLOCKS
aCargo[CG_N_RANDOM] := INT(RAND(CG_N_RANDOM))
nVal := INT(RAND(CG_N_RANDOM))
IF( nVal < 1 , nVal := 1 , NIL)
IF( nVal > INT(CG_N_RANDOM), nVal := INT(CG_N_RANDOM), NIL)
ELSE
aCargo[CG_N_RANDOM] := INT(RAND(CG_N_RANDOM/2))
nVal := INT(RAND(CG_N_RANDOM/2))
IF( nVal < 1 , nVal := 1 , NIL)
IF( nVal > INT(CG_N_RANDOM/2), nVal := INT(CG_N_RANDOM/2), NIL)
ENDIF
#ELSE
aCargo[CG_N_RANDOM] := (aCargo[CG_N_RANDOM] * IA + IC) % IM
nVal := (INT((aCargo[CG_N_RANDOM] / IM) * nMax) + 1)
IF( nVal < 1 , nVal := 1 , NIL)
IF( nVal > INT(CG_N_RANDOM), nVal := INT(CG_N_RANDOM), NIL)
#ENDIF
RETURN nVal
STATIC FUNCTION TIC_TAC(nXms, nTop)
LOCAL nTic, nTac, nElapsed
nTac := INT((nXms / 55) + IF(nXms % 55 > 0, 1, 0))
nElapsed := INT((SECONDS() - nTop) * 1000)
nTic := INT((IF(nElapsed < 0, nElapsed += 86400000, nElapsed) / 55) + ;
IF(nElapsed % 55 > 0, 1, 0))
RETURN(IF(nTic >= nTac, .T., .F.))
STATIC FUNCTION INIT_GAME(aBlocks, aBoard, aCurBlock, aCargo,oPView)
LOCAL i, j
#IFDEF XPPGUI
FOR i = 1 TO 18
AFILL(aPlayground[i],"0")
NEXT
#ELSE
@ WIN_UP + 1, WIN_LEFT + 1 CLEAR TO WIN_UP + BD_HEIGHT, WIN_LEFT + BD_WIDTH
#ENDIF
FOR i := 1 TO BD_HEIGHT
FOR j := 2 TO BD_WIDTH + 1
aBoard[i,j] := N_EMPTY
NEXT
aBoard[i,1] := aBoard[i,BD_WIDTH+2] := aBoard[i,BD_WIDTH+3] := N_BORDURE
NEXT
AFILL(aBoard[i], N_BORDURE)
aCargo[CG_N_GAME] := N_PLAYED
aCargo[CG_N_CUR_WAIT] := N_INIT_WAIT
aCargo[CG_N_MAX_BLOCKS] := N_INIT_MAX_BLOCKS
aCargo[CG_N_NEXT_BLOCK] := Random_Block(aCargo, aCargo[CG_N_MAX_BLOCKS])
Init_Score(aCargo)
#IFDEF XPPGUI
Clear_Next_Block(oPView)
#ELSE
Clear_Next_Block()
#ENDIF
New_Block(aBlocks, aBoard, @aCurBlock, aCargo)
aCargo[CG_N_INIT_TIK] := SECONDS()
RETURN (NIL)
STATIC FUNCTION CLEAR_NEXT_BLOCK(oPView)
#IFDEF XPPGUI
aPView := LeerPView()
oPView:refreshAll()
#ELSE
@ N_NEXT_BLOCK_ROW, N_COL_SCORE CLEAR TO ;
N_NEXT_BLOCK_ROW + 3, N_COL_SCORE + 7
#ENDIF
RETURN (NIL)
STATIC FUNCTION NEW_BLOCK(aBlocks, aBoard, aCurBlock, aCargo)
LOCAL i
aCargo[CG_N_CUR_BLOCK] := aCargo[CG_N_NEXT_BLOCK]
aCargo[CG_N_NEXT_BLOCK] := Random_Block(aCargo, aCargo[CG_N_MAX_BLOCKS])
IF ++aCargo[CG_N_COUNT_BLOCKS] % N_BLOCKS_PER_LEVEL == 0 .AND.;
aCargo[CG_N_CUR_WAIT] > 0
IF ++aCargo[CG_N_LEVEL] == N_LEVEL_ADD_BLOCKS
aCargo[CG_N_CUR_WAIT] := N_INIT_WAIT - N_TIME_PER_LEVEL
aCargo[CG_N_MAX_BLOCKS] := LEN(aBlocks[aCargo[CG_N_CUR_BLOCK]])
ELSE
aCargo[CG_N_CUR_WAIT] -= N_TIME_PER_LEVEL
ENDIF
ENDIF
aCargo[CG_N_SCORE] += aCargo[CG_N_LEVEL] * N_PT_PER_BLOCK
IF aCargo[CG_N_SCORE] > aCargo[CG_N_HIGH_SCORE]
aCargo[CG_N_HIGH_SCORE] := aCargo[CG_N_SCORE]
ENDIF
aCargo[CG_N_BLOCK_SIZE] := LEN(aBlocks[aCargo[CG_N_CUR_BLOCK]]) ^ 0.5
aCargo[CG_N_BLOCK_ROW] := 0
aCargo[CG_N_BLOCK_COL] := BD_WIDTH / 2
aCurBlock := ACLONE(aBlocks[aCargo[CG_N_CUR_BLOCK]])
IF Hit_Block(aBoard, aCurBlock, aCargo)
ACOPY(aCurBlock, aCurBlock, aCargo[CG_N_BLOCK_SIZE] + 1)
AFILL(aCurBlock, .F., LEN(aCurBlock) - aCargo[CG_N_BLOCK_SIZE] + 1)
DO WHILE Hit_Block(aBoard, aCurBlock, aCargo)
ACOPY(aCurBlock, aCurBlock, aCargo[CG_N_BLOCK_SIZE] + 1)
ENDDO
aCargo[CG_N_GAME] := N_GAME_OVER
ENDIF
RETURN (NIL)
STATIC FUNCTION DRAW_BLOCK(aCurBlock, aColor, aCargo, lDraw, oBrowse)
LOCAL i, j
#IFDEF XPPGUI
LOCAL nRow, nCol
LOCAL nNo := 0
FOR i := 0 TO aCargo[CG_N_BLOCK_SIZE] - 1
FOR j := 0 TO aCargo[CG_N_BLOCK_SIZE] - 1
IF aCurBlock[i*aCargo[CG_N_BLOCK_SIZE]+j+1]
nRow := aCargo[CG_N_BLOCK_ROW] + i + 1
nCol := aCargo[CG_N_BLOCK_COL] + j*2 -1
nNo := aCargo[CG_N_CUR_BLOCK]
IF ISINFIELD(nRow,nCol)
aPlayground[nRow][nCol] := IF(lDraw, NTRIM(nNo), "0")
aPlayground[nRow][nCol+1] := IF(lDraw, NTRIM(nNo), "0")
ENDIF
ENDIF
NEXT
NEXT
oBrowse:refreshAll()
#ELSE
SETCOLOR(IF(lDraw, aColor[aCargo[CG_N_CUR_BLOCK]], C_BOARD_CLR + "/" + C_BOARD_CLR))
FOR i := 0 TO aCargo[CG_N_BLOCK_SIZE] - 1
FOR j := 0 TO aCargo[CG_N_BLOCK_SIZE] - 1
IF aCurBlock[i*aCargo[CG_N_BLOCK_SIZE]+j+1]
@ aCargo[CG_N_BLOCK_ROW] + WIN_UP + i + 1, ;
aCargo[CG_N_BLOCK_COL] + WIN_LEFT + j*2 - 1 SAY C_ELEMENT
ENDIF
NEXT
NEXT
#ENDIF
RETURN (NIL)
STATIC FUNCTION DRAW_BCKGND(aBoard, aColor,oBrowse)
LOCAL i, j
#IFDEF XPPGUI
LOCAL nRow, nCol
LOCAL nNo := 0
FOR i := 1 TO BD_HEIGHT
FOR j := 2 TO BD_WIDTH STEP 2
IF aBoard[i,j] != N_EMPTY
nNo := aBoard[i,j]
ELSE
nNo := 0
ENDIF
nRow := i
nCol := j - 1
IF ISINFIELD(nRow,nCol)
aPlayground[nRow][nCol] := NTRIM(nNo)
aPlayground[nRow][nCol+1] := NTRIM(nNo)
ENDIF
NEXT
NEXT
oBrowse:refreshAll()
#ELSE
FOR i := 1 TO BD_HEIGHT
FOR j := 2 TO BD_WIDTH STEP 2
SETCOLOR(IF (aBoard[i,j] != N_EMPTY, aColor[aBoard[i,j]], C_BOARD_CLR + "/" +C_BOARD_CLR))
@ WIN_UP + i, WIN_LEFT + j - 1 SAY C_ELEMENT
NEXT
NEXT
#ENDIF
RETURN(NIL)
STATIC FUNCTION DRAW_NEXT_BLOCK(aBlocks, aColor, aCargo,oBrowse,oPView)
LOCAL i, j, nSize
#IFDEF XPPGUI
LOCAL nRow, nCol
LOCAL nNo := aCargo[CG_N_NEXT_BLOCK]
nSize := LEN(aBlocks[aCargo[CG_N_NEXT_BLOCK]] ) ^ 0.5
oPView:show()
Clear_Next_Block(oPView)
FOR i := 0 TO nSize - 1
FOR j := 0 TO nSize - 1
IF aBlocks[aCargo[CG_N_NEXT_BLOCK],i*nSize+j+1]
nRow := i + 1 // N_NEXT_BLOCK_ROW
nCol := j*2 + 1 // N_COL_SCORE
aPView[nRow][nCol] := NTRIM(nNo)
aPView[nRow][nCol+1] := NTRIM(nNo)
ENDIF
NEXT
NEXT
oPView:refreshAll()
#ELSE
SETCOLOR(aColor[aCargo[CG_N_NEXT_BLOCK]])
nSize := LEN(aBlocks[aCargo[CG_N_NEXT_BLOCK]] ) ^ 0.5
Clear_Next_Block()
FOR i := 0 TO nSize - 1
FOR j := 0 TO nSize - 1
IF aBlocks[aCargo[CG_N_NEXT_BLOCK],i*nSize+j+1]
@ N_NEXT_BLOCK_ROW + i, N_COL_SCORE + j*2 SAY C_ELEMENT
ENDIF
NEXT
NEXT
#ENDIF
RETURN (NIL)
STATIC FUNCTION ROTATE_BLOCK(aCurBlock, aCargo, nSens)
LOCAL i, j, aTmpBlock
DO CASE
CASE aCargo[CG_N_BLOCK_SIZE] == 4
aTmpBlock := ARRAY(LEN(aCurBlock))
IF nSens == K_LEFT
FOR i := 0 TO 3
FOR j := 0 TO 3
aTmpBlock[i*4+j+1] := aCurBlock[j*4+i+1]
NEXT
NEXT
ELSE
FOR i := 0 TO 3
FOR j := 0 TO 3
aTmpBlock[j*4+i+1] := aCurBlock[i*4+j+1]
NEXT
NEXT
ENDIF
aCurBlock := aTmpBlock
CASE aCargo[CG_N_BLOCK_SIZE] == 3
aTmpBlock := ARRAY(LEN(aCurBlock))
IF nSens == K_LEFT
FOR i := 0 TO 2
FOR j := 0 TO 2
aTmpBlock[(2-j)*3+i+1] := aCurBlock[i*3+j+1]
NEXT
NEXT
ELSE
FOR i := 0 TO 2
FOR j := 0 TO 2
aTmpBlock[i*3+j+1] := aCurBlock[(2-j)*3+i+1]
NEXT
NEXT
ENDIF
aCurBlock := aTmpBlock
ENDCASE
RETURN (NIL)
STATIC FUNCTION HIT_BLOCK(aBoard, aCurBlock, aCargo)
LOCAL i,j
FOR i := 0 TO aCargo[CG_N_BLOCK_SIZE] - 1
FOR j := 0 TO aCargo[CG_N_BLOCK_SIZE] - 1
IF aCurBlock[i*aCargo[CG_N_BLOCK_SIZE]+j+1] .AND.;
aBoard[aCargo[CG_N_BLOCK_ROW]+i+1,aCargo[CG_N_BLOCK_COL]+j*2+1] != N_EMPTY
RETURN(.T.)
ENDIF
NEXT
NEXT
RETURN (.F.)
STATIC FUNCTION PLACE_BLOCK(aBlocks, aBoard, aCurBlock, aColor, aCargo,oBrowse,oPView)
LOCAL i,j, nLines
FOR i := 0 TO aCargo[CG_N_BLOCK_SIZE] -1
FOR j := 0 TO aCargo[CG_N_BLOCK_SIZE] -1
IF aCurBlock[i*aCargo[CG_N_BLOCK_SIZE]+j+1]
aBoard[aCargo[CG_N_BLOCK_ROW]+i+1,aCargo[CG_N_BLOCK_COL]+j*2] := ;
aBoard[aCargo[CG_N_BLOCK_ROW]+i+1,aCargo[CG_N_BLOCK_COL]+j*2+1] := ;
aCargo[CG_N_CUR_BLOCK]
ENDIF
NEXT
NEXT
IF Remove_Lines(aBoard, @nLines)
TONE(1100,1)
TONE(1500,1)
Draw_BckGnd(aBoard, aColor,oBrowse)
aCargo[CG_N_SCORE] += (aCargo[CG_N_LEVEL] * N_PT_PER_LINE) * nLines
aCargo[CG_N_COUNT_LINES] += nLines
ELSE
Draw_Block(aCurBlock, aColor, aCargo, .T.,oBrowse)
ENDIF
New_Block(aBlocks, aBoard, @aCurBlock, aCargo,oBrowse)
#IFDEF XPPGUI // moved from DISP_SCORE()
IF aCargo[CG_N_LEVEL] >= N_LEVEL_ADD_BLOCKS
REST_ENV( , aCargo, .T.)
Draw_Next_Block(aBlocks, aColor, aCargo, oBrowse,oPView)
ENDIF
#ENDIF
RETURN (NIL)
STATIC FUNCTION REMOVE_LINES(aBoard, nLines)
LOCAL i,j,k,l, bRemove
bRemove := .F.
i := BD_HEIGHT
nLines := 0
DO WHILE i >= 1
FOR j := 2 TO BD_WIDTH + 1
IF aBoard[i,j] == N_EMPTY
EXIT
ENDIF
NEXT
IF j > BD_WIDTH + 1
FOR k := i TO 2 STEP - 1
FOR l := 2 TO BD_WIDTH + 1
aBoard[k,l] := aBoard[k-1,l]
NEXT
FOR l := 2 TO BD_WIDTH + 1
aBoard[1,l] := N_EMPTY
NEXT
NEXT
bRemove := .T.
nLines++
ELSE
i--
ENDIF
ENDDO
RETURN(bRemove)
*
* EOF
*