home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / library / gwbasic / friendly / craps.bas < prev    next >
Encoding:
BASIC Source File  |  1994-05-25  |  9.3 KB  |  115 lines
  1. 10 COLOR 3,0:SCREEN 0,0,0:LOCATE ,,0:CLS:DEFSTR A:H=10:H1=1:KEY(10) ON:ON KEY(10) GOSUB 850
  2. 20 GOSUB 1100:GOSUB 430:GOSUB 410:GOSUB 330
  3. 30 GOSUB 870:GOSUB 920
  4. 40 IF H<1 THEN GOSUB 630
  5. 50 IF H+H1*10>100 THEN 1070
  6. 60 GOSUB 150:GOSUB 400:GOSUB 320
  7. 70 K=INT(C+D):IF K=7 OR K=11 THEN IF P=0 THEN 270 ELSE 290
  8. 80 IF K=2 OR K=3 OR K=12 THEN IF P=0 THEN 290 ELSE 270
  9. 90 LOCATE 2,29:PRINT"   THE POINT IS"K"    ":J=7
  10. 100 GOSUB 1080:LOCATE 3,J*4+10:PRINT A2;:GOSUB 400
  11. 110 J=INT(C+D):COLOR 15:LOCATE 3,J*4+10:PRINT A1;:COLOR 3,0
  12. 120 IF J=K THEN IF P=1 THEN 290 ELSE 270
  13. 130 IF J=7 THEN IF P=0 THEN 290 ELSE 270
  14. 140 GOTO 100
  15. 150 LOCATE 21,24:PRINT SPC(35):LOCATE 21,24:COLOR 15
  16. 160 PRINT"Bet on `PASS' or `DON'T PASS' <P/D>?";:COLOR 3,0
  17. 170 GOSUB 1080:IF RP$="P" THEN P=0:GOTO 190 ELSE IF RP$="D" THEN P=1:GOTO 190
  18. 180 LOCATE 23,21:PRINT"Strike <P> For PASS or <D> For DON'T PASS";:FOR F=1 TO 2000:NEXT:LOCATE 23,20:PRINT SPC(42):GOTO 170
  19. 190 COLOR 15:IF P THEN LOCATE 13,60:PRINT"**":LOCATE 13,32:PRINT"  ";:GOTO 210
  20. 200 LOCATE 13,32:PRINT"**":LOCATE 13,60:PRINT"  "
  21. 210 COLOR 3,0:R1%=20:C1%=1:R2%=21:C2%=64:GOSUB 1140:LOCATE 21,30:PRINT"Place Your Bets Please"
  22. 220 GOSUB 530:IF G>0 THEN 240
  23. 230 LOCATE 23,23:PRINT"Please Bet An Amount Greater Than Zero";:FOR F=1 TO 4000:NEXT:LOCATE 23,23:PRINT SPC(40):GOTO 220
  24. 240 IF G=<H+H1*10 THEN 260
  25. 250 LOCATE 23,15:PRINT"Hey, I Ain't Stupid! You Don't Have That Much.":FOR F=1 TO 2500:NEXT:LOCATE 23,15:PRINT SPC(46):GOTO 220
  26. 260 LOCATE 21,1:PRINT SPC(62):H=H-G:GOSUB 920:LOCATE 10,69:COLOR 15:PRINT USING "$$#####,.##";H*100+H1*1000:COLOR 3,0:LOCATE 2,29:PRINT"***** COMING OUT *****":LOCATE 22,10:PRINT SPC(50):LOCATE 15,8+P*20+9:GOSUB 970:RETURN
  27. 270 LOCATE 23,10:PRINT SPC(50):LOCATE 23,37:PRINT"You Win!";:H=H+2*G
  28. 280 PLAY "MN T120":PLAY "O3 P8 O2E8 O2G8. O2E16 F8 G4.":G=G*2:GOTO 300
  29. 290 LOCATE 23,10:PRINT SPC(50):LOCATE 23,32:PRINT"Sorry, You Lose.":FOR F=1 TO 8:SOUND 50,1:SOUND 37,1:SOUND 40,1:NEXT
  30. 300 GOSUB 910:LOCATE 10,69:COLOR 15:PRINT USING "$$#####,.##";H*100+H1*1000:COLOR 3,0
  31. 310 FOR F=1 TO 1000:NEXT:LOCATE 2,29:PRINT SPC(25):LOCATE 3,K*4+10:PRINT A2;:LOCATE 3,(C+D)*4+10:PRINT A2;:LOCATE 15,10:PRINT SPC(50):R1%=22:C1%=10:R2%=23:C2%=60:GOSUB 1140:GOTO 40
  32. 320 LOCATE 3,(C+D)*4+10:PRINT A1;:RETURN
  33. 330 LOCATE 1,15:PRINT"╔"STRING$(50,205)"╗":FOR B=2 TO 13:LOCATE B,15:PRINT"║":LOCATE B,66:PRINT"║":NEXT:LOCATE 12,15:PRINT"╠"STRING$(24,205)"╦"STRING$(25,205)"╣":LOCATE 14,15:PRINT"╚"STRING$(24,205)"╩"STRING$(25,205)"╝":LOCATE 13,40:PRINT"║"
  34. 340 LOCATE 13,16:PRINT"         PASS":LOCATE 13,41:PRINT"       DON'T PASS":LOCATE 10,69:COLOR 15:PRINT USING "$$#####,.##";H*100+H1*1000:COLOR 3,0:LOCATE 4,16:PRINT"    2   3   4   5   6   7   8   9  10  11  12
  35. 350 LOCATE 6,31:PRINT"┌"STRING$(7,196)"┐":LOCATE 6,41:PRINT"┌"STRING$(7,196)"┐":LOCATE 7,31:PRINT"│":LOCATE 7,39:PRINT"│":LOCATE 7,41:PRINT"│":LOCATE 7,49:PRINT"│":LOCATE 8,31:PRINT"│":LOCATE 8,39:PRINT"│":LOCATE 8,41:PRINT"│":LOCATE 8,49:PRINT"│"
  36. 360 LOCATE 9,31:PRINT"│":LOCATE 9,39:PRINT"│":LOCATE 9,41:PRINT"│":LOCATE 9,49:PRINT"│":LOCATE 10,31:PRINT"└"STRING$(7,196)"┘":LOCATE 10,41:PRINT"└"STRING$(7,196)"┘":LOCATE 7,68:PRINT STRING$(13,178):LOCATE 8,68:PRINT"▓ YOU  HAVE":LOCATE 8,80:PRINT"▓";
  37. 370 LOCATE 8,69:COLOR 15,0:PRINT" YOU  HAVE ";:COLOR 3,0:LOCATE 9,68:PRINT"▓":LOCATE 9,80:PRINT"▓":LOCATE 10,68:PRINT"▓":LOCATE 10,80:PRINT"▓":LOCATE 11,68:PRINT STRING$(13,178):LOCATE 7,1:COLOR 15:PRINT STRING$(13,176)
  38. 380 LOCATE 8,1:PRINT"░N E V A D A░":LOCATE 9,1:PRINT"░           ░":LOCATE 10,1:PRINT"░  D I C E  ░":LOCATE 11,1:PRINT STRING$(13,176):COLOR 3,0:RETURN
  39. 390 LOCATE 7,32:PRINT A(0);:LOCATE 7,42:PRINT A(0);
  40. 400 COLOR 15:FOR B=1 TO 6:SOUND 137,.01:LOCATE 7,32:C=INT(RND(1)*6)+1:PRINT A(C):SOUND 37,0:RANDOMIZE(VAL(RIGHT$(TIME$,2))*RND):LOCATE 7,42:D=INT(RND(1)*6)+1:PRINT A(D):SOUND 137,.01:RANDOMIZE(VAL(RIGHT$(TIME$,2))):SOUND 37,0:NEXT:COLOR 3,0:RETURN
  41. 410 A=STRING$(7,29)+CHR$(31):A0="       ":A1="   ■   ":A2=" ■   ■ ":A3=" ■     ":A4="     ■ ":A(0)=A0+A+A0+A+A0:A(1)=A0+A+A1+A+A0:A(2)=A3+A+A0+A+A4:A(3)=A3+A+A1+A+A4:A(4)=A2+A+A0+A+A2:A(5)=A2+A+A1+A+A2:A(6)=A2+A+A2+A+A2
  42. 420 A1="╔══╗"+CHR$(31)+STRING$(4,29)+"║"+STRING$(2,28)+"║"+CHR$(31)+STRING$(4,29)+"╚══╝":A2="    "+CHR$(31)+STRING$(4,29)+" "+STRING$(2,28)+" "+CHR$(31)+STRING$(4,29)+"    ":RETURN
  43. 430 CLS:LOCATE 1,1:PRINT STRING$(80,219):FOR B=2 TO 22:LOCATE B,1:PRINT"█":LOCATE B,80:PRINT"█":NEXT:LOCATE B,1:PRINT STRING$(80,219);:LOCATE 4,30:COLOR 15,0:PRINT"N E V A D A   D I C E
  44. 440 LOCATE 10,24:COLOR 15:PRINT"Would You Like Instructions? <Y/N>":COLOR 3,0
  45. 450 GOSUB 1080:IF RP$="N" THEN CLS:RETURN ELSE IF RP$<>"Y" THEN 450
  46. 460 LOCATE 2,30:COLOR 15,0:PRINT"N E V A D A   D I C E     ": COLOR 3,0:LOCATE 4,10:PRINT"Friendlyware's NEVADA  DICE differs from the CASINO-STYLE game":LOCATE 5,10:PRINT"in TWO ways: there  are  no  sidebets (hardways,fieldbets,etc)
  47. 470 LOCATE 6,10:PRINT"              AND WE CAN'T TAKE ANY OF YOUR CASH":LOCATE 8,10:PRINT"The  object  is  to  accumulate  money  by  throwing  as many":LOCATE 9,10:PRINT"`PASSES' as  you can. A `PASS'  is a  winning  roll. A  `ROLL'
  48. 480 LOCATE 10,10:PRINT"can be  and  usually is,  more  than  one  roll  of the  dice.":LOCATE 12,10:PRINT"On your  first throw one of three things can happen: 1) You":LOCATE 13,10:PRINT"will throw a `NATURAL'  7  or  11  YOU WIN, 2) You will throw
  49. 490 LOCATE 14,10:PRINT"2, 3, 12,  YOU  LOSE  or    3) You will establish your `POINT'":LOCATE 15,10:PRINT"by  throwing a  4, 5, 6, 8, 9  or 10. ( 7 and 11 are  winners":LOCATE 16,10:PRINT"and  2, 3, and  12  are  losers  on  the  FIRST  throw  only).
  50. 500 LOCATE 18,10:PRINT"You're a  winner if you  throw  your  POINT  again ";:COLOR 1:PRINT"before";:COLOR 3,0:PRINT" you":LOCATE 19,10:PRINT"throw a 7. You lose if you roll a 7 before rolling your POINT.
  51. 510 LOCATE 20,10:PRINT"You may also bet  AGAINST  the dice or DON'T PASS. This means":LOCATE 21,10:PRINT"you  WIN  your bet if the  DICE LOSE and LOSE if the DICE WIN.":LOCATE 25,27:COLOR 15:PRINT"Strike Any Key To Continue";:COLOR 3,0
  52. 520 GOSUB 1080:CLS:RETURN
  53. 530 LOCATE 22,1:PRINT SPC(62):LOCATE 22,26:COLOR 15:PRINT"How Many Chips?   From 1 To";H+H1*10;:COLOR 3,0
  54. 540 A0=""
  55. 550 A=INKEY$:IF A="" THEN 550 ELSE IF A=" " THEN G=VAL(A0):RETURN
  56. 560 IF A=CHR$(13) THEN 550
  57. 570 IF LEN(A0)>2 THEN G=99:RETURN
  58. 580 COLOR 15:LOCATE 23,30
  59. 590 PRINT"Press Space Bar To Roll":LOCATE 22,57+LEN(A0):COLOR 3,0
  60. 600 IF A=CHR$(8) THEN IF LEN(A0)>0 THEN 620 ELSE 550
  61. 610 A0=A0+A:PRINT A;:GOTO 550
  62. 620 PRINT CHR$(29)" "CHR$(29);:A0=LEFT$(A0,LEN(A0)-1):GOTO 550
  63. 630 COLOR 15:LOCATE 22,26:PRINT"You Don't Have Any More Money.
  64. 640 LOCATE 23,24:PRINT"Would You Like To Sell Your";
  65. 650 XXX=XXX+1:ON XXX-1 GOTO 680,690,700,710,720,730,740
  66. 660 IF XXX>7 THEN XXX=0
  67. 670 PRINT" Car?";:VV=20:GOTO 750
  68. 680 PRINT" Boat?";:VV=20:GOTO 750
  69. 690 PRINT" Computer?";:VV=20:GOTO 750
  70. 700 PRINT" Motorcycle?";:VV=18:GOTO 750
  71. 710 PRINT" Stereo?";:VV=12:GOTO 750
  72. 720 PRINT" Golf Clubs?";:VV=6:GOTO 750
  73. 730 PRINT" House?";:VV=5:GOTO 750
  74. 740 PRINT" Skate Board?";:VV=5:GOTO 750
  75. 750 PRINT" <Y/N>";:COLOR 3,0
  76. 760 GOSUB 1080:IF RP$="Y" THEN 770 ELSE IF RP$<>"N" THEN 760 ELSE 880
  77. 770 H1=0:H=VV
  78. 780 IF H>9 THEN H1=H1+1:H=H-10:GOTO 780
  79. 790 LOCATE 22,15:PRINT"          OK. I'll give you $"VV*100"for it.      "
  80. 800 LOCATE 23,1:PRINT SPC(79);
  81. 810 FOR F=1 TO 2500:NEXT:R1%=22:C1%=10:R2%=23:C2%=64:GOSUB 1140
  82. 820 LOCATE 10,69:COLOR 15:PRINT USING "$$#####,.##";H*100+H1*1000:GOTO 920
  83. 830 FOR F=1 TO 3500:NEXT:CLS:LOCATE 12,20:COLOR 15:PRINT"Would You Like To Play Again? <Y/N>";:COLOR 3,0
  84. 840 GOSUB 1080:IF RP$="Y" THEN RUN ELSE IF RP$="N" THEN 880 ELSE 840
  85. 850 KEY(10) OFF:COLOR 15:LOCATE 25,23:PRINT"Do You Wish To Leave This Game? <Y/N>";
  86. 860 GOSUB 1080:IF RP$="Y" THEN 880 ELSE IF RP$<>"N" THEN 860
  87. 870 LOCATE 25,1:PRINT SPC(60);:LOCATE 25,25:COLOR 0,15:PRINT" Strike <F10> To Leave This Game ";:COLOR 3,0:LOCATE 25,68:PRINT"100's 1000's";:LOCATE 23,35:PRINT SPC(10):LOCATE 23,35:A0="":A="":KEY(10) ON:RETURN
  88. 880 ON ERROR GOTO 890:RUN"MENU1"
  89. 890 ON ERROR GOTO 900:RUN"MENU2"
  90. 900 RUN"MENU3"
  91. 910 :R1%=16:C1%=14:R2%=18:C2%=64:GOSUB 1140
  92. 920 COLOR 3,0:IF H<1 THEN IF H1>0 THEN H1=H1-1:H=H+10:GOTO 920
  93. 930 IF H>10 THEN H1=H1+1:H=H-10:GOTO 930
  94. 940 COLOR 15:R1%=13:C1%=68:R2%=23:C2%=79:GOSUB 1140:FOR F=23 TO 24-H STEP-1:LOCATE F,68:PRINT"▀▀▀";:NEXT
  95. 950 IF H1>12 THEN HH=12 ELSE HH=H1
  96. 960 FOR F=23 TO 24-HH STEP-1:LOCATE F,74:PRINT"▀▀▀▀▀";:NEXT:COLOR 3,0:RETURN
  97. 970 G1=G:G2=0
  98. 980 IF G1>9 THEN G2=G2+1:G1=G1-10:GOTO 980
  99. 990 F2=14+P*25:F=0
  100. 1000 IF F=G2 THEN 1020
  101. 1010 FOR F1=18 TO 16 STEP-1:IF F=G2 THEN 1020 ELSE F=F+1:LOCATE F1,5+F2:PRINT"▀▀▀▀▀";:NEXT F1:F2=F2+6:GOTO 1000
  102. 1020 F2=F2+6:F=0
  103. 1030 IF F=G1 THEN RETURN
  104. 1040 FOR F1=18 TO 16 STEP-1:IF F=G1 THEN 1060 ELSE F=F+1
  105. 1050 LOCATE F1,5+F2:PRINT"▀▀▀";:NEXT F1
  106. 1060 F2=F2+4:GOTO 1030
  107. 1070 FOR F=1 TO 5:SOUND 500,1:SOUND 200,1:SOUND 150,1:NEXT:CLS:LOCATE 10,26:COLOR 31:PRINT"YOU BROKE THE BANK !!!!!!!":COLOR 3,0:FOR F=1 TO 10:SOUND 500,1:SOUND 200,1:SOUND 150,1:NEXT:GOTO 830
  108. 1080 IF INKEY$<>"" THEN 1080
  109. 1090 DEF SEG=&H40:POKE &H17,(PEEK(&H17) OR 96):RP$=INKEY$:IF RP$="" THEN 1090 ELSE RETURN
  110. 1100 DIM A%(22):FOR I=0 TO 21:READ A%(I):NEXT:RETURN
  111. 1110 DATA &h8b55,&hb8ec,&h0600,&h07b7,&h768b,&h8a0c,&h8b2c
  112. 1120 DATA &h0a76,&h0c8a,&h768b,&h8a08,&h8b34,&h0676,&h148a
  113. 1130 DATA &hcdfe,&hc9fe,&hcefe,&hcafe,&h10cd,&hca5d,&h8,&h,0
  114. 1140 DEF SEG:SUBRT%=VARPTR(A%(0)):CALL SUBRT%(R1%,C1%,R2%,C2%):RETURN
  115.