home *** CD-ROM | disk | FTP | other *** search
/ ftp.whtech.com / ftp.whtech.com.tar / ftp.whtech.com / club100 / gam / foursc.ba < prev    next >
Text File  |  2006-10-19  |  7KB  |  135 lines
  1. 0 'FOURSC.BA - By Stevens, G
  2. 1 'Club 100 Library - 415/939-1246 BBS,    937-5039 NEWSLETTER, 932-8856 VOICE
  3. 2 CLEAR1000:DEFSTRS:DEFINTA-R,T:DIMA(52),HP(52),HS(52),SA(13),D(52),T(5,13),N(5),F(4),PT(5),PF(4):DATA" A"," 2"," 3"," 4"," 5"," 6"," 7"," 8"," 9","10"," J"," Q"," K":FORI1=1TO13:READSA(I1):NEXT:SM="##,###":RV$=CHR$(27)+"p":NV$=CHR$(27)+"q":CLS
  4. 3 PRINTTAB(14);"Four Seasons":PRINT:PRINT:PRINT"Initializing - hang in there ...":PRINT:GOSUB81:PT(1)=23:PT(2)=97:PT(3)=103:PT(4)=109:PT(5)=183:PF(1)=17:PF(2)=29:PF(3)=177:PF(4)=189:CL=0:CW=0:GL=0:GW=0:SC=""
  5. 4 IFSC=""THENGOSUB9:GOTO4
  6. 5 SR="Y"
  7. 6 IFSR<>"N"THENGOSUB17:GOTO6
  8. 7 IFSC="N"THENMENU
  9. 8 OPEN"FOURSC"FOROUTPUTAS1:PRINT#1,GW;GL;IG:CLOSE:MENU
  10. 9 PRINT"Keep cumulative scores? ";:SC=INPUT$(1):IFSC="n"THENSC="N"
  11. 10 IFSC="y"THENSC="Y"
  12. 11 IFSC="N"THENPRINT"No";:RETURN
  13. 12 IFSC<>"Y"THENSC="":BEEP:PRINT@240,"*** PLEASE ENTER <Y> OR <N> ***":RETURN
  14. 13 PRINT"Yes";:ONERRORGOTO15:OPEN"FOURSC"FORINPUTAS1:INPUT#1,GW,GL,IG:CLOSE
  15. 14 ONERRORGOTO0:RETURN
  16. 15 IFERR=52THENRESUME14
  17. 16 ONERRORGOTO0
  18. 17 CLS:IFSR="Y"THENGOSUB64ELSEGOSUB69
  19. 18 GOSUB71:CLS:GOSUB72
  20. 19 IFNH<52THENGOSUB34:GOTO19
  21. 20 CLS:IFND=0THENPRINT"YOU WON!":CW=CW+1:GW=GW+1ELSEPRINT"YOU LOST!":CL=CL+1:GL=GL+1
  22. 21 PRINT:BL=CL:BW=CW:SG="Current:":GOSUB33:BL=GL:BW=GW:IFSC="Y"THENSG="Cum:":GOSUB33
  23. 22 SR=""
  24. 23 IFSR=""THENGOSUB28:GOTO23
  25. 24 IFSR="Y"THENPRINT"Yes";
  26. 25 IFSR="N"THENPRINT"No";
  27. 26 IFSR="R"THENPRINT"Replay";
  28. 27 RETURN
  29. 28 PRINT@280,"Play again (yes/no/replay)? ";:SR=INPUT$(1):IFSR="y"THENSR="Y":RETURN
  30. 29 IFSR="n"THENSR="N":RETURN
  31. 30 IFSR="r"THENSR="R":RETURN
  32. 31 IFSR="Y"ORSR="N"ORSR="R"THENRETURN
  33. 32 SR="":BEEP:PRINT@240,"** Please type <Y>, <N>, or <R> **":RETURN
  34. 33 PRINTSG;:PRINTTAB(9);"Played:";TAB(17);:PRINTUSINGSM;BL+BW;:PRINTTAB(26);"Won:";TAB(31);:PRINTUSINGSM;BW:PRINTTAB(9);"Lost:";TAB(17);:PRINTUSINGSM;BL;:PRINTTAB(26);"% Won:";TAB(33);:PRINTUSING"###.##";BW/(BW+BL)*100;:PRINT"%";:RETURN
  35. 34 NH=NH+1:IC=HP(NH):ND=ND+1:D(ND)=IC:GOSUB74:PRINT@303,SG;:PRINT@280,52-NH;"Cards left ";:IS=1
  36. 35 IFIS=1THENGOSUB37:GOTO35
  37. 36 RETURN
  38. 37 IS=0:GOSUB76:PRINT@240,STRING$(33," ");:IFSG="H"THENPRINT@206,"Hit";:RETURN
  39. 38 IFSG="Q"THENNH=52:PRINT@206,"Quit";:RETURN
  40. 39 IFSG="M"THENPRINT@206,"Move";
  41. 40 GOSUB83:PRINT@6,SF;:GOSUB105:PRINT@44,ST;:GOSUB44:IFIS=1THENRETURN
  42. 41 GOSUB46:IFIS=1THENRETURN
  43. 42 IFLEFT$(ST,1)="T"THENGOSUB49ELSEGOSUB55
  44. 43 IS=1:RETURN
  45. 44 IFSF="D"ANDND>0THENFC=D(ND):RETURN
  46. 45 IT=ASC(RIGHT$(SF,1))-48:FC=T(IT,N(IT)):RETURN
  47. 46 IT=ASC(RIGHT$(ST,1))-48:IFLEFT$(ST,1)="F"THENTC=F(IT):RETURN
  48. 47 TC=T(IT,N(IT)):RETURN
  49. 48 IS=1:BEEP:PRINT@240,"ILLEGAL MOVE";:RETURN
  50. 49 TM=((TC-1)MOD13)+1:FM=((FC-1)MOD13)+1:IFTM=FMORTM=IBTHENGOSUB48:RETURN
  51. 50 IFTM=1THENTM=13ELSETM=TM-1
  52. 51 IFTM<0THENTM=FM
  53. 52 IFFM<>TMTHENGOSUB48:RETURN
  54. 53 IT=ASC(RIGHT$(ST,1))-48:N(IT)=N(IT)+1:T(IT,N(IT))=FC:IC=FC:GOSUB74:PRINT@PT(IT),SG;:IFSF="D"THENGOSUB62ELSEGOSUB63
  55. 54 RETURN
  56. 55 TM=((TC-1)MOD13)+1:FM=((FC-1)MOD13)+1:IFTM=0THENTM=IBELSETM=TM+1
  57. 56 IFTM=14THENTM=1
  58. 57 IFFM<>TMTHENGOSUB48:RETURN
  59. 58 I1=(FC-1)/13+1:IFTC=0THENI2=I1ELSEI2=(TC-1)/13+1
  60. 59 IFI1<>I2THENGOSUB48:RETURN
  61. 60 IT=ASC(RIGHT$(ST,1))-48:F(IT)=FC:IC=FC:GOSUB74:PRINT@PF(IT),SG;:IFSF="D"THENGOSUB62ELSEGOSUB63
  62. 61 RETURN
  63. 62 ND=ND-1:IC=D(ND):GOSUB74:PRINT@303,SG;:RETURN
  64. 63 IT=ASC(RIGHT$(SF,1))-48:N(IT)=N(IT)-1:IC=T(IT,N(IT)):GOSUB74:PRINT@PT(IT),SG;:RETURN
  65. 64 PRINT"Shuffling - be patient ...":FORI1=1TO52:A(I1)=0:NEXT:I1=0
  66. 65 IFI1<52THENGOSUB67:GOTO65
  67. 66 RETURN
  68. 67 I2=RND(1)*52+1:IFA(I2)=1THENRETURN
  69. 68 I1=I1+1:HP(I1)=I2:HS(I1)=I2:A(I2)=1:RETURN
  70. 69 FORI1=1TO52:HP(I1)=HS(I1):NEXT:IFND=0THENGW=GW-1:CW=CW-1ELSEGL=GL-1:CL=CL-1
  71. 70 RETURN
  72. 71 T(1,1)=HP(1):T(3,1)=HP(2):T(5,1)=HP(3):T(2,1)=HP(4):T(4,1)=HP(5):F(1)=HP(6):FORI1=1TO5:N(I1)=1:NEXT:F(2)=0:F(3)=0:F(4)=0:ND=0:NH=6:IB=((F(1)-1)MOD13)+1:RETURN
  73. 72 IC=F(1):GOSUB74:PRINT@PF(1),SG;:GOSUB132:IC=T(1,N(1)):GOSUB74:PRINT@PT(1),SG;:IC=F(2):GOSUB74:PRINT@PF(2),SG;:IC=T(2,N(2)):GOSUB74:PRINT@PT(2),SG;:IC=T(3,N(3)):GOSUB74:PRINT@PT(3),SG;:IC=T(4,N(4)):GOSUB74:PRINT@PT(4),SG;:IC=F(3)
  74. 73 GOSUB74:PRINT@PF(3),SG;:IC=T(5,N(5)):GOSUB74:PRINT@PT(5),SG;:IC=F(4):GOSUB74:PRINT@PF(4),SG;:RETURN
  75. 74 IFIC=0THENSG=STRING$(4," "):RETURN
  76. 75 I1=((IC-1)MOD13)+1:SG=SA(I1)+" ":I1=(IC-1)/13+1:SG=SG+CHR$(155+I1):RETURN
  77. 76 PRINT@200,STRING$(11," "):PRINT@0,STRING$(8," "):PRINT@40,STRING$(6," "):PRINT@200,"PLAY? ";:SG=INPUT$(1):IFSG="h"THENSG="H"
  78. 77 IFSG="q"THENSG="Q"
  79. 78 IFSG="m"THENSG="M"
  80. 79 IFSG="H"ORSG="Q"ORSG="M"THENRETURN
  81. 80 BEEP:PRINT@240,"** Please type <M>, <H> or <Q> **":GOTO76
  82. 81 I1=VAL(LEFT$(DATE$,2)):GOSUB82:I1=VAL(MID$(DATE$,4,2)):GOSUB82:I1=VAL(MID$(DATE$,7,2)):GOSUB82:I1=VAL(MID$(TIME$,1,2)):GOSUB82:I1=VAL(MID$(TIME$,4,2)):GOSUB82:I1=VAL(MID$(TIME$,7,2)):GOSUB82:RETURN
  83. 82 FORI2=1TOI1:I3=RND(1):NEXT:RETURN
  84. 83 CF=0:PF=0:SF="":GOSUB96:PRINT@0,"From:";
  85. 84 IFSF<>CHR$(13)THENGOSUB87:GOTO84
  86. 85 PF=CF:IFPF=0THENSF="D":RETURN
  87. 86 SF="T"+RIGHT$(STR$(CF),1):CF=CF+4:RETURN
  88. 87 SF=INKEY$:IFSF=""THEN87
  89. 88 IFSF=CHR$(13)THENRETURN
  90. 89 IFASC(SF)<28ORASC(SF)>31THENBEEP:GOTO87
  91. 90 IFSF=CHR$(28)THENMV=-2
  92. 91 IFSF=CHR$(29)THENMV=2
  93. 92 IFSF=CHR$(30)THENMV=-1
  94. 93 IFSF=CHR$(31)THENMV=1
  95. 94 PF=CF:CF=(CF+MV)MOD6:IFCF<0THENCF=6+CF
  96. 95 GOSUB96:RETURN
  97. 96 IFPF=0THENGOSUB101
  98. 97 IFPF<>0THENGOSUB102
  99. 98 IFCF=0THENGOSUB103
  100. 99 IFCF<>0THENGOSUB104
  101. 100 RETURN
  102. 101 IC=D(ND):GOSUB74:PRINT@303,SG;:RETURN
  103. 102 IC=T(PF,N(PF)):GOSUB74:PRINT@PT(PF),SG;:RETURN
  104. 103 IC=D(ND):GOSUB74:PRINT@303,RV$;SG;NV$;:RETURN
  105. 104 IC=T(CF,N(CF)):GOSUB74:PRINT@PT(CF),RV$;SG$;NV$;:RETURN
  106. 105 CT=1:PT=1:ST="":GOSUB123:PRINT@40,"TO:";
  107. 106 IFST<>CHR$(13)THENGOSUB114:GOTO106
  108. 107 PT=CT:IFPT<5THENGOSUB112
  109. 108 IFPT>4THENGOSUB113
  110. 109 IFPF=0THENGOSUB101
  111. 110 IFPF<>0THENGOSUB102
  112. 111 RETURN
  113. 112 GOSUB128:ST="F"+RIGHT$(STR$(PT),1):RETURN
  114. 113 GOSUB129:ST="T"+RIGHT$(STR$(PT-4),1):RETURN
  115. 114 ST=INKEY$:IFST=""THEN114
  116. 115 IFST=CHR$(13)THENRETURN
  117. 116 IFASC(ST)<28ORASC(ST)>31THENBEEP:GOTO114
  118. 117 IFST=CHR$(28)THENMV=1
  119. 118 IFST=CHR$(29)THENMV=-1
  120. 119 IFST=CHR$(30)THENMV=4
  121. 120 IFST=CHR$(31)THENMV=-4
  122. 121 PT=CT:CT=(CT+MV)MOD9:IFCT<1THENCT=9-ABS(CT)
  123. 122 GOSUB123:RETURN
  124. 123 IFPT<5THENGOSUB128
  125. 124 IFPT>4ANDCF<>PTTHENGOSUB129
  126. 125 IFCT<5THENGOSUB130
  127. 126 IFCT>4THENGOSUB131
  128. 127 RETURN
  129. 128 IC=F(PT):GOSUB74:PRINT@PF(PT),SG;:RETURN
  130. 129 IC=T(PT-4,N(PT-4)):GOSUB74:PRINT@PT(PT-4),SG;:RETURN
  131. 130 IC=F(CT):GOSUB74:PRINT@PF(CT),RV$;SG;NV$;:RETURN
  132. 131 IC=T(CT-4,N(CT-4)):GOSUB74:PRINT@PT(CT-4),RV$;SG;NV$;:RETURN
  133. 132 PRINT@315,LEFT$(SG,2);:IFVAL(LEFT$(SG,2))=10THENLS=203ELSELS=206
  134. 133 LINE(LS,63)-(LS+24,52),1,B:LINE(LS+2,63)-(LS+22,54),1,B:FORZ=LS+1TOLS+23STEP2:PSET(Z,53):NEXTZ:FORZ=53TO63STEP2:PSET(LS+1,Z):PSET(LS+23,Z):NEXTZ:RETURN
  135.