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