home *** CD-ROM | disk | FTP | other *** search
/ Explore the World of Soft…ids, Adults, Educational / RocelcoInc-ExploreTheWorldOfSoftware-KidsAdultsEducational-Vol2-Shareware.iso / educate / disk116 / backgam.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1982-11-04  |  4.6 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:PRINTSPC(79):LOCATE 5,10:PRINT"Your pips look like this:"
  5. 2462  LOCATE 7,30:PRINT A$(1) TAB(45) " - <0xDF!><0xDF!><0xDF!>":LOCATE 9,30:PRINT A$(2) TAB(45) " - <0xDF!> <0xDF!>"
  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"OPEN";:NEXT Y,X
  19. 2600  LOCATE 2,20:PRINT"KEYTHENTHENTHEN<0xCB!>THENTHENTHEN<0xCB!>THENTHENTHEN<0xCB!>THENTHENTHEN<0xCB!>THENTHENTHEN<0xCB!>THENTHENTHEN<0xCB!>THENTHENTHEN<0xCB!>THENTHENTHEN<0xCB!>THENTHENTHEN<0xCB!>THENTHENTHEN<0xCB!>THENTHENTHEN<0xCB!>THENTHENTHENCLOSE";
  20. 2610  LOCATE 20,20:PRINT"SCREENTHENTHENTHENLOCATETHENTHENTHENLOCATETHENTHENTHENLOCATETHENTHENTHENLOCATETHENTHENTHENLOCATETHENTHENTHENLOCATETHENTHENTHENLOCATETHENTHENTHENLOCATETHENTHENTHENLOCATETHENTHENTHENLOCATETHENTHENTHENLOCATETHENTHENTHENLOAD";
  21. 2620  LOCATE 11,20:PRINT"TOTHENTHENTHENTAB(THENTHENTHENTAB(THENTHENTHENTAB(THENTHENTHENTAB(THENTHENTHENTAB(THENTHENTHENTAB(THENTHENTHENTAB(THENTHENTHENTAB(THENTHENTHENTAB(THENTHENTHENTAB(THENTHENTHENTAB(THENTHENTHENRANDOMIZE";
  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"<0xDF!> <0xDF!>";:LOCATE 12,6:PRINT"<0xDF!><0xDF!><0xDF!>";
  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"<0xDF!><0xDF!><0xDF!>"; ELSE PRINT"<0xDF!> <0xDF!>";
  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"<0xDF!><0xDF!><0xDF!>"; ELSE PRINT"<0xDF!> <0xDF!>";
  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:PRINTL;: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"<0xDF!><0xDF!><0xDF!>"; ELSE PRINT"<0xDF!> <0xDF!>";
  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.