'Bricks Copyright 1999(c)WendelSoft
'
'To run this game,press Shift+F5.
'
'To exit QBasic,press Alt,A,R.
'
DEFINT A-Z
'$DYNAMIC
TYPE arenaType
realRow AS INTEGER
acolor AS INTEGER
sister AS INTEGER
END TYPE
DECLARE SUB SpacePause(text$)
DECLARE SUB Intro()
DECLARE SUB DrawScreen()
DECLARE SUB PlayBricks()
DECLARE SUB Set(row,col,acolor)
DECLARE SUB Center(row,text$)
DECLARE SUB Initialize()
DECLARE SUB PrintScore(pts%,t%)
DECLARE SUB SparklePause()
DECLARE SUB InitColors()
DECLARE FUNCTION PointIsThere(row,col)
DECLARE FUNCTION StillWantsToPlay()
CONST True=-1
CONST False=0
DIM SHARED arena(1 TO 50,1 TO 80)AS arenaType,kleft$,kright$
RANDOMIZE TIMER
GOSUB ClearKeyLocks
?"Definir teclas:"
?"P/ direita :";:DO:kright$=INKEY$:LOOP WHILE kright$="":?"Ok"
?"P/ esquerda :";:DO:kleft$=INKEY$:LOOP WHILE kleft$="":?"Ok"
Intro
DrawScreen
DO
PlayBricks
LOOP WHILE StillWantsToPlay
GOSUB RestoreKeyLocks
COLOR 7,0
CLS
SYSTEM
ClearKeyLocks:
DEF SEG=0
KeyFlags=PEEK(1047)
POKE 1047,&H0
DEF SEG
RETURN
RestoreKeyLocks:
DEF SEG=0
POKE 1047,KeyFlags
DEF SEG
RETURN
REM $STATIC
SUB Center(row,text$)
LOCATE row,41-LEN(text$)/2
?text$;
END SUB
SUB DrawScreen
VIEW ?
COLOR 15,0
CLS
Center 1,"Bricks!"
Center 11,"Preparando Campo De Jogo..."
FOR row=1 TO 50
FOR col=1 TO 80
arena(row,col).realRow=INT((row+1)/2)
arena(row,col).sister=(row MOD 2)*2-1
NEXT col
NEXT row
END SUB
SUB InitColors
FOR row=1 TO 50
FOR col=1 TO 80
arena(row,col).acolor=1
NEXT col
NEXT row
COLOR 1,1
CLS
FOR col=1 TO 80
Set 3,col,15
Set 50,col,15
NEXT col
FOR row=4 TO 49
Set row,1,15
Set row,80,15
NEXT row
END SUB
SUB Intro
SCREEN 0
WIDTH 80,25
COLOR 15,0
CLS
Center 4,"B r i c k s"
COLOR 7
Center 6,"Copyright (C) WendelSoft 1999"
Center 8,"Pressione alguma tecla para come‡ar"
PLAY "MBT160O1L8CDEDCDL4ECC"
SparklePause
END SUB
SUB PlayBricks
InitColors
escore=0
cplayer=35
FOR i=0 TO 9:Set 48,35+i,14:NEXT
FOR i=1 TO 20
DO
l=INT(RND*42)+5:c=INT(RND*78)+2
LOOP UNTIL PointIsThere(l,c)=1
Set l,c,3
NEXT
Brow=4
Bcol=INT(RND*78)+2
Bdr=1
Bdc=INT(RND*3)-1
tmu!=TIMER
DO
IF npt=0 THEN
FOR i=1 TO 30
DO
l=INT(RND*42)+5:c=INT(RND*78)+2
LOOP UNTIL PointIsThere(l,c)=1
Set l,c,7
NEXT
npt=i-1
tmu!=TIMER
END IF
PrintScore escore,TIMER-tmu!
IF TIMER-tmu!>=20 THEN GOSUB MaisUm:tmu!=TIMER
Set Brow,Bcol,1
IF dir=-1 THEN
Set 48,cplayer+10,1
ELSEIF dir=1 THEN
Set 48,cplayer-1,1
END IF
k$=INKEY$
SELECT CASE k$
CASE kleft$:dir=-1
CASE kright$:dir=1
CASE "":EXIT DO
CASE "P","p":tx!=TIMER:SpacePause "JOGO PAUSADO - APERTE ESPA€O":tmu!=tmu!+TIMER-tx!
CASE " ":dir=0
END SELECT
SELECT CASE dir
CASE-1:cplayer=cplayer-1:IF cplayer=1 THEN cplayer=2
CASE 1:cplayer=cplayer+1:IF cplayer=71 THEN cplayer=70
END SELECT
IF dir=-1 THEN
Set 48,cplayer,14
ELSEIF dir=1 THEN
Set 48,cplayer+9,14
END IF
aRow=Brow
aCol=Bcol
Brow=Brow+Bdr
Bcol=Bcol+Bdc
1 pt=PointIsThere(Brow,Bcol)
IF pt<>1 THEN
SOUND 100*pt,1
IF pt=7 THEN
tmu!=TIMER:escore=escore+10:Bdr=-Bdr:Bdc=-Bdc
Set Brow,Bcol,1
Brow=aRow:Bcol=aCol:npt=npt-1
IF npt=0 THEN
escore=escore+1000:PLAY "MFo6l20cdefgabcdefgabcdefgab"
FOR i=1 TO 20
GOSUB MaisUm
NEXT
END IF
GOTO 1
END IF
IF pt=14 THEN
Bdr=-Bdr:Bdc=Bdc+dir
IF Bdc>1 THEN Bdc=1
IF Bdc<-1 THEN Bdc=-1
Brow=aRow:Bcol=aCol
GOTO 1
END IF
IF pt=3 THEN
Set Brow,Bcol,1
DO
l=INT(RND*42)+5:c=INT(RND*78)+2
LOOP UNTIL PointIsThere(l,c)=1
Set l,c,3
Bdr=INT(RND*2)*2-1
Bdc=INT(RND*3)-1
tmu!=TIMER
GOTO 1
END IF
gt=0
IF Bcol=1 OR Bcol=80 THEN Bdc=-Bdc:Bcol=aCol:gt=-1
IF Brow=50 THEN escore=escore-10:gt=-1
IF Brow=3 OR Brow=50 THEN Bdr=-Bdr:Brow=aRow:Bcol=aCol:gt=-1
IF gt THEN 1
END IF
Set Brow,Bcol,15
PrintScore escore,TIMER-tmu!
t!=TIMER:DO:LOOP UNTIL TIMER-t!>.0001
LOOP
EXIT SUB
MaisUm:
DO
l=INT(RND*42)+5:c=INT(RND*78)+2
LOOP UNTIL PointIsThere(l,c)=1
Set l,c,7
npt=npt+1
RETURN
END SUB
FUNCTION PointIsThere(row,col)
PointIsThere=arena(row,col).acolor
END FUNCTION
SUB PrintScore(pts,t)
COLOR 15,2
LOCATE 1,1:?USING "Pontos : #####  Proximo bloco em ##"+SPACE$(45);pts;20-t;
END SUB
SUB Set(row,col,acolor)
IF row<>0 THEN
arena(row,col).acolor=acolor
realRow=arena(row,col).realRow
topFlag=arena(row,col).sister+1/2
sisterRow=row+arena(row,col).sister
sisterColor=arena(sisterRow,col).acolor
LOCATE realRow,col
IF acolor=sisterColor THEN
COLOR acolor,acolor
?CHR$(219);
ELSE
IF topFlag THEN
IF acolor>7 THEN
COLOR acolor,sisterColor
?CHR$(223);
ELSE
COLOR sisterColor,acolor
?CHR$(220);
END IF
ELSE
IF acolor>7 THEN
COLOR acolor,sisterColor
?CHR$(220);
ELSE
COLOR sisterColor,acolor
?CHR$(223);
END IF
END IF
END IF
END IF
END SUB
SUB SpacePause(text$)
COLOR 15,2
Center 11,"ÛßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßÛ"
Center 12,"Û "+LEFT$(text$+SPACE$(29),29)+" Û"
Center 13,"ÛÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÛ"
WHILE INKEY$<>"":WEND
WHILE INKEY$<>" ":WEND
COLOR 15,1
FOR i=21 TO 26
FOR j=24 TO 56
Set i,j,arena(i,j).acolor
NEXT j
NEXT i
END SUB
SUB SparklePause
COLOR 7,0
a$="*    *    *    *    *    *    *    *    *    *    *    *    *    *    *    *    *"
WHILE INKEY$<>"":WEND
WHILE INKEY$=""
FOR a=1 TO 5
LOCATE 1,1
?MID$(a$,a,80);
LOCATE 22,1
?MID$(a$,6-a,80);
FOR b=2 TO 21
c=(a+b)MOD 5
IF c=1 THEN
LOCATE b,80
?"*";
LOCATE 23-b,1
?"*";
ELSE
LOCATE b,80
?" ";
LOCATE 23-b,1
?" ";
END IF
NEXT b
NEXT a
WEND
END SUB
FUNCTION StillWantsToPlay
COLOR 15,2
Center 10,"ÛßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßÛ"
Center 11,"Û       FIM  DO  JOGO ! !       Û"
Center 12,"Û                               Û"
Center 13,"Û    JOGA DE NOVO?    (S/N)     Û"
Center 14,"ÛÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÛ"
WHILE INKEY$<>"":WEND
DO
kbd$=UCASE$(INKEY$)
LOOP UNTIL kbd$="S" OR kbd$="N"
COLOR 15,1
Center 10,""
Center 11,""
Center 12,""
Center 13,""
Center 14,""
IF kbd$="S" THEN
StillWantsToPlay=True
ELSE
StillWantsToPlay=False
COLOR 7,0
CLS
END IF
END FUNCTION