home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / library / gwbasic / spiele / backgam.bas < prev    next >
Encoding:
BASIC Source File  |  1991-05-15  |  6.3 KB  |  125 lines
  1. 2430 KEY OFF:CLS:COLOR 0,7:LOCATE 1,30:KEY(10) ON:ON KEY(10) GOSUB 5000:PRINT" B A C K G A M M O N ":COLOR 7,0
  2. 2440 FOR X=1 TO 2:LOCATE 12,1:PRINT SPC(79):LOCATE 12,1:PRINT"Enter the name of player #" X;:PLAY "mbc":INPUT " - " ,A$(X):NEXT X
  3. 2450 DEFINT A,D-J,L-M,S-U,X-Z:GOSUB 59980:DIM A(25)
  4. 2460 LOCATE 12,1:PRINT SPC(79):LOCATE 5,10:PRINT"Your pips look like this:"
  5. 2462 LOCATE 7,30:PRINT A$(1) TAB(45) " - ▀▀▀":LOCATE 9,30:PRINT A$(2) TAB(45) " - ▀ ▀"
  6. 2470 LOCATE 25,1:PRINT "Press any key to continue";:PLAY "c":GOSUB 59990
  7. 2480 FOR X=0 TO 25:A(X)=0:NEXT X
  8. 2482 A(24)=2:A(19)=-5:A(17)=-3:A(13)=5:A(12)=-5:A(8)=3:A(6)=5:A(1)=-2
  9. 2500 GOSUB 2590:W=0:IF INT(RND*2+1)=2 THEN W=1
  10. 2510 LOCATE 25,1:PRINT SPC(79):LOCATE 25,1:PRINT A$(W+1);
  11. 2520 COLOR 15:PRINT"   1";:COLOR 7:PRINT"=ROLL DICE, ";:COLOR 15:PRINT"2";:COLOR 7:PRINT"=REDRAW BOARD, ";:COLOR 15:PRINT"3";:COLOR 7:PRINT"=NEW GAME";
  12. 2530 PLAY "c":GOSUB 59990:IF INSTR("123",IKEY$)=0 THEN 2530 ELSE X=VAL(IKEY$)
  13. 2540 ON X GOTO 2560, 2550, 2480:GOTO 2510
  14. 2550 GOSUB 2590:GOTO 2510
  15. 2560 L=INT(RND*6+1):M=INT(RND*6+1):D=2:IF L=M THEN D=4 ELSE IF L<M THEN SWAP L,M
  16. 2570 ON W+1 GOTO 2770, 3080
  17. 2580 PLAY "ae":LOCATE 25,1:PRINT SPC(79):LOCATE 25,1:PRINT"INVALID MOVE";:TIMEOUT=6:GOSUB 59950:RETURN
  18. 2590 CLS:FOR X=20 TO 70 STEP 4:FOR Y=3 TO 19:LOCATE Y,X:PRINT"║";:NEXT Y,X
  19. 2600 LOCATE 2,20:PRINT"╔═══╦═══╦═══╦═══╦═══╦═══╦═══╦═══╦═══╦═══╦═══╦═══╗";
  20. 2610 LOCATE 20,20:PRINT"╚═══╩═══╩═══╩═══╩═══╩═══╩═══╩═══╩═══╩═══╩═══╩═══╝";
  21. 2620 LOCATE 11,20:PRINT"╠═══╬═══╬═══╬═══╬═══╬═══╬═══╬═══╬═══╬═══╬═══╬═══╣";
  22. 2630 Y=24:FOR X=21 TO 65 STEP 4:LOCATE 1,X:PRINT Y;:Y1=25-Y:LOCATE 21,X:PRINT Y1;:Y=Y-1:NEXT X
  23. 2640 LOCATE 11,5:PRINT"ON BAR";:LOCATE 10,6:PRINT"▀ ▀";:LOCATE 12,6:PRINT"▀▀▀";
  24. 2650 LOCATE 9,6:PRINT A(0);:LOCATE 13,6:PRINT A(25);
  25. 2660 FOR X=24 TO 13 STEP -1
  26. 2670 IF A(X)=0 THEN 2710 ELSE  U=1:IF A(X)<0 THEN U=2
  27. 2680 FOR Z=1 TO ABS(A(X)):S=3+Z-1
  28. 2690 Y=(24-X)*4+21:LOCATE S,Y:IF U=1 THEN PRINT"▀▀▀"; ELSE PRINT"▀ ▀";
  29. 2700 NEXT Z
  30. 2710 NEXT X
  31. 2720 FOR X=1 TO 12:IF A(X)=0 THEN 2765
  32. 2730 U=1:IF A(X)<0 THEN U=2
  33. 2740 FOR Z=1 TO ABS(A(X)):S=20-Z
  34. 2750 Y=(X-1)*4+21:LOCATE S,Y:IF U=1 THEN PRINT"▀▀▀"; ELSE PRINT"▀ ▀";
  35. 2760 NEXT Z
  36. 2765 NEXT X:RETURN
  37. 2770 LOCATE 25,1:PRINT SPC(79);:LOCATE 25,1:PRINT A$(1) ", your roll is  ";:COLOR 15:PRINT L;:COLOR 7
  38. 2780 J=25:IF D>1 THEN COLOR 15:PRINT M;:COLOR 7
  39. 2790 IF A(25)>0 AND A(25-L)<-1 AND A(25-M)<-1 THEN 3070
  40. 2800 IF A(J)<1 THEN J=J-1:GOTO 2800
  41. 2810 E=0:FOR X=L+1 TO 25:IF A(X)>0 AND A(X-L)>-2 THEN E=1
  42. 2820 NEXT X:FOR X=M+1 TO 25:IF A(X)>0 AND A(X-M)>-2 THEN E=1
  43. 2830 NEXT X:IF E=1 THEN 2850 ELSE IF J>6 THEN 3070
  44. 2840 IF A(M)<1 AND A(L)<1 AND J>L THEN 3070
  45. 2850 IF A(25)>0 THEN F=25:LOCATE 25,40:COLOR 15:PRINT"FROM BAR ";:COLOR 7:GOTO 2880
  46. 2860 PLAY "d":LOCATE 25,40:COLOR 15:INPUT;"FROM-- ",IN$:COLOR 7:F=VAL(IN$):IF F<1 OR F>24 THEN 2940
  47. 2870 IF A(F)<1 THEN 2940
  48. 2880 PLAY "d":LOCATE 25,60:COLOR 15:INPUT;"TO-- ",IN$:COLOR 7:T=VAL(IN$)
  49. 2890 IF T=99 THEN 3020
  50. 2900 IF T<1 OR T>24 THEN 2940
  51. 2910 IF A(T)<-1 THEN 2940
  52. 2920 IF F-T=L THEN L=M:GOTO 2950
  53. 2930 IF F-T=M THEN M=L:GOTO 2950
  54. 2940 GOSUB 2580:GOTO 2770
  55. 2950 A(F)=A(F)-1:IF A(T)=-1 THEN A(0)=A(0)+1:A(T)=0
  56. 2960 A(T)=A(T)+1
  57. 2970 GOSUB 3430:D=D-1:E=0:FOR X=1 TO 25
  58. 2980 IF A(X)<1 THEN E=E+1
  59. 2990 NEXT X:IF E=25 THEN 3580
  60. 3000 IF D=0 THEN W=1:GOTO 2510
  61. 3010 GOTO 2770
  62. 3020 IF J>6 THEN 2940
  63. 3030 IF F=M OR M>J AND F=J THEN M=L:GOTO 3060
  64. 3040 IF F=L OR L>J AND F=J THEN L=M:GOTO 3060
  65. 3050 GOTO 2940
  66. 3060 A(F)=A(F)-1:GOTO 2970
  67. 3070 PLAY "ae":TIMEOUT=3:GOSUB 59950:LOCATE 25,1:PRINT SPC(79);:LOCATE 25,1:PRINT"You can't move!";:W=ABS(W-1):TIMEOUT=6:GOSUB 59950:LOCATE 25,1:PRINT SPC(79);:GOTO 2510
  68. 3080 LOCATE 25,1:PRINT SPC(79);:LOCATE 25,1:PRINT A$(2) ", your roll is  ";:COLOR 15:PRINT L;:COLOR 7
  69. 3090 IF D>1 THEN COLOR 15:PRINT M;:COLOR 7
  70. 3100 J=0
  71. 3110 IF A(0)>0 AND A(L)>1 AND A(M)>1 THEN 3070
  72. 3120 IF A(0)<1 AND A(J)>=0 THEN J=J+1:GOTO 3120
  73. 3130 E=0:IF A(0)>0 AND A(L)<2 THEN E=1
  74. 3140 IF A(0)>0 AND A(M)<2 THEN E=1
  75. 3150 FOR X=1 TO 24-L:IF A(X)<0 AND A(X+L)<2 THEN E=1
  76. 3160 NEXT X:FOR X=1 TO 24-M:IF A(X)<0 AND A(X+M)<2 THEN E=1
  77. 3170 NEXT X:IF E=1 THEN 3200
  78. 3180 IF J<19 THEN 3070
  79. 3190 IF A(25-M)>-1 AND A(25-L)>-1 AND J<25-L THEN 3070
  80. 3200 IF A(0)>0 THEN F=0:LOCATE 25,40:COLOR 15:PRINT"FROM BAR ";:COLOR 7:GOTO 3240
  81. 3210 PLAY "f":LOCATE 25,40:COLOR 15:INPUT;"FROM-- ",IN$:COLOR 7:F=VAL(IN$)
  82. 3220 IF F<1 OR F>24 THEN 3290
  83. 3230 IF A(F)>-1 THEN 3290
  84. 3240 PLAY "f":LOCATE 25,60:COLOR 15:INPUT;"TO-- ",IN$:COLOR 7:T=VAL(IN$):IF T=99 THEN 3380
  85. 3250 IF T<1 OR T>24 THEN 3290
  86. 3260 IF A(T)>1 THEN 3290
  87. 3270 IF T-F=L THEN L=M:GOTO 3300
  88. 3280 IF T-F=M THEN M=L:GOTO 3300
  89. 3290 GOSUB 2580:GOTO 3080
  90. 3300 IF F=0 THEN A(0)=A(0)-2
  91. 3310 A(F)=A(F)+1:IF A(T)=1 THEN A(25)=A(25)+1:A(T)=0
  92. 3320 A(T)=A(T)-1
  93. 3330 GOSUB 3430:D=D-1:E=0:FOR X=1 TO 25
  94. 3340 IF A(X)>-1 THEN E=E+1
  95. 3350 NEXT X:IF E=25 THEN 3590
  96. 3360 IF D=0 THEN W=0:GOTO 2510
  97. 3370 GOTO 3080
  98. 3380 IF J<19 THEN 3290
  99. 3390 IF F=25-M OR J>25-M AND F=J THEN M=L:GOTO 3420
  100. 3400 IF F=25-L OR J>25-L AND F=J THEN L=M:GOTO 3420
  101. 3410 GOTO 3290
  102. 3420 A(F)=A(F)+1:GOTO 3330
  103. 3430 LOCATE 9,6:PRINT A(0);:LOCATE 13,6:PRINT A(25);:IF F=0 OR F=25 THEN 3450
  104. 3440 H=F:GOSUB 3460:IF T=99 THEN RETURN
  105. 3450 H=T:GOSUB 3460:RETURN
  106. 3460 U=1:IF A(H)<0 THEN U=2
  107. 3470 P=A(H):IF P>8 THEN P=8
  108. 3480 IF H<=12 THEN 3510
  109. 3490 X=(24-H)*4+21:G=0:IF H=F THEN G=1
  110. 3500 Y=2+ABS(P)+G:GOTO 3540
  111. 3510 X=(H-1)*4+21:G=0:IF H=F THEN G=1
  112. 3520 Y=20-ABS(P)-G
  113. 3540 LOCATE Y,X:PRINT"   ";
  114. 3550 IF H<>T THEN RETURN
  115. 3560 LOCATE Y,X:IF U=1 THEN PRINT"▀▀▀"; ELSE PRINT"▀ ▀";
  116. 3570 RETURN
  117. 3580 PLAY "c16c16c16ge8g":LOCATE 25,1:PRINT SPC(79);:COLOR 25:LOCATE 25,1:PRINT A$(1) " WINS";:TIMEOUT=6:GOSUB 59950:COLOR 7:RUN "b:???0??"
  118. 3590 PLAY "c16c16c16ge8g":LOCATE 25,1:PRINT SPC(79);:COLOR 25:LOCATE 25,1:PRINT A$(2) " WINS";:TIMEOUT=6:GOSUB 59950:COLOR 7:RUN "b:???0??"
  119. 5000 RUN "menu"
  120. 59950 TIMEOUT$=TIME$:TIME2=VAL(LEFT$(TIMEOUT$,2))*120+VAL(MID$(TIMEOUT$,4,2))*60+VAL(RIGHT$(TIMEOUT$,2))
  121. 59960 TIMEOUT$=TIME$:TIME3=VAL(LEFT$(TIMEOUT$,2))*120+VAL(MID$(TIMEOUT$,4,2))*60+VAL(RIGHT$(TIMEOUT$,2))
  122. 59970 IF TIMEOUT > TIME3 - TIME2 THEN 59960 ELSE RETURN
  123. 59980 RNDTIME$=TIME$:RNDVAL=VAL(LEFT$(RNDTIME$,2))*120+VAL(MID$(RNDTIME$,4,2))*60+VAL(RIGHT$(RNDTIME$,2)):RANDOMIZE RNDVAL:RETURN
  124. 59990 ON KEY(1) GOSUB 5000:IKEY$=INKEY$:IF IKEY$="" THEN 59990 ELSE RETURN
  125.