forum.vdsworld.com :: View topic

forum.vdsworld.com
Visit VDSWORLD.com

FAQ

Memberlist

Usergroups

Profile

Tetris

forum.vdsworld.com Forum Index -> Visual DialogScript 3 Source Code

View previous topic :: View next topic

Author

Message

Skit3000
Admin Team

Joined: 11 May 2002
Posts: 2166
Location: The Netherlands

Posted: Tue Aug 27, 2002 12:59 pm Post subject: Tetris

Hello all,

I've made a Tetris-game, but there are a few bugs in it, which I can't make to work.

So, if some of you guys want to help (or use it for something else) here it is:

Code:

option decimalsep,.
DIALOG CREATE,Tetris1q,-1,0,533,372
DIALOG ADD,STYLE,pointstyle,Courier New,12,R,WHITE,BLACK
DIALOG ADD,STYLE,TETRISSTYLE,Courier New,14,,WHITE,BLACK
DIALOG ADD,EDIT,TETRIS,8,8,176,344,,MULTI,READONLY,TETRISSTYLE
DIALOG ADD,MENU,-,up|up,down|down,left|left,right|right
DIALOG ADD,BUTTON,start,192,264,64,24,Start
DIALOG ADD,COMBO,speed,160,264,104,26,,LIST,POINTSTYLE
DIALOG ADD,TEXT,TEXT1,136,264,,,Current level:
DIALOG ADD,EDIT,points,96,264,104,24,0,POINTSTYLE,READONLY
DIALOG ADD,EDIT,next,8,264,96,80,XXXX@cr()@chr(10)XXXX@cr()@chr(10)XXXX@cr()@chr(10)XXXX,MULTI,READONLY,TETRISSTYLE
DIALOG SHOW
list loadtext,speed
"10
"9
"8
"7
"6
"5
"4
"3
"2
"1
list seek,speed,9

:evloop
wait event
%%event = @event()
goto %%event

:upmenu
:downmenu
:leftmenu
:rightmenu
goto evloop

:Startbutton
%%speed = @diff(15,@item(speed))
%%angle = 1
%%uppos = 0
%%leftpos = 5

rem This is to get a variable that set the (next) type of block
%%type = @datetime(ss)
repeat
%%type = @div(%%type,2)
until @greater(7,%%type)

%%nexttype = @datetime(ss)
repeat
%%nexttype = @div(%%nexttype,2)
until @greater(7,%%nexttype)

rem The 'map' of the game
list create,1
list loadtext,1
"
"
"
"
"
"
"
"
"
"
"
"
"
" XXXX
" X XX
"XXXXXXXXXXXXXXXXX

rem Here will the block be 'calcullated'
gosub whichtype

list create,2
list assign,2,1

rem This is where the block will be added to the screen
gosub setpos
dialog set,tetris,@text(2)

:tetrisloop
wait event,0.01
%%event = @event()

rem The timer is splitted, because a WAIT 1 command must be started over
rem if there is an event like UPMENU
if @equal(%%event,TIMER)
if @equal(%%counter,%%speed)
%%counter = 0
if @not(@equal(%%new,true))
%%new = false
%%uppos = @succ(%%uppos)
end
list assign,2,1
gosub setpos
rem %%error is setted to TRUE by :SETPOS
rem When it's true, 2 blocks hit eighother, so you have to
rem put a new one in the game
if @equal(%%error,true)
   %%error = false
   gosub newtype
end
dialog set,tetris,@text(2)
goto tetrisloop
else
%%counter = @succ(%%counter)
goto tetrisloop
end
end

rem This will turn the block, and get the new positions at :WHICHTYPE
rem then it put the new ones on the map
if @equal(%%event,UPMENU)
%%angle = @succ(%%angle)
if @greater(%%angle,4)
%%angle = 1
end
gosub whichtype
if @equal(%%error,true)
%%error = false
   gosub newtype
end
goto tetrisloop
end

rem This is the same as the COUNTER stuff, only this can be started
rem whenever you want.
if @equal(%%event,DOWNMENU)
%%uppos = @succ(%%uppos)
list assign,2,1
gosub setpos
if @equal(%%error,true)
   %%error = false
   gosub newtype
end
dialog set,tetris,@text(2)
goto tetrisloop
end

rem Move the block to the left
if @equal(%%event,LEFTMENU)
if @greater(%%leftpos,0)
%%leftpos = @pred(%%leftpos)
list assign,2,1
gosub setpos
if @equal(%%error,true)
%%error = false
   gosub newtype
