BASIC2\PAIRS.BAS ·
BAS ·
5 KB ·
1987-10-19 ·
from PCPlus_Issue-19_Apr-1988
OPTION RUN
'*******************************************************
'************************ PAIRS ************************
'*******************************************************
'**************** Written by H. DICKSON ****************
'*******************************************************
GOSUB init
1 DATA 3,4,2800,1300,5,4,4,2800,900,7,4,5,2400,900,9
DATA 4,6,2000,900,11,5,6,2000,500,14
FOR game=1 TO 5
GOSUB shuffle
GOSUB play
NEXT
GOSUB endgame:GOTO 1
LABEL shuffle
MOVE 7200;4700:PRINT;"Sheilsoft"
MOVE 7400;4500:PRINT;CHR$(189);" 1987"
READ ld,td,xd,yd,rn:score=score+(rn+1)*2
GOSUB sort
MOVE 7300;1000:PRINT;"USE MOUSE"
q=0: x=xd:y=yd:st=1
FOR l = 1 TO ld
FOR t = 1 TO td
BOX x;y,750,750 FILL WITH 4 COLOUR 2
card(l,t)=mx(st):st = st+1
cardx(l,t)=x
cardy(l,t)=y
x=x+800
NEXT
x=xd:y=y+800
NEXT
BOX 7500;300,500,600
a1=7550:b1=600:BOX a1;b1,150,200
a2=7800:b2=600:BOX a2;b2,150,200
BOX 500;2900,1000,1550
BOX 550;4000,900,400
MOVE 730;3700:PRINT;"SCORE"
MOVE 600;3200:PRINT;"LEVEL";game
BOX 500;225,2100,275:MOVE 600;285:PRINT;"HIGHEST SCORE";hs
RETURN
LABEL play
MOVE 800;4100:PRINT;score
BOX 7525;325,450,500 FILL COLOUR 0
BOX a1;b1,150,200 FILL COLOUR 2:BOX a2;b2,150,200
IF game=1 THEN ALERT 0 TEXT "MATCH THE"," PAIRS" BUTTON "PRESS TO START"
ALERT 1 TEXT "WATCH","CAREFULLY..","YOU HAVE","10 SECONDS" BUTTON "CONTINUE"
GOSUB preview
REPEAT
MOVE 800;4100:PRINT;score
FOR g= 1 TO 2
BOX 7525;325,450,550 FILL COLOUR 0
IF g=1 THEN BOX a1;b1,150,200 FILL COLOUR 2:BOX a2;b2,150,200
IF g=2 THEN BOX a1;b1,150,200:BOX a2;b2,150,200 FILL COLOUR 2
20 xx=0:yy=0:zz=0
WHILE BUTTON(g) = -1 :WEND
xm=XMOUSE*XPIXEL:ym=(YMOUSE-YBAR)*YPIXEL
FOR l=1 TO ld
FOR t=1 TO td
IF xm< xd OR xm> (xd+(td*800)) THEN GOTO 20
IF ym< yd OR ym> (yd+(ld*800)) THEN GOTO 20
IF xm >cardx(l,t) AND xm <(cardx(l,t)+800) THEN xx=cardx(l,t):tt=t
IF ym >cardy(l,t) AND ym <(cardy(l,t)+800) THEN yy=cardy(l,t):ll=l
NEXT
NEXT
IF card(ll,tt)=0 THEN GOTO 20
zz=card(ll,tt)
CIRCLE (xx+375);(yy+375),300 FILL WITH (zz+6) COLOUR zz
pr(g)=zz
x(g)=xx:y(g)=yy:ll(g)=ll:tt(g)=tt
NEXT
IF pr(1)=pr(2) THEN GOSUB pair ELSE GOSUB nopair
UNTIL q=(rn+1) OR score=0
IF score=0 THEN game=5
RETURN
LABEL pair
IF ll(2)=ll(1) AND tt(2)=tt(1) THEN GOSUB nopair:score=score+2:RETURN
PRINT;CHR$(7)
FOR j=1 TO 5000:NEXT
BOX x(1);y(1),750,750 FILL WITH 0 COLOUR 0
BOX x(2);y(2),750,750 FILL WITH 0 COLOUR 0
card(ll(1),tt(1))=0
card(ll(2),tt(2))=0
q=q+1
RETURN
LABEL nopair
FOR j=1 TO 5000:NEXT
FOR k=1 TO 2
BOX x(k);y(k),750,750 FILL WITH 4 COLOUR 2
NEXT
score=score-2
RETURN
LABEL sort
r1=RND(rn)+1:r2=(r1+rn)
st=1
FOR sort=r1 TO r2
mx(sort)=st
st=st+1
NEXT
st=RND(rn+1)
FOR sort=1 TO (r1-1)
mx(sort)=st
st=st-1
IF st=0 THEN st=rn+1
NEXT
FOR sort=(r2+1) TO (rn*2)+2
mx(sort)=st
st=st-1
IF st=0 THEN st=rn+1
NEXT
RETURN
LABEL preview
x=xd:y=yd
FOR l=1 TO ld
FOR t=1 TO td
CIRCLE x+375;y+375,300 FILL WITH (card(l,t)+6) COLOUR card(l,t)
x=x+800
NEXT
x=xd:y=y+800
NEXT
FOR h=1 TO 30000:NEXT
x=xd:y=yd
FOR l=1 TO ld
FOR t=1 TO td
BOX x;y,750,750 FILL WITH 4 COLOUR 2
x=x+800
NEXT
x=xd:y=y+800
NEXT
RETURN
LABEL init
CLS:RESTORE 1
WINDOW TITLE "*** PAIRS ***"
WINDOW OPEN
WINDOW FULL
DIM card(5,6),cardx(5,6),cardy(5,6),pr(2),x(2),y(2),ll(2),tt(2),mx(30)
yn = ALERT 0 TEXT "DO YOU WANT","INSTRUCTIONS ?" BUTTON "yes","no"
IF yn=2 THEN RETURN ELSE CLS
PRINT:PRINT " In PAIRS there are a number of cards lying face down."
PRINT:PRINT " Each card has a coloured pattern which you have to match with another card."
PRINT:PRINT " You select the cards by moving the mouse pointer over the card and clicking once on the LEFT hand button for the first card and once on the RIGHT hand button for the second card."
PRINT:PRINT " There are 5 levels of play each with an increased number of cards."
PRINT:PRINT " You are given a 10 second preview at the start of each game."
PRINT:PRINT " Your score is given bonus points at the start of each game but is reduced by 2 points every time you fail to make a match."
TEXT FEED 4
PRINT " CLICK ONCE WHEN READY...":WHILE BUTTON = -1:WEND:CLS
RETURN
LABEL endgame
MOVE 800;4100:PRINT;score:IF hs< score THEN hs=score
yn=ALERT 1 TEXT "DO YOU WANT","ANOTHER GAME"," ?" BUTTON "YES","NO"
IF yn = 1 THEN RESTORE 1:score=0:CLS:RETURN
SYSTEM
RETURN