Parchisi

Source Code

    1 REM PARCHISI-LIKE GAME
    2 REM                        Written by Ferry Groothedde;    authorized translation by CedricBastiaans (only for use by      members of the L.I.S.T. group)
    3 REM RESET  "SINCLAIR GEBRUIKER",   a Dutch computer magazine;   \* F.Groothedde; \* C.R.Bastiaans
    4 FOR f=1 TO 4: READ a$: FOR g=0 TO 7: READ A: POKE USR a$+g,a: NEXT g: NEXT f
    5 LET e=1: GO SUB 5000: LET a=10: LET b=11: BRIGHT e: PAPER e: CLS : INK 9: BORDER e: LET u$="      ": FOR p=e TO 6: LET u$(p)=CHR$ 8: NEXT p
   10 LET j=4: DIM a(b,b): DIM b$(j,96): LET a(6,6)=9: PRINT "Welcome to""DON'T BE AGGRAVATED!""";'"A Dutch Parcheesi-like Boardgame": PRINT : PRINT "  Written by \*Ferry Groothedde";'"   Authorized Translation and";'"           Adaptation"'"    by  \*Cedric R. Bastiaans";AT 21,0;"Need Instructions? (Y/N)": PAUSE 0: GO SUB 6000+(310 AND (INKEY$="n" OR INKEY$="N"))
   20 LET b$(2)=" 172737475758595a5b6b7b7a7978778797a7b7b6b5a59585757473727161515253545545352515162636465666666666"
   30 LET b$(e)=" "+b$(2,62 TO 81)+b$(2,2 TO 61)+"626364656666666666666666"
   40 LET b$(3)=" "+b$(e,42 TO 81)+b$(e,2 TO 41)+"6a696867666666666666"
   50 LET b$(4)=" "+b$(2,42 TO 81)+b$(2,2 TO 41)+"a69686766666666666666"
   70 FOR p=2 TO 80 STEP 2: PRINT OVER e;AT 2*VAL b$(j,p)-2,2*VAL b$(j,p+e);"/\\                              \\/": NEXT p
  100 FOR p=2 TO 19: PRINT OVER e;AT p,12;"##": NEXT p: PRINT AT a,4;"########  ########";AT b,4;"########  ########"
  130 DIM k(4): DIM s(4): DIM t(4): DIM x(4): DIM y(4)
  150 FOR p=e TO 4: LET y(p)=4: NEXT p
  160 PRINT OVER e;AT e,3;"4";TAB 22;"4";AT 20,3;"4";TAB 22;"4"
  170 LET k(2)=4: LET k(3)=6: LET k(4)=2: LET k(e)=7
  180 PRINT OVER e;AT 0,2;"   ";TAB 21;"   ";AT 2,2;"   ";TAB 21;"   ";AT 19,2;"   ";TAB 21;"   ";AT 21,2;"   ";TAB 21;"   "
  190 PRINT #e;AT 0,0;"Highest throw starts game ( / )   throws";
  210 IF NOT LEN INKEY$ THEN GO TO 210
  215 IF LEN INKEY$ THEN GO TO 215
  220 BEEP .1,b: LET s=INT (RND*6+e): PRINT #e;s,"  throws ";
  230 IF sp AND NOT LEN INKEY$ THEN GO TO 230
  235 IF LEN INKEY$ AND sp THEN GO TO 235
  240 BEEP .1,b: LET z=INT (RND*6+e): PRINT #e;z
  250 FOR p=-b TO 50: BEEP .02,p: NEXT p: INPUT "": IF s=z THEN GO TO 190
  260 FOR j=2 TO 4: IF j=2 AND s>z THEN LET j=4
  270 IF j=4 OR (j=2 AND sp) THEN GO SUB 1000
  280 IF j=3 OR (j=2 AND NOT sp) THEN GO SUB 300
  290 NEXT j: GO TO 7000
  300 LET z=INT (RND*6+e)
  310 FOR p=e TO 3: PRINT PAPER k(j); INK 9;AT p+9,27;d$(VAL e$(z,p)): NEXT p
  320 IF z=6 THEN FOR p=e TO 100: NEXT p
  330 LET v=0: LET w=v
  350 IF y(j) AND z=6 THEN GO TO 4000
  360 IF x(j)+y(j)=4 THEN GO TO 880
  370 FOR p=80 TO 2 STEP -2: LET st=a(VAL b$(j,p),VAL b$(j,p+e))
  380 IF st<>j+4 THEN GO TO 430
  390 LET dl=a(VAL b$(j,p+2*z),VAL b$(j,e+p+2*z))
  400 IF dl=a-e THEN GO TO 430
  410 IF dl<>j+4 THEN LET v=p
  420 IF (p+2*z>80 AND NOT dl) OR (p=2 AND NOT dl) OR (dl AND dl<>j+4) THEN LET w=p
  430 NEXT p: IF NOT v THEN GO TO 880
  440 IF w THEN LET v=w
  450 IF v+2*z>80 THEN LET x(j)=x(j)+e
  470 LET aa=VAL b$(j,v): LET aaa=VAL b$(j,v+e): LET ab=VAL b$(j,v+2*z): LET abb=VAL b$(j,v+e+2*z)
  500 LET a(aa,aaa)=0: LET aq=a(ab,abb)
  510 IF aq<9 AND aq>4 THEN LET y(aq-4)=y(aq-4)+e
  520 IF aq>a THEN LET t(aq-a)=0: LET y(2)=y(2)+e
  530 IF aq AND aq<5 THEN LET s(aq)=0: LET y(4)=y(4)+e
  540 LET a(ab,abb)=j+4
  550 PRINT AT 2*aa-2,2*aaa;"/\\";AT 2*aa-e,2*aaa;"\\/": BEEP .1,RND*b: PRINT AT e,3;y(e);AT e,22;y(2);AT 20,3;y(4);AT 20,22;y(3);AT 2*ab-2,2*abb; INK j=e; PAPER k(j);"\p\i";AT 2*ab-e,2*abb;"\o\n": BEEP .1,RND*b
  560 IF x(j)=4 THEN GO TO 8000
  580 IF z=6 THEN RANDOMIZE : GO TO 300
  590 RETURN 
  880 FOR p=e TO 100: NEXT p
  900 FOR p=e TO 3: PRINT PAPER 0; OVER e; INVERSE e;AT p+a-e,27;"   ": NEXT p
  910 BEEP e,-RND*b: IF z=6 THEN RANDOMIZE : GO TO 300
  920 RETURN 
 1000 IF sp=-e THEN GO TO 300
 1010 LET s=INT (RND*6+e)
 1020 FOR p=e TO 3: PRINT PAPER k(j); INK 9;AT p+9,27;d$(VAL e$(s,p)): NEXT p
 1050 PRINT #e;AT e,e; INVERSE e;"Your move? (0=No Move Possible)"
 1060 IF LEN INKEY$ THEN GO TO 1060
 1070 LET u$=INKEY$: IF u$<"0" OR u$>"4" THEN GO TO 1070
 1080 INPUT "": BEEP .05,a: LET v=VAL u$: IF v THEN GO TO 1200
 1100 IF s=6 THEN GO TO 1000+(50 AND y(j))
 1120 RETURN 
 1200 IF s<6 AND NOT (s(v) AND j=4)+(t(v) AND j=2) THEN GO TO 1050
 1202 IF j=4 AND a(b,5) AND a(b,5)<5 THEN GO SUB 2900+100*s
 1203 IF j=2 AND a(e,7)>=a THEN GO SUB 2950+100*s
 1205 IF (s(v) AND j=4)+(t(v) AND j=2)+s>44 OR (s(v) AND j=4)+(t(v) AND j=2)>40 THEN GO TO 1050
 1207 IF j=4 THEN IF s<6 OR NOT y(j) OR (a(b,5) AND a(b,5)<5) THEN GO TO 1260
 1208 IF j=2 THEN IF s<6 OR NOT y(j) OR a(e,7)>a THEN GO TO 1280
 1210 IF (t(v) AND j=2) OR (s(v) AND j=4) THEN GO TO 2000
 1215 BEEP e,b: IF j=2 THEN GO TO 1230
 1220 LET s(v)=e: LET y3=b: LET y4=5: GO TO 1240
 1230 LET t(v)=e: LET y3=e: LET y4=7
 1240 LET y(j)=y(j)-e: PRINT AT 20,3;y(4);AT e,22;y(2): LET l=a(y3,y4): GO TO 1335
 1260 LET y1=VAL b$(j,2*s(v)): LET y2=VAL b$(j,e+2*s(v)): LET y3=VAL b$(j,2*(s+s(v))): LET y4=VAL b$(j,e+2*(s+s(v)))
 1270 GO TO 1300
 1280 LET y1=VAL b$(j,2*t(v)): LET y2=VAL b$(j,e+2*t(v)): LET y3=VAL b$(j,2*(s+t(v))): LET y4=VAL b$(j,e+2*(s+t(v)))
 1300 LET l=a(y3,y4)
 1305 IF (l AND l<5 AND j=4) OR (l>a AND j=2) THEN GO TO 1050
 1310 PRINT AT 2*y1-2,2*y2;"/\\";AT 2*y1-e,2*y2;"\\/"
 1320 LET a(y1,y2)=0: IF j=2 THEN LET t(v)=t(v)+s: LET x(j)=x(j)+(t(v)>40): GO TO 1335
 1330 LET s(v)=s(v)+s: LET x(j)=x(j)+(s(v)>40)
 1335 IF l>a THEN LET t(l-a)=0: LET y(2)=y(2)+e
 1337 IF l>4 AND l<a THEN LET y(l-4)=y(l-4)+e
 1340 IF l AND l<5 THEN LET s(l)=0: LET y(4)=y(4)+e
 1350 LET a(y3,y4)=v+(a AND j=2): PRINT AT e,3;y(e);AT e,22;y(2);AT 20,3;y(4);AT 20,22;y(3);AT 2*y3-2,2*y4; INVERSE j=4;v;: PRINT PAPER k(j);"\i";AT 2*y3-e,2*y4;"\o\n"
 1360 BEEP .1,RND*b: IF x(j)=4 THEN GO TO 8000+50*j
 1370 IF s=6 THEN GO TO 1000
 1380 RETURN 
 2000 PRINT #e; INVERSE e;AT e,0;"No, you need to enter a new pawn": FOR p=e TO 200: NEXT p: INPUT "": GO TO 1050
 3000 IF NOT a(a,5) OR a(a,5)>4 THEN LET v=a(b,5)
 3010 RETURN 
 3050 IF a(2,7)<a THEN LET v=a(e,7)-a
 3060 RETURN 
 3100 IF NOT a(9,5) OR a(9,5)>4 THEN LET v=a(b,5)
 3110 RETURN 
 3150 IF a(3,7)<a THEN LET v=a(e,7)-a
 3160 RETURN 
 3200 IF NOT a(8,5) OR a(8,5)>4 THEN LET v=a(b,5)
 3210 RETURN 
 3250 IF a(4,7)<a THEN LET v=a(e,7)-a
 3260 RETURN 
 3300 IF NOT a(7,5) OR a(7,5)>4 THEN LET v=a(b,5)
 3310 RETURN 
 3350 IF a(5,7)<a THEN LET v=a(e,7)-a
 3360 RETURN 
 3400 IF NOT a(7,4) OR a(7,4)>4 THEN LET v=a(b,5)
 3410 RETURN 
 3450 IF a(5,8)<a THEN LET v=a(e,7)-a
 3460 RETURN 
 3500 IF NOT a(7,3) OR a(7,3)>4 THEN LET v=a(b,5)
 3510 RETURN 
 3550 IF a(5,9)<a THEN LET v=a(e,7)-a
 3560 RETURN 
 4000 LET aa=a(VAL b$(j,2),VAL b$(j,3))
 4010 IF aa=j+4 THEN GO TO 360
 4020 IF aa AND aa<5 THEN LET s(aa)=0: LET y(4)=y(4)+e
 4030 IF aa>a THEN LET t(aa-a)=0: LET y(2)=y(2)+e
 4040 IF aa>4 AND aa<a THEN LET y(aa-4)=y(aa-4)+e
 4050 LET a(VAL b$(j,2),VAL b$(j,3))=j+4: PRINT AT 2*VAL b$(j,2)-2,2*VAL b$(j,3); INK j=e; PAPER k(j);"\p\i";AT 2*VAL b$(j,2)-e,2*VAL b$(j,3);"\o\n": LET y(j)=y(j)-e
 4060 PRINT AT e,3;y(e);AT e,22;y(2);AT 20,3;y(4);AT 20,22;y(3)
 4080 FOR p=e TO a: BEEP .2,5*p-30: NEXT p: GO TO 300
 5000 DIM d$(5,3): DIM e$(6,3)
 5010 LET d$(e)="*  ": LET d$(2)=" * ": LET d$(3)="  *": LET d$(4)="* *"
 5020 LET e$(e)="525": LET e$(2)="153": LET e$(3)="123": LET e$(4)="454": LET e$(5)="424": LET e$(6)="444"
 5030 RETURN 
 6000 CLS : PRINT '"The game is  played  with 4 setsof four ""men"" (pawns), a die andthe board or field."'"Object  of the game is to  bringone's men  into the field,  movethem CLOCKWISE  around the fieldaccording  to the  throw  of thedie, until they are safely home,an area indicated by #'s."'"The player first to bring his orher men home, is the winner."
 6012 PRINT '"A pawn landing at a spot alreadyoccupied by  an  opposing  pawn,knocks it off the field! A  pawnknocked off like this, can't re-enter the game until  the playerthrows a six (as at the start ofplay)."'"You may  NOT knock  yourself offthe field!" 
 6013 PRINT '"There are always four players.  One or two  players play againstthe computer, which  will thuslyplay the role of either three ortwo opponents respectively.     There is also the possibility ofhaving the computer play againstitself!" 
 6020 PRINT '"A pawn standing at  the startingplace  HAS to  move at  the nextopportunity, even when there areno more pawns  of the same colorparked outside the field!"'"However, should  your die cast anumber that would result in yourbumping off one of your own men,then you are allowed to move oneof your other  men. Next  round,you HAVE to move the start-pawn!"
 6022 PRINT '"Highest number  cast, starts thegame. You're  , the computer  .   throws first: press  a key andthe result is displayed. Press akey again to show the computer'sthrow." 
 6024 PRINT '"If one player  plays against thecomputer, your color's   and thecomputer plays  ,   and  .      If two play against the computeryour colors are   and  ."  
 6026 PRINT '"If it's your  turn, the computerwill ask you which pawn you wantto move.  You  have four  pawns,numbered 1 through 4. The die ofyour color needs to throw a six,before you're  allowed  to entera pawn in the field.  Each  timeyou throw a six, you are grantedanother throw of the die." 
 6040 PRINT '"A  pawn, which has  entered  thehome area, can not be moved any-more!"'"""Bouncing back"" is NOT allowed."'"Therefore, if you threw too manypoints, you can't move that pawnand have to consider moving someother pawn!"
 6050 PRINT '"Now remains to indicate how manyplayers will  play  against  thecomputer."'''''',u$;"SUCCESS"''''
 6055 PRINT #e;"Press any key.": PAUSE 0: INPUT ""
 6310 PRINT #e;"How many  will play  against thecomputer? (0, 1 or 2)": PAUSE 0: CLS : LET s$=INKEY$: LET sp=CODE s$-CODE "1": IF s$<"0" OR sp>e THEN GO TO 6310
 6320 CLS : RETURN 
 7000 RANDOMIZE : FOR j=e TO 4
 7010 IF j=e OR j=3 THEN GO SUB 3000
 7020 IF j=2 THEN GO SUB 300+(700 AND sp)
 7030 IF j=4 THEN GO SUB 1000
 7040 NEXT j: GO TO 7000
 8000 IF sp=-e THEN GO TO 8500
 8010 INPUT "": PRINT #e;AT 0,0;"You have ";"both " AND sp;"lost the game": GO TO 8500
 8100 INPUT "": PRINT #e;AT 0,0;"  has won the game!": GO TO 8500
 8200 INPUT "": IF sp THEN PRINT #e;AT 0,0;"  has won the game!": GO TO 8500
 8210 PRINT #e;AT 0,0;"You have won the game!"
 8500 PRINT #e;AT e,0;"Another game? (y/n)",
 8510 IF LEN INKEY$ THEN GO TO 8510
 8520 IF NOT LEN INKEY$ THEN GO TO 8520
 8530 IF INKEY$="n" OR INKEY$="N" THEN NEW 
 8540 RUN 
 9200 CLEAR : SAVE "parchisi" LINE 1: VERIFY ""
 9300 DATA "\p",255,255,254,252,252,254,254,252
 9310 DATA "\i",255,255,63,31,31,63,63,31
 9320 DATA "\o",252,248,248,240,240,224,255,255
 9330 DATA "\n",31,15,15,7,7,3,255,255