end
dialog set,tetris,@text(2)
end
goto tetrisloop
end

rem Move the block to the right
if @equal(%%event,RIGHTMENU)
if @greater(15,%%leftpos)
%%leftpos = @succ(%%leftpos)
list assign,2,1
gosub setpos
if @equal(%%error,true)
%%error = false
%%new = true
   gosub newtype
end
dialog set,tetris,@text(2)
end

goto tetrisloop
end

goto %%event

:newtype
rem This will check if there is a complete row (Doesn't work proper jet) and
rem puts a new block on the map (Which does work). It will also paint the next
rem Block in the NEXT EDIT
if @match(1,XXXXXXXXXXXXXXX)
gosub line
end
%%angle = 1
%%uppos = 0
%%leftpos = 5
list clear,1
list add,1,@dlgtext(tetris)
list clear,2
list assign,2,1

%%type = %%nexttype

%%nexttype = @datetime(ss)
repeat
%%nexttype = @div(%%nexttype,2)
until @greater(7,%%nexttype)

if @equal(%%nexttype,1)
dialog set,next,@chr(32)@chr(32)X@cr()@chr(10) X@cr()@chr(10) XX
end
if @equal(%%nexttype,2)
dialog set,next,@chr(32)@chr(32)@chr(32)X@cr()@chr(10) X@cr()@chr(10) XX
end
if @equal(%%nexttype,3)
dialog set,next,@cr()@chr(10)@chr(32)@chr(32)XX@cr()@chr(10) XX
end
if @equal(%%nexttype,4)
dialog set,next,@chr(32)@chr(32)X@cr()@chr(10) X@cr()@chr(10) X@cr()@chr(10) X
end
if @equal(%%nexttype,5)
dialog set,next,@chr(32)@chr(32)@chr(32)XX@cr()@chr(10) XX
end
if @equal(%%nexttype,6)
dialog set,next,@chr(32)@chr(32)XX@cr()@chr(10) XX
end

gosub whichtype
gosub setpos
exit

:whichtype
rem This calculates the possisions of the stones where de blocks are made off.
rem %%pos1 = x|y

if @equal(%%type,1)
rem X
rem X
rem XX
if @equal(%%angle,1)
%%pos1 = 0|0
%%pos2 = 1|0
%%pos3 = 2|0
%%pos4 = 2|1
end
if @equal(%%angle,2)
%%pos1 = 0|0
%%pos2 = 0|1
%%pos3 = 0|2
%%pos4 = 1|0
end
if @equal(%%angle,3)
%%pos1 = 0|0
%%pos2 = 0|1
%%pos3 = 1|1
%%pos4 = 2|1
end
if @equal(%%angle,4)
%%pos1 = 0|3
%%pos2 = 1|1
%%pos3 = 1|2
%%pos4 = 1|3
end
end

if @equal(%%type,2)
rem X
rem X
rem XX
if @equal(%%angle,1)
%%pos1 = 0|1
%%pos2 = 1|1
%%pos3 = 2|0
%%pos4 = 2|1
end
if @equal(%%angle,2)
%%pos1 = 0|0
%%pos2 = 1|0
%%pos3 = 1|1
%%pos4 = 1|2
end
if @equal(%%angle,3)
%%pos1 = 0|0
%%pos2 = 0|1
%%pos3 = 1|0
%%pos4 = 2|0
end
if @equal(%%angle,4)
%%pos1 = 0|0
%%pos2 = 0|1
%%pos3 = 0|2
%%pos4 = 1|2
end
end

if @equal(%%type,3)
rem XX
rem XX
if @equal(%%angle,1)
%%pos1 = 0|0
%%pos2 = 0|1
%%pos3 = 1|0
%%pos4 = 1|1
end
if @equal(%%angle,2)
%%pos1 = 0|0
%%pos2 = 0|1
%%pos3 = 1|0
%%pos4 = 1|1
end
if @equal(%%angle,3)
%%pos1 = 0|0
%%pos2 = 0|1
%%pos3 = 1|0
%%pos4 = 1|1
end
if @equal(%%angle,4)
%%pos1 = 0|0
%%pos2 = 0|1
%%pos3 = 1|0
%%pos4 = 1|1
end
end

if @equal(%%type,4)
rem X
rem X
rem X
rem X
if @equal(%%angle,1)
%%pos1 = 0|0
%%pos2 = 1|0
%%pos3 = 2|0
%%pos4 = 3|0
end
if @equal(%%angle,2)
%%pos1 = 0|0
%%pos2 = 0|1
%%pos3 = 0|2
%%pos4 = 0|3
end
if @equal(%%angle,3)
%%pos1 = 0|0
%%pos2 = 1|0
%%pos3 = 2|0
%%pos4 = 3|0
end
if @equal(%%angle,4)
%%pos1 = 0|0
%%pos2 = 0|1
%%pos3 = 0|2
%%pos4 = 0|3
end
end

if @equal(%%type,5)
rem XX
rem XX
if @equal(%%angle,1)
%%pos1 = 0|1
%%pos2 = 0|2
%%pos3 = 1|0
%%pos4 = 1|1
end
if @equal(%%angle,2)
%%pos1 = 0|0
%%pos2 = 1|0
%%pos3 = 1|1
%%pos4 = 2|1
end
if @equal(%%angle,3)
%%pos1 = 0|1
%%pos2 = 0|2
%%pos3 = 1|0
%%pos4 = 1|1
end
if @equal(%%angle,4)
%%pos1 = 0|0
%%pos2 = 1|1
%%pos3 = 1|1
%%pos4 = 2|1
end
end

if @equal(%%type,6)
rem XX
rem XX
if @equal(%%angle,1)
%%pos1 = 0|0
%%pos2 = 0|1
%%pos3 = 1|1
%%pos4 = 1|2
end
if @equal(%%angle,2)
%%pos1 = 0|1
%%pos2 = 1|0
%%pos3 = 1|1
%%pos4 = 2|0
end
if @equal(%%angle,3)
%%pos1 = 0|0
%%pos2 = 0|1
%%pos3 = 1|1
%%pos4 = 1|2
end
if @equal(%%angle,4)
%%pos1 = 0|1
%%pos2 = 1|0
%%pos3 = 1|1
%%pos4 = 2|0
end
end
exit

:setpos
rem ---------------------------------------------------------
rem - This is to check if the blocks are hitting eighother -
rem ---------------------------------------------------------
rem The line %%asdfgdfgdf = @item(2,@fadd(%1,%%uppos))
rem is to make sure that there can be an @ok() function
rem (That doesn't work with LIST SEEK,2

parse "%1;%2",%%pos1
%%asdfgdfgdf = @item(2,@fadd(%1,%%uppos))
%%linetext = @item(2)
if @equal(@substr(%%linetext,@fadd(%%leftpos,%2),@fadd(%%leftpos,%2)),X)
if @not(@equal(%%event,RIGHTMENU))
if @not(@equal(%%event,LEFTMENU))
%%error = true
   exit
end
end
end
if @greater(%1,14)
%%error = true
exit
end

parse "%1;%2",%%pos2
%%asdfgdfgdf = @item(2,@fadd(%1,%%uppos))
%%linetext = @item(2)
if @equal(@substr(%%linetext,@fadd(%%leftpos,%2),@fadd(%%leftpos,%2)),X)
if @not(@equal(%%event,RIGHTMENU))
if @not(@equal(%%event,LEFTMENU))
%%error = true
   exit
end
end
end
if @greater(%1,14)
%%error = true
exit
end

parse "%1;%2",%%pos3
%%asdfgdfgdf = @item(2,@fadd(%1,%%uppos))
%%linetext = @item(2)
if @equal(@substr(%%linetext,@fadd(%%leftpos,%2),@fadd(%%leftpos,%2)),X)
if @not(@equal(%%event,RIGHTMENU))
if @not(@equal(%%event,LEFTMENU))
%%error = true
   exit
end
end
end
if @greater(%1,14)
%%error = true
exit
end

parse "%1;%2",%%pos4
%%asdfgdfgdf = @item(2,@fadd(%1,%%uppos))
%%linetext = @item(2)
if @equal(@substr(%%linetext,@fadd(%%leftpos,%2),@fadd(%%leftpos,%2)),X)
if @not(@equal(%%event,RIGHTMENU))
if @not(@equal(%%event,LEFTMENU))
%%error = true
   exit
end
end
end

if @greater(%1,14)
%%error = true
exit
end

rem ---------------------------------------------
rem - If nothing hits, the blocks will be moved -
rem ---------------------------------------------
parse "%1;%2",%%pos1

%%asdfgdfgdf = @item(2,@fadd(%1,%%uppos))
if @not(@ok())
%%error = true
exit
end
%%linetext = @item(2)
if @equal(@substr(%%linetext,@fadd(%%leftpos,%2),@fadd(%%leftpos,%2)),X)
if @not(@equal(%%event,RIGHTMENU))
if @not(@equal(%%event,LEFTMENU))
%%error = true
end
end
end
list delete,2
list insert,2
list put,2,@strdel(@strins(%%linetext,@fadd(%%leftpos,%2),X),@succ(@fadd(%%leftpos,%2)),@succ(@fadd(%%leftpos,%2)))

parse "%1;%2",%%pos2
%%asdfgdfgdf = @item(2,@fadd(%1,%%uppos))
if @not(@ok())
%%error = true
exit
end
%%linetext = @item(2)
if @equal(@substr(%%linetext,@fadd(%%leftpos,%2),@fadd(%%leftpos,%2)),X)
if @not(@equal(%%event,RIGHTMENU))
if @not(@equal(%%event,LEFTMENU))
%%error = true
end
end
end
list delete,2
list insert,2
list put,2,@strdel(@strins(%%linetext,@fadd(%%leftpos,%2),X),@succ(@fadd(%%leftpos,%2)),@succ(@fadd(%%leftpos,%2)))

parse "%1;%2",%%pos3
%%asdfgdfgdf = @item(2,@fadd(%1,%%uppos))
if @not(@ok())
%%error = true
exit
end
%%linetext = @item(2)
if @equal(@substr(%%linetext,@fadd(%%leftpos,%2),@fadd(%%leftpos,%2)),X)
if @not(@equal(%%event,RIGHTMENU))
if @not(@equal(%%event,LEFTMENU))
%%error = true
end
end
end
list delete,2
list insert,2
list put,2,@strdel(@strins(%%linetext,@fadd(%%leftpos,%2),X),@succ(@fadd(%%leftpos,%2)),@succ(@fadd(%%leftpos,%2)))

parse "%1;%2",%%pos4
%%asdfgdfgdf = @item(2,@fadd(%1,%%uppos))
if @not(@ok())
%%error = true
exit
end
%%linetext = @item(2)
if @equal(@substr(%%linetext,@fadd(%%leftpos,%2),@fadd(%%leftpos,%2)),X)
if @not(@equal(%%event,RIGHTMENU))
if @not(@equal(%%event,LEFTMENU))
%%error = true
end
end
end
list delete,2
list insert,2
list put,2,@strdel(@strins(%%linetext,@fadd(%%leftpos,%2),X),@succ(@fadd(%%leftpos,%2)),@succ(@fadd(%%leftpos,%2)))
exit

:line
EXIT
rem If there is a full row, this must remove it and put a new one at the top, but
rem that doesn't work, so I've put a EXIT after :line (remove it if you want to fix it)
if @match(1,XXXXXXXXXX)
list delete,1
list seek,1,0
list insert,1
list put,1,@chr(32)@chr(32)@chr(32)@chr(32)@chr(32)@chr(32)@chr(32)@chr(32)@chr(32)@chr(32)@chr(32)@chr(32)@chr(32)@chr(32)
dialog set,tetris,@text(1)
end
if @match(2,XXXXXXXXXX)
list delete,2
list seek,2,0
list insert,2
list put,2,@chr(32)@chr(32)@chr(32)@chr(32)@chr(32)@chr(32)@chr(32)@chr(32)@chr(32)@chr(32)@chr(32)@chr(32)@chr(32)@chr(32)
dialog set,tetris,@text(2)
end
exit

rem And @ last:
:Close
exit

It's a lot of code, but I think it can be a good example for someone who wants to make a game with VDS...

Tommy
Admin Team

Joined: 16 Nov 2002
Posts: 746
Location: The Netherlands

Posted: Sat Aug 31, 2002 8:14 pm Post subject:

Dat is heel knap gedaan, maar het lijkt erop dat er iets mis is met de besturing... Verder moeten natuurlijk de overbodige spaties uit de onderdelen van het LIST LOADTEXT commando gehaalt worden. That's very nicely done, but it seems that there's something wrong with the steering... Of course before trying it, the additional spaces should be removed from the lines in the LIST LOADTEXT command.

Display posts from previous:

	forum.vdsworld.com Forum Index -> Visual DialogScript 3 Source Code	All times are GMT
Page 1 of 1

You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum
You can attach files in this forum
You can download files in this forum

@vdsworld