TheGameCreators - CodeBase

Return to the CodeBase listing

Category: Complete Applications

Version: 1.0

Information

Uploaded: 16th Feb 2009 13:05

Modified: 1st Jan 1970 01:00

Author: Anonymous Coder

Summary

application game like tetris

Full Description

DarkBASIC Professional Source Code

` This code was downloaded from The Game Creators

` It is reproduced here with full permission

` http://www.thegamecreators.com

Rem Project: tetris_pr01

Rem Created: Monday, February 09, 2009

Rem ***** Main Source File *****

// sync on

// set dir "media"

// load image "ts02.jpg",1

// load image "ts02.jpg",2

// load image "ts04.jpg",3

// load image "titretetris.jpg",4

// load image "helptetris.jpg",5

rem

create bitmap 1,27,27

set current bitmap 1

INK RGB(255,255,0),RGB(0,0,255)

//PRINT "YELLOW IN BLUE"

box 0,0,27,27

INK RGB(0,0,255),RGB(255,0,0)

box 2,2,25,25

get image 1,0,0,27,27

delete bitmap 1

create bitmap 2,27,27

set current bitmap 2

INK RGB(0,0,0),RGB(255,0,0)

box 0,0,27,27

get image 2,0,0,27,27

delete bitmap 2

INK RGB(95,0,255),RGB(255,0,0)

rem

//global comin(13)

global dim tempin$(13,8)

global score

global spl1=130

global spl2=30

global spl

global kx

global ky

global cc

global mp_x

global bk1=1

global bk2=1

global bk3=1

global bk4=1

global bk5=1

global false=0

global true=-1

global st_blok=0

global dim mp_tetris$(4,4)

global dim mp_map$(16,14)

global dim mp_trs$(14,9)

rem

for k=1 to 13

for j=1 to 8

mp_trs$(k,j)="0"

next j

next k

restore mydata

for k=1 to 4

for j=1 to 4

read aa

aaa$=str$(aa)

mp_tetris$(k,j)=aaa$

set cursor j*10,k*10

// print mp_tetris$(k,j)

next j

next k

restore mymap

for k=1 to 16

for j=1 to 14

read aa

aaa$=str$(aa)

mp_map$(k,j)=aaa$

set cursor j*10,k*10

print mp_map$(k,j)

next j

next k

a=27*4+10

b=27+10

cls

randomize timer()

cls

if spacekey() then gosub resetgame

gosub resmap  rem ricalcola mappa

gosub dismap rem display mappa video

if st_blok=false

mp_x= rnd(4)+1

a=27*4+10

b=27+10

cc=a

ky=1

//bk1=1: bk2=1: bk3=1: bk4=1: bk5=1

st_blok=true

//gosub blok

endif

gosub blok

sync

loop

//wait key

end

rem data =============

dismap:

// SET TEXT SIZE 60

// s$=str$(score)

// CENTER TEXT 320,240,s$

for k=1 to 16

for j=1 to 14

if mp_map$(k,j)="1"

paste image 1,(j*27)+10,(k*27)+10

endif

if mp_map$(k,j)="0"

paste image 2,(j*27)+10,(k*27)+10

endif

next j

next k

for k=1 to 13

for j=1 to 8

if mp_trs$(k,j)="0"

paste image 2,(j*27)+(27*3)+10,(k*27)+10

endif

if mp_trs$(k,j)="1"

paste image 1,(j*27)+(27*3)+10,(k*27)+10

endif

next j

next k

gosub gameover

SET TEXT SIZE 30

s$=str$(score)

TEXT 420,350,"score:"+s$

SET TEXT SIZE 25

s$="by:vitaluciano@hotmail.fr"

TEXT 420,410,s$

return

rem ================blok =============================

blok:

select  mp_x

case 1

gosub blok1

//text 500,20,"go "+str$(ky)

for k=1 to 4

for j =1 to 4

if mp_tetris$(k,j)="1" then paste image 1,a,b

if mp_tetris$(k,j)="2" then paste image 1,a+27,b

if mp_tetris$(k,j)="3" then paste image 1,a,b+27

if mp_tetris$(k,j)="4" then paste image 1,a+27,b+27

next j

next k

gosub dwnk

sleep spl

b=b+3

if (b-37) mod 27 = 0

ky=((b-37)/27)+1

endif

if rightkey()

a=a+27

kxx=(((27*3)-a)/27)*-1

if kxx<7 and  mp_trs$(ky,kx+2)="1" or  mp_trs$(ky+2,kx+2)="1" then a=a-27

endif

if leftkey()

a=a-27

kxx=(((27*3)-a)/27)*-1

if kxx>1 and  mp_trs$(ky,kx-1)="1" or  mp_trs$(ky+2,kx-1)="1" then a=a+27

endif

// text 500,20,"go "+str$(ky)+" "+str$(kx)

if a<=((27*4)+10) then a=27*4+10

if a>=((27*10)+10) then a=27*10+10

kx=(((27*3)-a)/27)*-1

if mp_trs$(ky+2,kx)="1"

mp_trs$(ky,kx)="1"

mp_trs$(ky,kx+1)="1"

mp_trs$(ky+1,kx)="1"

mp_trs$(ky+1,kx+1)="1"

st_blok=false

endif

if mp_trs$(ky+2,kx+1)="1"

mp_trs$(ky,kx)="1"

mp_trs$(ky,kx+1)="1"

mp_trs$(ky+1,kx)="1"

mp_trs$(ky+1,kx+1)="1"

st_blok=false

endif

if b>=((27*12)+10)

b=27*12+10

mp_trs$(ky,kx)="1"

mp_trs$(ky,kx+1)="1"

mp_trs$(ky+1,kx)="1"

mp_trs$(ky+1,kx+1)="1"

st_blok=false

endif

endcase

case 2

if upkey() then inc bk2,1

if bk2>4 then bk2=1

if bk2=1

gosub blok2

//     text 500,20,"goup1 "+str$(bk2)

// text 500,20,"go "+str$(mp_x)

for k=1 to 4

for j =1 to 4

if mp_tetris$(k,j)="1" then paste image 1,a,b

if mp_tetris$(k,j)="2" then paste image 1,a,b+27

if mp_tetris$(k,j)="3" then paste image 1,a+27,b+27

if mp_tetris$(k,j)="4" then paste image 1,a+27+27,b+27

next j

next k

gosub dwnk

sleep spl

b=b+3

if (b-37) mod 27 = 0

ky=((b-37)/27)+1

endif

if rightkey()

a=a+27

kxx=(((27*3)-a)/27)*-1

if kxx<6 and  mp_trs$(ky,kx+3)="1" or  mp_trs$(ky+1,kx+3)="1" then a=a-27

endif

if leftkey()

a=a-27

kxx=(((27*3)-a)/27)*-1

if kxx>1 and  mp_trs$(ky,kx-1)="1" or  mp_trs$(ky+1,kx-1)="1" then a=a+27

endif

if a<=((27*4)+10) then a=27*4+10

if a>=((27*10)+10) then a=27*9+10

kx=(((27*3)-a)/27)*-1

if mp_trs$(ky+2,kx)="1"

mp_trs$(ky,kx)="1"

mp_trs$(ky+1,kx)="1"

mp_trs$(ky+1,kx+1)="1"

mp_trs$(ky+1,kx+2)="1"

st_blok=false

endif

if mp_trs$(ky+2,kx+1)="1"

mp_trs$(ky,kx)="1"

mp_trs$(ky+1,kx)="1"

mp_trs$(ky+1,kx+1)="1"

mp_trs$(ky+1,kx+2)="1"

st_blok=false

endif

if mp_trs$(ky+2,kx+2)="1"

mp_trs$(ky,kx)="1"

mp_trs$(ky+1,kx)="1"

mp_trs$(ky+1,kx+1)="1"

mp_trs$(ky+1,kx+2)="1"

st_blok=false

endif

if b>=((27*12)+10)

b=27*12+10

mp_trs$(ky,kx)="1"

mp_trs$(ky+1,kx)="1"

mp_trs$(ky+1,kx+1)="1"

mp_trs$(ky+1,kx+2)="1"

st_blok=false

endif

rem

if bk2=2

gosub blok2l2

//    text 500,20,"goup "+str$(bk2)

for k=1 to 4

for j =1 to 4

if mp_tetris$(k,j)="1" then paste image 1,a,b+27+27

if mp_tetris$(k,j)="2" then paste image 1,a+27,b+27+27

if mp_tetris$(k,j)="3" then paste image 1,a+27,b+27

if mp_tetris$(k,j)="4" then paste image 1,a+27,b

next j

next k

gosub dwnk

sleep spl

b=b+3

if (b-37) mod 27 = 0

ky=((b-37)/27)+1

endif

if rightkey()

a=a+27

kxx=(((27*3)-a)/27)*-1

if kxx<7 and  mp_trs$(ky,kx+2)="1" or  mp_trs$(ky+1,kx+2)="1"  or  mp_trs$(ky+2,kx+2)="1" then a=a-27

endif

if leftkey()

a=a-27

kxx=(((27*3)-a)/27)*-1

if kxx>1 and  mp_trs$(ky,kx-1)="1" or  mp_trs$(ky+1,kx-1)="1" or  mp_trs$(ky+2,kx-1)="1" then a=a+27

endif

if a<=((27*4)+10) then a=27*4+10

if a>=((27*10)+10) then a=27*10+10

kx=(((27*3)-a)/27)*-1

if mp_trs$(ky+3,kx+1)="1"

mp_trs$(ky,kx+1)="1"

mp_trs$(ky+1,kx+1)="1"

mp_trs$(ky+2,kx)="1"

mp_trs$(ky+2,kx+1)="1"

st_blok=false

endif

if mp_trs$(ky+3,kx)="1"

mp_trs$(ky,kx+1)="1"

mp_trs$(ky+1,kx+1)="1"

mp_trs$(ky+2,kx)="1"

mp_trs$(ky+2,kx+1)="1"

st_blok=false

endif

if b>=((27*11)+10)

b=27*12+10

mp_trs$(ky,kx+1)="1"

mp_trs$(ky+1,kx+1)="1"

mp_trs$(ky+2,kx)="1"

mp_trs$(ky+2,kx+1)="1"

st_blok=false

endif

rem

if bk2=3

gosub blok2l3

//    text 500,20,"goup "+str$(bk2)

for k=1 to 4

for j =1 to 4

if mp_tetris$(k,j)="1" then paste image 1,a,b

if mp_tetris$(k,j)="2" then paste image 1,a+27,b

if mp_tetris$(k,j)="3" then paste image 1,a+27+27,b

if mp_tetris$(k,j)="4" then paste image 1,a+27+27,b+27

next j

next k

gosub dwnk

sleep spl

b=b+3

if (b-37) mod 27 = 0

ky=((b-37)/27)+1

endif

if rightkey()

a=a+27

kxx=(((27*3)-a)/27)*-1

if kxx<6 and  mp_trs$(ky,kx+3)="1" or  mp_trs$(ky+1,kx+3)="1" then a=a-27

endif

if leftkey()

a=a-27

kxx=(((27*3)-a)/27)*-1

if kxx>1 and  mp_trs$(ky,kx-1)="1" or  mp_trs$(ky+1,kx+1)="1" then a=a+27 //or  mp_trs$(ky+1,kx-3)="1" then a=a+27

endif

if a<=((27*4)+10) then a=27*4+10

if a>=((27*10)+10) then a=27*9+10

kx=(((27*3)-a)/27)*-1

if mp_trs$(ky+1,kx)="1"

mp_trs$(ky,kx)="1"

mp_trs$(ky,kx+1)="1"

mp_trs$(ky,kx+2)="1"

mp_trs$(ky+1,kx+2)="1"

st_blok=false

endif

if mp_trs$(ky+1,kx+1)="1"

mp_trs$(ky,kx)="1"

mp_trs$(ky,kx+1)="1"

mp_trs$(ky,kx+2)="1"

mp_trs$(ky+1,kx+2)="1"

st_blok=false

endif

if mp_trs$(ky+2,kx+2)="1"

mp_trs$(ky,kx)="1"

mp_trs$(ky,kx+1)="1"

mp_trs$(ky,kx+2)="1"

mp_trs$(ky+1,kx+2)="1"

st_blok=false

endif

if b>=((27*12)+10)

b=27*12+10

mp_trs$(ky,kx)="1"

mp_trs$(ky,kx+1)="1"

mp_trs$(ky,kx+2)="1"

mp_trs$(ky+1,kx+2)="1"

st_blok=false

endif

rem

if bk2=4

gosub blok2l4

//    text 500,20,"goup "+str$(bk2)

for k=1 to 4

for j =1 to 4

if mp_tetris$(k,j)="1" then paste image 1,a,b

if mp_tetris$(k,j)="2" then paste image 1,a+27,b

if mp_tetris$(k,j)="3" then paste image 1,a,b+27

if mp_tetris$(k,j)="4" then paste image 1,a,b+27+27

next j

next k

gosub dwnk

sleep spl

b=b+3

if (b-37) mod 27 = 0

ky=((b-37)/27)+1

endif

if rightkey()

a=a+27

kxx=(((27*3)-a)/27)*-1

if kxx<7 and  mp_trs$(ky,kx+2)="1" or  mp_trs$(ky+1,kx+1)="1"  or  mp_trs$(ky+2,kx+1)="1" then a=a-27

endif

if leftkey()

a=a-27

kxx=(((27*3)-a)/27)*-1

if kxx>1 and  mp_trs$(ky,kx-1)="1" or  mp_trs$(ky+1,kx-1)="1" or  mp_trs$(ky+2,kx-1)="1" then a=a+27

endif

if a<=((27*4)+10) then a=27*4+10

if a>=((27*10)+10) then a=27*10+10

kx=(((27*3)-a)/27)*-1

if mp_trs$(ky+1,kx+1)="1"

mp_trs$(ky,kx)="1"

mp_trs$(ky,kx+1)="1"

mp_trs$(ky+1,kx)="1"

mp_trs$(ky+2,kx)="1"

st_blok=false

endif

if mp_trs$(ky+3,kx)="1"

mp_trs$(ky,kx)="1"

mp_trs$(ky,kx+1)="1"

mp_trs$(ky+1,kx)="1"

mp_trs$(ky+2,kx)="1"

st_blok=false

endif

if b>=((27*11)+10)

b=27*12+10

mp_trs$(ky,kx)="1"

mp_trs$(ky,kx+1)="1"

mp_trs$(ky+1,kx)="1"

mp_trs$(ky+2,kx)="1"

st_blok=false

endif

rem

endcase

case 3

if upkey() then inc bk3,1

if bk3>4 then bk3=1

if bk3=1

gosub blok3

// text 500,20,"go "+str$(mp_x)

for k=1 to 4

for j =1 to 4

if mp_tetris$(k,j)="1" then paste image 1,a+27+27,b

if mp_tetris$(k,j)="2" then paste image 1,a+27+27,b+27

if mp_tetris$(k,j)="3" then paste image 1,a+27,b+27

if mp_tetris$(k,j)="4" then paste image 1,a,b+27

next j

next k

gosub dwnk

sleep spl

b=b+3

if (b-37) mod 27 = 0

ky=((b-37)/27)+1

endif

if rightkey()

a=a+27

kxx=(((27*3)-a)/27)*-1

if kxx<6 and  mp_trs$(ky,kx+3)="1" or  mp_trs$(ky+1,kx+3)="1" then a=a-27

endif

if leftkey()

a=a-27

kxx=(((27*3)-a)/27)*-1

if kxx>1 and  mp_trs$(ky,kx+1)="1" or  mp_trs$(ky+1,kx-1)="1" then a=a+27 //or  mp_trs$(ky+1,kx-3)="1" then a=a+27

endif

if a<=((27*4)+10) then a=27*4+10

if a>=((27*10)+10) then a=27*9+10

kx=(((27*3)-a)/27)*-1

if mp_trs$(ky+2,kx+2)="1"

mp_trs$(ky,kx+2)="1"

mp_trs$(ky+1,kx)="1"

mp_trs$(ky+1,kx+1)="1"

mp_trs$(ky+1,kx+2)="1"

st_blok=false

endif

if mp_trs$(ky+2,kx+1)="1"

mp_trs$(ky,kx+2)="1"

mp_trs$(ky+1,kx)="1"

mp_trs$(ky+1,kx+1)="1"

mp_trs$(ky+1,kx+2)="1"

st_blok=false

endif

if mp_trs$(ky+2,kx)="1"

mp_trs$(ky,kx+2)="1"

mp_trs$(ky+1,kx)="1"

mp_trs$(ky+1,kx+1)="1"

mp_trs$(ky+1,kx+2)="1"

st_blok=false

endif

if b>=((27*12)+10)

b=27*12+10

mp_trs$(ky,kx+2)="1"

mp_trs$(ky+1,kx)="1"

mp_trs$(ky+1,kx+1)="1"

mp_trs$(ky+1,kx+2)="1"

st_blok=false

endif

rem

if bk3=2

gosub blok3ll2

// text 500,20,"go "+str$(mp_x)

for k=1 to 4

for j =1 to 4

if mp_tetris$(k,j)="1" then paste image 1,a,b

if mp_tetris$(k,j)="2" then paste image 1,a,b+27

if mp_tetris$(k,j)="3" then paste image 1,a,b+27+27

if mp_tetris$(k,j)="4" then paste image 1,a+27,b+27+27

next j

next k

gosub dwnk

sleep spl

b=b+3

if (b-37) mod 27 = 0

ky=((b-37)/27)+1

endif

if rightkey()

a=a+27

kxx=(((27*3)-a)/27)*-1

if kxx<7 and  mp_trs$(ky,kx+1)="1" or  mp_trs$(ky+1,kx+1)="1" or  mp_trs$(ky+2,kx+2)="1"  then a=a-27

endif

if leftkey()

a=a-27

kxx=(((27*3)-a)/27)*-1

if kxx>1 and  mp_trs$(ky,kx-1)="1" or  mp_trs$(ky+1,kx-1)="1"  or  mp_trs$(ky+2,kx-1)="1" then a=a+27

endif

if a<=((27*4)+10) then a=27*4+10

if a>=((27*10)+10) then a=27*10+10

kx=(((27*3)-a)/27)*-1

if mp_trs$(ky+3,kx)="1"

mp_trs$(ky,kx)="1"

mp_trs$(ky+1,kx)="1"

mp_trs$(ky+2,kx)="1"

mp_trs$(ky+2,kx+1)="1"

st_blok=false

endif

if mp_trs$(ky+3,kx+1)="1"

mp_trs$(ky,kx)="1"

mp_trs$(ky+1,kx)="1"

mp_trs$(ky+2,kx)="1"

mp_trs$(ky+2,kx+1)="1"

st_blok=false

endif

if b>=((27*11)+10)

b=27*12+10

mp_trs$(ky,kx)="1"

mp_trs$(ky+1,kx)="1"

mp_trs$(ky+2,kx)="1"

mp_trs$(ky+2,kx+1)="1"

st_blok=false

endif

rem

if bk3=3

gosub blok3ll3

// text 500,20,"go "+str$(mp_x)

for k=1 to 4

for j =1 to 4

if mp_tetris$(k,j)="1" then paste image 1,a,b

if mp_tetris$(k,j)="2" then paste image 1,a+27,b

if mp_tetris$(k,j)="3" then paste image 1,a+27+27,b

if mp_tetris$(k,j)="4" then paste image 1,a,b+27

next j

next k

gosub dwnk

sleep spl

b=b+3

if (b-37) mod 27 = 0

ky=((b-37)/27)+1

endif

if rightkey()

a=a+27

kxx=(((27*3)-a)/27)*-1

if kxx<6 and  mp_trs$(ky,kx+3)="1" or  mp_trs$(ky+1,kx+1)="1" then a=a-27

endif

if leftkey()

a=a-27

kxx=(((27*3)-a)/27)*-1

if kxx>1 and  mp_trs$(ky,kx-1)="1" or  mp_trs$(ky+1,kx-1)="1" then a=a+27

endif

if a<=((27*4)+10) then a=27*4+10

if a>=((27*10)+10) then a=27*9+10

kx=(((27*3)-a)/27)*-1

if   mp_trs$(ky+2,kx)="1"

mp_trs$(ky,kx)="1"

mp_trs$(ky,kx+1)="1"

mp_trs$(ky,kx+2)="1"

mp_trs$(ky+1,kx)="1"

st_blok=false

endif

if   mp_trs$(ky+1,kx+1)="1"

mp_trs$(ky,kx)="1"

mp_trs$(ky,kx+1)="1"

mp_trs$(ky,kx+2)="1"

mp_trs$(ky+1,kx)="1"

st_blok=false

endif

if   mp_trs$(ky+1,kx+2)="1"

mp_trs$(ky,kx)="1"

mp_trs$(ky,kx+1)="1"

mp_trs$(ky,kx+2)="1"

mp_trs$(ky+1,kx)="1"

st_blok=false

endif

if b>=((27*12)+10)

b=27*12+10

mp_trs$(ky,kx)="1"

mp_trs$(ky,kx+1)="1"

mp_trs$(ky,kx+2)="1"

mp_trs$(ky+1,kx)="1"

st_blok=false

endif

rem

if bk3=4

gosub blok3ll4

// text 500,20,"go "+str$(mp_x)

for k=1 to 4

for j =1 to 4

if mp_tetris$(k,j)="1" then paste image 1,a,b

if mp_tetris$(k,j)="2" then paste image 1,a+27,b

if mp_tetris$(k,j)="3" then paste image 1,a+27,b+27

if mp_tetris$(k,j)="4" then paste image 1,a+27,b+27+27

next j

next k

gosub dwnk

sleep spl

b=b+3

if (b-37) mod 27 = 0

ky=((b-37)/27)+1

endif

if rightkey()

a=a+27

kxx=(((27*3)-a)/27)*-1

if kxx<7 and  mp_trs$(ky,kx+2)="1" or  mp_trs$(ky+1,kx+2)="1"  or  mp_trs$(ky+2,kx+2)="1" then a=a-27

endif

if leftkey()

a=a-27

kxx=(((27*3)-a)/27)*-1

if kxx>1 and  mp_trs$(ky,kx-1)="1" or  mp_trs$(ky+1,kx)="1"  or  mp_trs$(ky+2,kx)="1" then a=a+27

endif

if a<=((27*4)+10) then a=27*4+10

if a>=((27*10)+10) then a=27*10+10

kx=(((27*3)-a)/27)*-1

if   mp_trs$(ky+1,kx)="1"

mp_trs$(ky,kx)="1"

mp_trs$(ky,kx+1)="1"

mp_trs$(ky+1,kx+1)="1"

mp_trs$(ky+2,kx+1)="1"

st_blok=false

endif

if   mp_trs$(ky+3,kx+1)="1"

mp_trs$(ky,kx)="1"

mp_trs$(ky,kx+1)="1"

mp_trs$(ky+1,kx+1)="1"

mp_trs$(ky+2,kx+1)="1"

st_blok=false

endif

if b>=((27*11)+10)

b=27*12+10

mp_trs$(ky,kx)="1"

mp_trs$(ky,kx+1)="1"

mp_trs$(ky+1,kx+1)="1"

mp_trs$(ky+2,kx+1)="1"

st_blok=false

endif

endcase

case 4

if upkey() then inc bk4,1

if bk4>2 then bk4=1

if bk4=1

gosub blok4

// text 500,20,"go "+str$(mp_x)

for k=1 to 4

for j =1 to 4

if mp_tetris$(k,j)="1" then paste image 1,a,b

if mp_tetris$(k,j)="2" then paste image 1,a,b+27

if mp_tetris$(k,j)="3" then paste image 1,a,b+27+27

if mp_tetris$(k,j)="4" then paste image 1,a,b+27+27+27

next j

next k

gosub dwnk

sleep spl

b=b+3

if (b-37) mod 27 = 0

ky=((b-37)/27)+1

endif

if rightkey()

a=a+27

kxx=(((27*3)-a)/27)*-1

if kxx<8 and  mp_trs$(ky,kx+1)="1" or  mp_trs$(ky+1,kx+1)="1" or  mp_trs$(ky+2,kx+1)="1"   or  mp_trs$(ky+3,kx+1)="1" then a=a-27

endif

if leftkey()

a=a-27

kxx=(((27*3)-a)/27)*-1

if kxx>1 and  mp_trs$(ky,kx-1)="1" or  mp_trs$(ky+1,kx-1)="1" or  mp_trs$(ky+2,kx-1)="1"   or  mp_trs$(ky+3,kx-1)="1" then a=a+27

endif

if a<=((27*4)+10) then a=27*4+10

if a>=((27*11)+10) then a=27*11+10

kx=(((27*3)-a)/27)*-1

if  mp_trs$(ky+4,kx)="1"

mp_trs$(ky,kx)="1"

mp_trs$(ky+1,kx)="1"

mp_trs$(ky+2,kx)="1"

mp_trs$(ky+3,kx)="1"

st_blok=false

endif

if b>=((27*10)+10)

b=27*10+10

mp_trs$(ky,kx)="1"

mp_trs$(ky+1,kx)="1"

mp_trs$(ky+2,kx)="1"

mp_trs$(ky+3,kx)="1"

st_blok=false

endif

rem

if bk4=2

gosub blok4i2

// text 500,20,"go "+str$(mp_x)

for k=1 to 4

for j =1 to 4

if mp_tetris$(k,j)="1" then paste image 1,a,b

if mp_tetris$(k,j)="2" then paste image 1,a+27,b

if mp_tetris$(k,j)="3" then paste image 1,a+27+27,b

if mp_tetris$(k,j)="4" then paste image 1,a+27+27+27,b

next j

next k

gosub dwnk

sleep spl

b=b+3

if (b-37) mod 27 = 0

ky=((b-37)/27)+1

endif

if rightkey()

a=a+27

kxx=(((27*3)-a)/27)*-1

if kxx<5 and  mp_trs$(ky,kx+4)="1" then a=a-27

endif

if leftkey()

a=a-27

kxx=(((27*3)-a)/27)*-1

if kxx>1 and  mp_trs$(ky,kx-1)="1" then a=a+27

endif

if a<=((27*4)+10) then a=27*4+10

if a>=((27*9)+10) then a=27*8+10

kx=(((27*3)-a)/27)*-1

if   mp_trs$(ky+1,kx)="1"

mp_trs$(ky,kx)="1"

mp_trs$(ky,kx+1)="1"

mp_trs$(ky,kx+2)="1"

mp_trs$(ky,kx+3)="1"

st_blok=false

endif

if   mp_trs$(ky+1,kx+1)="1"

mp_trs$(ky,kx)="1"

mp_trs$(ky,kx+1)="1"

mp_trs$(ky,kx+2)="1"

mp_trs$(ky,kx+3)="1"

st_blok=false

endif

if   mp_trs$(ky+1,kx+2)="1"

mp_trs$(ky,kx)="1"

mp_trs$(ky,kx+1)="1"

mp_trs$(ky,kx+2)="1"

mp_trs$(ky,kx+3)="1"

st_blok=false

endif

if   mp_trs$(ky+1,kx+3)="1"

mp_trs$(ky,kx)="1"

mp_trs$(ky,kx+1)="1"

mp_trs$(ky,kx+2)="1"

mp_trs$(ky,kx+3)="1"

st_blok=false

endif

if b>=((27*13)+10)

b=27*13+10

mp_trs$(ky,kx)="1"

mp_trs$(ky,kx+1)="1"

mp_trs$(ky,kx+2)="1"

mp_trs$(ky,kx+3)="1"

st_blok=false

endif

rem

endcase

case 5

if upkey() then inc bk5,1

if bk5>4 then bk5=1

if bk5=1

gosub blok5

// text 500,20,"go "+str$(mp_x)

for k=1 to 4

for j =1 to 4

if mp_tetris$(k,j)="1" then paste image 1,a,b

if mp_tetris$(k,j)="2" then paste image 1,a+27,b

if mp_tetris$(k,j)="3" then paste image 1,a+27+27,b

if mp_tetris$(k,j)="4" then paste image 1,a+27,b+27

next j

next k

gosub dwnk

sleep spl

b=b+3

if (b-37) mod 27 = 0

ky=((b-37)/27)+1

endif

if rightkey()

a=a+27

kxx=(((27*3)-a)/27)*-1

if kxx<6 and  mp_trs$(ky,kx+3)="1" or  mp_trs$(ky+1,kx+2)="1" then a=a-27

endif

if leftkey()

a=a-27

kxx=(((27*3)-a)/27)*-1

if kxx>1 and  mp_trs$(ky,kx-1)="1" or  mp_trs$(ky+1,kx)="1" then a=a+27

endif

if a<=((27*4)+10) then a=27*4+10

if a>=((27*10)+10) then a=27*9+10

kx=(((27*3)-a)/27)*-1

if  mp_trs$(ky+1,kx)="1"

mp_trs$(ky,kx)="1"

mp_trs$(ky,kx+1)="1"

mp_trs$(ky,kx+2)="1"

mp_trs$(ky+1,kx+1)="1"

st_blok=false

endif

if  mp_trs$(ky+1,kx+2)="1"

mp_trs$(ky,kx)="1"

mp_trs$(ky,kx+1)="1"

mp_trs$(ky,kx+2)="1"

mp_trs$(ky+1,kx+1)="1"

st_blok=false

endif

if  mp_trs$(ky+2,kx+1)="1"

mp_trs$(ky,kx)="1"

mp_trs$(ky,kx+1)="1"

mp_trs$(ky,kx+2)="1"

mp_trs$(ky+1,kx+1)="1"

st_blok=false

endif

if b>=((27*12)+10)

b=27*12+10

mp_trs$(ky,kx)="1"

mp_trs$(ky,kx+1)="1"

mp_trs$(ky,kx+2)="1"

mp_trs$(ky+1,kx+1)="1"

st_blok=false

endif

rem

if bk5=2

gosub blok5t2

// text 500,20,"go "+str$(mp_x)

for k=1 to 4

for j =1 to 4

if mp_tetris$(k,j)="1" then paste image 1,a+27,b

if mp_tetris$(k,j)="2" then paste image 1,a+27,b+27

if mp_tetris$(k,j)="3" then paste image 1,a+27,b+27+27

if mp_tetris$(k,j)="4" then paste image 1,a,b+27

next j

next k

gosub dwnk

sleep spl

b=b+3

if (b-37) mod 27 = 0

ky=((b-37)/27)+1

endif

if rightkey()

a=a+27

kxx=(((27*3)-a)/27)*-1

if kxx<7 and  mp_trs$(ky,kx+2)="1" or  mp_trs$(ky+1,kx+2)="1"  or  mp_trs$(ky+2,kx+2)="1" then a=a-27

endif

if leftkey()

a=a-27

kxx=(((27*3)-a)/27)*-1

if kxx>1 and  mp_trs$(ky,kx)="1" or  mp_trs$(ky+1,kx-1)="1" or  mp_trs$(ky+2,kx)="1" then a=a+27

endif

if a<=((27*4)+10) then a=27*4+10

if a>=((27*10)+10) then a=27*10+10

kx=(((27*3)-a)/27)*-1

if   mp_trs$(ky+2,kx)="1"

mp_trs$(ky,kx+1)="1"

mp_trs$(ky+1,kx)="1"

mp_trs$(ky+1,kx+1)="1"

mp_trs$(ky+2,kx+1)="1"

st_blok=false

endif

if   mp_trs$(ky+3,kx+1)="1"

mp_trs$(ky,kx+1)="1"

mp_trs$(ky+1,kx)="1"

mp_trs$(ky+1,kx+1)="1"

mp_trs$(ky+2,kx+1)="1"

st_blok=false

endif

if b>=((27*11)+10)

b=27*12+10

mp_trs$(ky,kx+1)="1"

mp_trs$(ky+1,kx)="1"

mp_trs$(ky+1,kx+1)="1"

mp_trs$(ky+2,kx+1)="1"

st_blok=false

endif

rem

if bk5=3

gosub blok5t3

// text 500,20,"go "+str$(mp_x)

for k=1 to 4

for j =1 to 4

if mp_tetris$(k,j)="1" then paste image 1,a,b+27

if mp_tetris$(k,j)="2" then paste image 1,a+27,b+27

if mp_tetris$(k,j)="3" then paste image 1,a+27+27,b+27

if mp_tetris$(k,j)="4" then paste image 1,a+27,b

next j

next k

gosub dwnk

sleep spl

b=b+3

if (b-37) mod 27 = 0

ky=((b-37)/27)+1

endif

if rightkey()

a=a+27

kxx=(((27*3)-a)/27)*-1

if kxx<6 and  mp_trs$(ky,kx+2)="1" or  mp_trs$(ky+1,kx+3)="1" then a=a-27

endif

if leftkey()

a=a-27

kxx=(((27*3)-a)/27)*-1

if kxx>1 and  mp_trs$(ky,kx)="1" or  mp_trs$(ky+1,kx-1)="1" then a=a+27

endif

if a<=((27*4)+10) then a=27*4+10

if a>=((27*10)+10) then a=27*9+10

kx=(((27*3)-a)/27)*-1

if  mp_trs$(ky+2,kx)="1"

mp_trs$(ky,kx+1)="1"

mp_trs$(ky+1,kx)="1"

mp_trs$(ky+1,kx+1)="1"

mp_trs$(ky+1,kx+2)="1"

st_blok=false

endif

if  mp_trs$(ky+2,kx+1)="1"

mp_trs$(ky,kx+1)="1"

mp_trs$(ky+1,kx)="1"

mp_trs$(ky+1,kx+1)="1"

mp_trs$(ky+1,kx+2)="1"

st_blok=false

endif

if  mp_trs$(ky+2,kx+2)="1"

mp_trs$(ky,kx+1)="1"

mp_trs$(ky+1,kx)="1"

mp_trs$(ky+1,kx+1)="1"

mp_trs$(ky+1,kx+2)="1"

st_blok=false

endif

if b>=((27*12)+10)

b=27*12+10

mp_trs$(ky,kx+1)="1"

mp_trs$(ky+1,kx)="1"

mp_trs$(ky+1,kx+1)="1"

mp_trs$(ky+1,kx+2)="1"

st_blok=false

endif

rem

if bk5=4

gosub blok5t4

// text 500,20,"go "+str$(mp_x)

for k=1 to 4

for j =1 to 4

if mp_tetris$(k,j)="1" then paste image 1,a,b

if mp_tetris$(k,j)="2" then paste image 1,a,b+27

if mp_tetris$(k,j)="3" then paste image 1,a,b+27+27

if mp_tetris$(k,j)="4" then paste image 1,a+27,b+27

next j

next k

gosub dwnk

sleep spl

b=b+3

if (b-37) mod 27 = 0

ky=((b-37)/27)+1

endif

if rightkey()

a=a+27

kxx=(((27*3)-a)/27)*-1

if kxx<7 and  mp_trs$(ky,kx+1)="1" or  mp_trs$(ky+1,kx+2)="1"  or  mp_trs$(ky+2,kx+1)="1" then a=a-27

endif

if leftkey()

a=a-27

kxx=(((27*3)-a)/27)*-1

if kxx>1 and  mp_trs$(ky,kx-1)="1" or  mp_trs$(ky+1,kx-1)="1"  or  mp_trs$(ky+2,kx-1)="1" then a=a+27

endif

if a<=((27*4)+10) then a=27*4+10

if a>=((27*10)+10) then a=27*10+10

kx=(((27*3)-a)/27)*-1

if   mp_trs$(ky+3,kx)="1"

mp_trs$(ky,kx)="1"

mp_trs$(ky+1,kx)="1"

mp_trs$(ky+1,kx+1)="1"

mp_trs$(ky+2,kx)="1"

st_blok=false

endif

if   mp_trs$(ky+2,kx+1)="1"

mp_trs$(ky,kx)="1"

mp_trs$(ky+1,kx)="1"

mp_trs$(ky+1,kx+1)="1"

mp_trs$(ky+2,kx)="1"

st_blok=false

endif

if b>=((27*11)+10)

b=27*12+10

mp_trs$(ky,kx)="1"

mp_trs$(ky+1,kx)="1"

mp_trs$(ky+1,kx+1)="1"

mp_trs$(ky+2,kx)="1"

st_blok=false

endif

endcase

endselect

return

rem ============================end blok============

rem

Rem ***** Included Source File *****

rem

rem ============================

resmap:

rem

gos01:

rem

com=0

flg=false

for k=1 to 13

for j=1 to 8

tempin$(k,j)=mp_trs$(k,j)

next j

next k

for k=13 to 1 step -1

if tempin$(k,1)="1" and tempin$(k,2)="1" and tempin$(k,3)="1" and tempin$(k,4)="1" and tempin$(k,5)="1" and tempin$(k,6)="1" and tempin$(k,7)="1" and tempin$(k,8)="1"

com=k

k=1

endif

next k

if com<>0

score=score+100

SET TEXT SIZE 60

s$=str$(score)

CENTER TEXT 320,240,s$

dec com,1

while flg=false

oldc=com+1

for kk=1 to 8

tempin$(oldc,kk)=tempin$(com,kk)

next kk

dec com,1

if com=0 then flg=true

endwhile

for k=1 to 13

for j=1 to 8

mp_trs$(k,j)=tempin$(k,j)

next j

next k

goto gos01

endif

return

rem

gameover:

// SET TEXT FONT "verdana"

SET TEXT SIZE 60

s$="tetris"

TEXT 420,40,s$

//paste image 4,420,40 rem ,Trasparency

SET TEXT SIZE 25

s$="upkey:rotate"

TEXT 420,100,s$

s$="leftkey:move"

TEXT 420,125,s$

s$="rightkey:move"

TEXT 420,150,s$

s$="downkey:move down"

TEXT 420,175,s$

s$="spacekey:reset game"

TEXT 420,200,s$

//paste image 5,420,120

return

resetgame:

score=0

for k=1 to 13

for j=1 to 8

mp_trs$(k,j)="0"

next j

next k

restore mydata

for k=1 to 4

for j=1 to 4

read aa

aaa$=str$(aa)

mp_tetris$(k,j)=aaa$

set cursor j*10,k*10

// print mp_tetris$(k,j)

next j

next k

restore mymap

for k=1 to 16

for j=1 to 14

read aa

aaa$=str$(aa)

mp_map$(k,j)=aaa$

set cursor j*10,k*10

print mp_map$(k,j)

next j

next k

a=27*4+10

b=27+10

cls

randomize timer()

return

rem

dwnk:

if downkey()

spl=spl2

else

spl=spl1

endif

return

rem

Rem ***** Included Source File *****

rem

mydata:

data 1,2,0,0

data 3,4,0,0

data 0,0,0,0

rem

mydatalr1:

data 1,0,0,0

data 2,3,4,0

data 0,0,0,0

rem

mydatalr2:

data 0,4,0,0

data 0,3,0,0

data 1,2,0,0

data 0,0,0,0

rem

mydatalr3:

data 1,2,3,0

data 0,0,4,0

data 0,0,0,0

rem

mydatalr4:

data 1,2,0,0

data 3,0,0,0

data 4,0,0,0

data 0,0,0,0

rem

mydatall1:

data 0,0,1,0

data 4,3,2,0

data 0,0,0,0

rem

mydatall2:

data 1,0,0,0

data 2,0,0,0

data 3,4,0,0

data 0,0,0,0

rem

mydatall3:

data 1,2,3,0

data 4,0,0,0

data 0,0,0,0

rem

mydatall4:

data 1,2,0,0

data 0,3,0,0

data 0,4,0,0

data 0,0,0,0

rem

mydatat1:

data 1,2,3,0

data 0,4,0,0

data 0,0,0,0

rem

mydatat2:

data 0,1,0,0

data 4,2,0,0

data 0,3,0,0

data 0,0,0,0

rem

mydatat3:

data 0,4,0,0

data 1,2,3,0

data 0,0,0,0

rem

mydatat4:

data 1,0,0,0

data 2,4,0,0

data 3,0,0,0

data 0,0,0,0

rem

mydatai1:

data 0,1,0,0

data 0,2,0,0

data 0,3,0,0

data 0,4,0,0

rem

mydatai2:

data 1,2,3,4

data 0,0,0,0

rem

mymap:

data 1,1,1,0,0,0,0,0,0,0,0,1,1,1

data 1,1,1,1,1,1,1,1,1,1,1,1,1,1

rem

blok1:

restore mydata

for k=1 to 4

for j=1 to 4

read aa

aaa$=str$(aa)

mp_tetris$(k,j)=aaa$

set cursor j*10,k*10

// print mp_tetris$(k,j)

next j

next k

return

rem

blok2:

restore mydatalr1

for k=1 to 4

for j=1 to 4

read aa

aaa$=str$(aa)

mp_tetris$(k,j)=aaa$

set cursor j*10,k*10

// print mp_tetris$(k,j)

next j

next k

return

rem

blok3:

restore mydatall1

for k=1 to 4

for j=1 to 4

read aa

aaa$=str$(aa)

mp_tetris$(k,j)=aaa$

set cursor j*10,k*10

// print mp_tetris$(k,j)

next j

next k

return

rem

blok4:

restore mydatai1

for k=1 to 4

for j=1 to 4

read aa

aaa$=str$(aa)

mp_tetris$(k,j)=aaa$

set cursor j*10,k*10

// print mp_tetris$(k,j)

next j

next k

return

rem

blok5:

restore mydatat1

for k=1 to 4

for j=1 to 4

read aa

aaa$=str$(aa)

mp_tetris$(k,j)=aaa$

set cursor j*10,k*10

// print mp_tetris$(k,j)

next j

next k

return

rem

blok2l2:

restore mydatalr2

for k=1 to 4

for j=1 to 4

read aa

aaa$=str$(aa)

mp_tetris$(k,j)=aaa$

set cursor j*10,k*10

// print mp_tetris$(k,j)

next j

next k

return

rem

blok2l3:

restore mydatalr3

for k=1 to 4

for j=1 to 4

read aa

aaa$=str$(aa)

mp_tetris$(k,j)=aaa$

set cursor j*10,k*10

// print mp_tetris$(k,j)

next j

next k

return

rem

blok2l4:

restore mydatalr4

for k=1 to 4

for j=1 to 4

read aa

aaa$=str$(aa)

mp_tetris$(k,j)=aaa$

set cursor j*10,k*10

// print mp_tetris$(k,j)

next j

next k

return

rem

blok3ll2:

restore mydatall2

for k=1 to 4

for j=1 to 4

read aa

aaa$=str$(aa)

mp_tetris$(k,j)=aaa$

set cursor j*10,k*10

// print mp_tetris$(k,j)

next j

next k

return

rem

blok3ll3:

restore mydatall3

for k=1 to 4

for j=1 to 4

read aa

aaa$=str$(aa)

mp_tetris$(k,j)=aaa$

set cursor j*10,k*10

// print mp_tetris$(k,j)

next j

next k

return

rem

blok3ll4:

restore mydatall4

for k=1 to 4

for j=1 to 4

read aa

aaa$=str$(aa)

mp_tetris$(k,j)=aaa$

set cursor j*10,k*10

// print mp_tetris$(k,j)

next j

next k

return

rem

blok4i2:

restore mydatai2

for k=1 to 4

for j=1 to 4

read aa

aaa$=str$(aa)

mp_tetris$(k,j)=aaa$

set cursor j*10,k*10

// print mp_tetris$(k,j)

next j

next k

return

rem

blok5t2:

restore mydatat2

for k=1 to 4

for j=1 to 4

read aa

aaa$=str$(aa)

mp_tetris$(k,j)=aaa$

set cursor j*10,k*10

// print mp_tetris$(k,j)

next j

next k

return

rem

blok5t3:

restore mydatat3

for k=1 to 4

for j=1 to 4

read aa

aaa$=str$(aa)

mp_tetris$(k,j)=aaa$

set cursor j*10,k*10

// print mp_tetris$(k,j)

next j

next k

return

rem

blok5t4:

restore mydatat4

for k=1 to 4

for j=1 to 4

read aa

aaa$=str$(aa)

mp_tetris$(k,j)=aaa$

set cursor j*10,k*10

// print mp_tetris$(k,j)

next j

next k

return

rem

Download

Please login to download

Comments

No comments yet.

CodeBase - tetris

Information

Summary

Full Description

DarkBASIC Professional Source Code

Download

Screen Shot

Author

Comments

Author Name:	Anonymous Coder
CodeBase Entries:	7