Dutch Parcheesi-like boardgame.
Content
Image Gallery
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