application game color tris

                                    ` This code was downloaded from The Game Creators
                                    ` It is reproduced here with full permission
                                    ` http://www.thegamecreators.com
                                    
                                    Rem Project: colortris
Rem Created: Wednesday, February 18, 2009

Rem ***** Main Source File *****
rem by:vitaluciano@hotmail.fr
rem
sync on
sync rate 60
set dir "media"
load image "bk1.jpg",1
load image "bk2.jpg",2
load image "bk3.jpg",3
load image "bk4.jpg",4
load image "bk5.jpg",5
load image "bk6.jpg",6
load image "bk7.jpg",7
load image "bk8.jpg",8
global false=0
global true=-1
global dim map$(15,14)
global dim mymap$(12,8)
global dim tempmap$(12,8)
global dim temp001$(12,8)
global dim blok$(3,3)
//global dim blk1$(1,3)
global flg_blk=false
global dim combk(3)
global dim tempcom$(3,3)
global dim tempcomv(3,3)
global bk1=1
global sz=28
global a=sz*2
global b=sz*2
global ky,kx
global slp
global score
global reset01=false

restore mymap
for k=1 to 14
for j=1 to 13
read aa
aaa$=str$(aa)
map$(k,j)=aaa$
next j
next k
for k=1 to 12
for j=1 to 7
mymap$(k,j)="0"
next j
next k
gosub resmymap
randomize timer()
cls
rem ==================main loop========================
do
cls
if mymap$(1,1)<>"0"
wait key
endif 
if spacekey()
cls
score=0
gosub resmymap
bk1=1
 flg_blk=false
endif
 gosub resmap
gosub dismap
if flg_blk=false
for k=1 to 3
combk(k)=rnd(5)+1
next k
a=sz*2
b=sz*2
ky=1
flg_blk=true
endif
gosub blk
// wait key
sync
loop
end
rem ======================routin=========
dismap:
for k=1 to 14
for j=1 to 13
if map$(k,j)="1" 
paste image rnd(5)+1,(j*28)+sz,(k*28)+sz
endif
if map$(k,j)="0" 
paste image 8,(j*28)+28,(k*28)+28
endif
next j
next k
for k=1 to 11
for j=1 to 7
if mymap$(k,j)="0" then paste image 8,(j*sz)+(sz*4),(k*sz)+sz
if mymap$(k,j)<>"0"
paste image val(mymap$(k,j)),(j*sz)+(sz*4),(k*sz)+sz
endif
next j
next k
set text size 40
s$="COLOR-TRIS"
text 430,10,s$
set text size 25
s$="Upkey:rotate color"
text 430,50,s$
s$="Rightkey:move"
text 430,70,s$
s$="Leftkey:move"
text 430,90,s$
s$="Downtkey:move down"
text 430,110,s$
s$="Spacekey:resetgame"
text 430,130,s$
s$="Esc:quit"
text 430,150,s$
set text size 35
s$="Score: "+str$(score)
text 430,200,s$
set text size 25
s$="by:vitaluciano@hotmail.fr"
text 430,350,s$
return
rem
blk:
if upkey()
inc bk1,1
endif
if bk1>4 then bk1=1
select  bk1
case 1
gosub resblok
gosub inblok1
 endcase
case 2
gosub resblok
gosub inblok2
endcase
case 3
gosub resblok
gosub inblok3
 endcase
 case 4
gosub resblok
gosub inblok4
 endcase
endselect
return
rem
resblok:
for k=1 to 3
for j=1 to 3
blok$(k,j)="0"
next j
next k
return
rem
blkky:
ky=((b-(sz*2))/sz)+1
return
rem
blkkx:
kx=((a-(sz*2))/sz)+1
return
rem
dwn:
if downkey()
slp=30
else
slp=150
endif
return
rem 
inblok1:
blok$(1,1)=str$(combk(1))
blok$(2,1)=str$(combk(2))
blok$(3,1)=str$(combk(3))
paste image val(blok$(1,1)),a+(28*3),b
paste image val(blok$(2,1)),a+(28*3),b+sz
paste image val(blok$(3,1)),a+(28*3),b+sz+sz
gosub dwn
sleep slp
b=b+2
gosub blkky
gosub rightleft

 if a<=sz*2 then a=sz*2
if a>=sz*8 then a=sz*8
gosub blkkx
if  mymap$(ky+3,kx)<>"0"
 mymap$(ky,kx)=blok$(1,1)
  mymap$(ky+1,kx)=blok$(2,1)
   mymap$(ky+2,kx)=blok$(3,1)
   flg_blk=false
endif
if b>=(sz*10) 
 b=sz*11
 mymap$(ky,kx)=blok$(1,1)
  mymap$(ky+1,kx)=blok$(2,1)
   mymap$(ky+2,kx)=blok$(3,1)
 
flg_blk=false
endif
return
rem
inblok2:
blok$(1,1)=str$(combk(1))
blok$(1,2)=str$(combk(2))
blok$(1,3)=str$(combk(3))
paste image val(blok$(1,1)),a+(28*3),b
paste image val(blok$(1,2)),a+(28*3)+sz,b
paste image val(blok$(1,3)),a+(28*3)+sz+sz,b
gosub dwn
sleep slp
b=b+2
gosub blkky
gosub rightleft

  if a<=sz*2 then a=sz*2
 if a>=sz*6 then a=sz*6
 gosub blkkx
 if  mymap$(ky+1,kx)<>"0"
  mymap$(ky,kx)=blok$(1,1)
  mymap$(ky,kx+1)=blok$(1,2)
   mymap$(ky,kx+2)=blok$(1,3)
 flg_blk=false
 endif
  if  mymap$(ky+1,kx+1)<>"0"
  mymap$(ky,kx)=blok$(1,1)
  mymap$(ky,kx+1)=blok$(1,2)
   mymap$(ky,kx+2)=blok$(1,3)
 flg_blk=false
 endif
  if  mymap$(ky+1,kx+2)<>"0"
  mymap$(ky,kx)=blok$(1,1)
  mymap$(ky,kx+1)=blok$(1,2)
   mymap$(ky,kx+2)=blok$(1,3)
 flg_blk=false
 endif
if b>=(sz*12) 
 b=sz*11
  mymap$(ky,kx)=blok$(1,1)
  mymap$(ky,kx+1)=blok$(1,2)
   mymap$(ky,kx+2)=blok$(1,3)
flg_blk=false
endif
return
rem
rem
inblok3:
blok$(1,1)=str$(combk(3))
blok$(2,1)=str$(combk(2))
blok$(3,1)=str$(combk(1))
paste image val(blok$(1,1)),a+(28*3),b
paste image val(blok$(2,1)),a+(28*3),b+sz
paste image val(blok$(3,1)),a+(28*3),b+sz+sz
gosub dwn
sleep slp
b=b+2
gosub blkky
gosub rightleft

 if a<=sz*2 then a=sz*2
if a>=sz*8 then a=sz*8
gosub blkkx
if  mymap$(ky+3,kx)<>"0"
 mymap$(ky,kx)=blok$(1,1)
  mymap$(ky+1,kx)=blok$(2,1)
   mymap$(ky+2,kx)=blok$(3,1)
   flg_blk=false
endif
if b>=(sz*10) 
 b=sz*11
  mymap$(ky,kx)=blok$(1,1)
  mymap$(ky+1,kx)=blok$(2,1)
   mymap$(ky+2,kx)=blok$(3,1)
flg_blk=false
endif
return
rem
inblok4:
blok$(1,1)=str$(combk(3))
blok$(1,2)=str$(combk(2))
blok$(1,3)=str$(combk(1))
paste image val(blok$(1,1)),a+(28*3),b
paste image val(blok$(1,2)),a+(28*3)+sz,b
paste image val(blok$(1,3)),a+(28*3)+sz+sz,b
gosub dwn
sleep slp
b=b+2
gosub blkky
gosub rightleft

  if a<=sz*2 then a=sz*2
 if a>=sz*6 then a=sz*6
 gosub blkkx
  if  mymap$(ky+1,kx)<>"0"
  mymap$(ky,kx)=blok$(1,1)
  mymap$(ky,kx+1)=blok$(1,2)
   mymap$(ky,kx+2)=blok$(1,3)
 flg_blk=false
 endif
  if  mymap$(ky+1,kx+1)<>"0"
  mymap$(ky,kx)=blok$(1,1)
  mymap$(ky,kx+1)=blok$(1,2)
   mymap$(ky,kx+2)=blok$(1,3)
 flg_blk=false
 endif
  if  mymap$(ky+1,kx+2)<>"0"
  mymap$(ky,kx)=blok$(1,1)
  mymap$(ky,kx+1)=blok$(1,2)
   mymap$(ky,kx+2)=blok$(1,3)
 flg_blk=false
 endif
if b>=(sz*12) 
 b=sz*11
   mymap$(ky,kx)=blok$(1,1)
  mymap$(ky,kx+1)=blok$(1,2)
   mymap$(ky,kx+2)=blok$(1,3)
flg_blk=false
endif
return
rem
resmymap:
for k=1 to 11
for j=1 to 7
mymap$(k,j)="0"
next j
next k
return
rem
rightleft:
if rightkey()
a=a+sz
kxx=((a-(sz*2))/sz)+1
if bk1=1 or bk1=3
if kxx<7 and mymap$(ky,kx+1)<>"0" or  mymap$(ky+1,kx+1)<>"0" or  mymap$(ky+2,kx+1)<>"0" then a=a-sz
endif
if bk1=2 or bk1=4
if kxx<6 and mymap$(ky,kx+3)<>"0" then a=a-sz
endif
endif
if leftkey()
a=a-sz
kxx=((a-(sz*2))/sz)+1
if bk1=1 or bk1=3
if kxx>1 and mymap$(ky,kx-1)<>"0" or  mymap$(ky+1,kx-1)<>"0" or  mymap$(ky+2,kx-1)<>"0" then a=a+sz
endif
if bk1=2 or bk1=4
if kxx>1 and mymap$(ky,kx-1)<>"0" then a=a+sz
endif
endif
return
rem
resmap:
go01:
for k=1 to 11
for j=1 to 7
tempmap$(k,j)=mymap$(k,j)
next j
next k
com2=false
gosub resmap01 rem control map orrinzzontal
com7=false
gosub resmap02 rem control map vertical
if com2=true or com7=true
score=score+100
if com2=true
com3=val(tempcom$(1,1)) 
for k=com3 to 1 step -1
if k<>1
com4=val(tempcom$(1,2))
com5=val(tempcom$(2,2))
com6=val(tempcom$(3,2))
mymap$(k,com4)=tempmap$(k-1,com4)
mymap$(k,com5)=tempmap$(k-1,com5)
mymap$(k,com6)=tempmap$(k-1,com6)
endif
next k
gosub resmymap001
goto go01
endif
rem
if com7=true
com10=tempcomv(1,1)
 com11=tempcomv(1,2)
com12=tempcomv(2,2)
com13=tempcomv(3,2)
for k=com10 to 1 step -1
if k>=4
mymap$(k,com11)=tempmap$(k-3,com11)
mymap$(k,com12)=tempmap$(k-3,com12)
mymap$(k,com13)=tempmap$(k-3,com13)
endif
next k
gosub resmymap001
goto go01
endif
endif
// gosub resmymap001
return
rem
resmap01:
for k=11 to 1 step -1
for j=1 to 7
if j<=5 and k>=4
com1$=tempmap$(k,j)
select j
case 1
if com1$<>"0"
if tempmap$(k,1)=com1$ and tempmap$(k,2)=com1$ and tempmap$(k,3)=com1$
tempcom$(1,1)=str$(k)
tempcom$(1,2)=str$(1)
tempcom$(2,1)=str$(k)
tempcom$(2,2)=str$(2)
tempcom$(3,1)=str$(k)
tempcom$(3,2)=str$(3)
com2=true
endif
endif
endcase
case 2
if com1$<>"0"
if tempmap$(k,2)=com1$ and tempmap$(k,3)=com1$ and tempmap$(k,4)=com1$
tempcom$(1,1)=str$(k)
tempcom$(1,2)=str$(2)
tempcom$(2,1)=str$(k)
tempcom$(2,2)=str$(3)
tempcom$(3,1)=str$(k)
tempcom$(3,2)=str$(4)
com2=true
endif
endif
endcase
case 3
if com1$<>"0"
if tempmap$(k,3)=com1$ and tempmap$(k,4)=com1$ and tempmap$(k,5)=com1$
tempcom$(1,1)=str$(k)
tempcom$(1,2)=str$(3)
tempcom$(2,1)=str$(k)
tempcom$(2,2)=str$(4)
tempcom$(3,1)=str$(k)
tempcom$(3,2)=str$(5)
com2=true
endif
endif
endcase
case 4
if com1$<>"0"
if tempmap$(k,4)=com1$ and tempmap$(k,5)=com1$ and tempmap$(k,6)=com1$
tempcom$(1,1)=str$(k)
tempcom$(1,2)=str$(4)
tempcom$(2,1)=str$(k)
tempcom$(2,2)=str$(5)
tempcom$(3,1)=str$(k)
tempcom$(3,2)=str$(6)
com2=true
endif
endif
endcase
case 5
if com1$<>"0"
if tempmap$(k,5)=com1$ and tempmap$(k,6)=com1$ and tempmap$(k,7)=com1$
tempcom$(1,1)=str$(k)
tempcom$(1,2)=str$(5)
tempcom$(2,1)=str$(k)
tempcom$(2,2)=str$(6)
tempcom$(3,1)=str$(k)
tempcom$(3,2)=str$(7)
com2=true
endif
endif
endcase
endselect
endif
next j
next k
return
rem
resmap02:
for k=11 to 1 step -1
for j=1 to 7 
if k>=3
com8$=tempmap$(k,j)
if com8$<>"0"
if tempmap$(k,j)=com8$ and tempmap$(k-1,j)=com8$ and tempmap$(k-2,j)=com8$
tempcomv(1,1)=k
tempcomv(1,2)=j
tempcomv(2,1)=k-1
tempcomv(2,2)=j
tempcomv(3,1)=k-2
tempcomv(3,2)=j
com7=true
endif
endif
endif
next j
next k
return
rem
resmymap001:
for k=1 to 11
for j=1 to 7
temp001$(k,j)="0"
tempmap$(k,j)=mymap$(k,j)
next j
next k
for j=1 to 7
select j
case 1
 gosub remmap002
endcase
case 2
 gosub remmap002
endcase
case 3
 gosub remmap002
endcase
case 4
 gosub remmap002
endcase
case 5
 gosub remmap002
endcase
case 6
 gosub remmap002
endcase
case 7
 gosub remmap002
endcase
endselect
next j

for k=1 to 11
for j=1 to 7
mymap$(k,j)=temp001$(k,j)
next j
next k
return
rem
remmap002:
kk=12
for k=11 to 1 step -1
if tempmap$(k,j)<>"0"
dec kk,1
temp001$(kk,j)=tempmap$(k,j)
endif
next k
return
rem ==================mappa================
mymap:
data 1,1,1,0,0,0,0,0,0,0,1,1,1
data 1,1,1,0,0,0,0,0,0,0,1,1,1
data 1,1,1,0,0,0,0,0,0,0,1,1,1
data 1,1,1,0,0,0,0,0,0,0,1,1,1
data 1,1,1,0,0,0,0,0,0,0,1,1,1
data 1,1,1,0,0,0,0,0,0,0,1,1,1
data 1,1,1,0,0,0,0,0,0,0,1,1,1
data 1,1,1,0,0,0,0,0,0,0,1,1,1
data 1,1,1,0,0,0,0,0,0,0,1,1,1
data 1,1,1,0,0,0,0,0,0,0,1,1,1
data 1,1,1,0,0,0,0,0,0,0,1,1,1
data 1,1,1,1,1,1,1,1,1,1,1,1,1
data 1,1,1,1,1,1,1,1,1,1,1,1,1
data 1,1,1,1,1,1,1,1,1,1,1,1,1
rem
// blk1:
// data 1,1,1
// data 0,0,0
// data 0,0,0
// rem
// blk2:
// data 1,0,0
// data 1,0,0
// data 1,0,0