home *** CD-ROM | disk | FTP | other *** search
/ ftp.whtech.com / ftp.whtech.com.tar / ftp.whtech.com / club100 / gam / heart.200 < prev    next >
Text File  |  2006-10-19  |  12KB  |  173 lines
  1. 0 'HEART.BA Modified for the Model 200     CLUB 100 Library - 415/939-1246 BBS,    937-5039 NEWSLETTER, 932-8856 VOICE
  2. 1 'All copyrights reserved by:
  3. 2 'R.       I. S.       E.
  4. 3 'Research In Software Excellence
  5. 4 'This program may be distributed in
  6. 5 'any manner, as long as lines 0-6
  7. 6 'remain present. Thanks, the authors.
  8. 10 ONERRORGOTO20:OPEN"SCORES.DO"FORINPUTAS1:CLOSE:ONERRORGOTO0:GOTO40
  9. 20 A$="SCORES.DO":GOSUB30:A$="MAIDS.DO":GOSUB30:A$="WDDNG.DO":GOSUB30:GOTO40
  10. 30 OPENA$FOROUTPUTAS1:FORA=1TO11:PRINT#1,STRING$(20,32):NEXT:PRINT#1,STRING$(19,32):CLOSE:RETURN
  11. 40 IFINKEY$<>""THEN20ELSECLEAR1000:MAXFILES=1
  12. 50 DEFINTA-Z:KEYON:ONKEYGOSUB540,540,540,540,540,540,560,560:GOTO1590
  13. 70 GOSUB840
  14. 80 GOSUB1180
  15. 90 Y=20
  16. 100 KEYOFF:DIMA(39,5),PO(10),MO(50,1)
  17. 110 GOSUB1540:FORNN=1TONM
  18. 120 N=INT(RND(1)*39):M=INT(RND(1)*5)+1:IFA(N,M)<>0THEN120ELSEA(N,M)=1:MO(NN,0)=N+M*40
  19. 130 NEXTNN
  20. 140 CLS:PRINT:PRINT:FORN=1TO5:FORM=0TO39
  21. 150 IFA(M,N)=0THENPRINT" ";:NEXT:NEXT::KEYON:ONKEYGOSUB610,620,710,730,540,540,560,560:GOTO180
  22. 160 PRINTCHR$(158);
  23. 170 NEXT:NEXT:KEYON:ONKEYGOSUB610,620,710,730,540,540,560,560
  24. 180 IFNM=0THEN220ELSEPRINT@Y,CHR$(147)
  25. 190 PRINT@280,"Score =";SC;:PRINT@297,"Level";DL;NL;:GOTO200
  26. 200 GOSUB410:GOSUB1620:PRINT@280,"Score =";SC;:PRINT@297,"Level";DL;NL;
  27. 210 CT#=VAL(LEFT$(TIME$,2))*3600+VAL(MID$(TIME$,4,2))*60+VAL(RIGHT$(TIME$,2)):PRINT@312,CT#-ST#;" ";:GOTO200
  28. 220 TIME$OFF:KEYOFF
  29. 230 DL=DL+1:IFDL>5THEN260
  30. 240 CLS:PRINTTAB(10)"Difficulty level =";DL:FORW=1TO1000:NEXTW
  31. 250 ONDLGOSUB1400,1410,1420,1430,1440:GOTO110
  32. 260 CLS:PRINT@15,"YOU WON!"
  33. 270 PRINT:PRINT"You broke";SC;"hearts and ":PRINT"graduated from level 5, proving yourselfan exceptionally excellent heartbreaker (perhaps you should consider making     heartbreaking your career)."
  34. 280 IFSO=0THENFORWW=1TO2000:NEXT:CLSELSERESTORE790:GOSUB750:CLS
  35. 290 A$="Hall of Fame":A1$="SCORES.DO":JJ=(5*(ABS(CT#-(ST#+TM)))+10*JJ)*7.2814:JJ=INT(JJ)
  36. 300 PRINTTAB(6)"Heartbreaker ";A$
  37. 310 A$=INKEY$:IFA$<>""THEN310
  38. 320 IFINSTR(1,HF$,",")=0THENPRINT:PRINT"Please input your full name (LAST,      FIRST)";:LINEINPUT": ";HF$
  39. 325 PRINTCHR$(158);" Saving Score . . .";CHR$(158)
  40. 330 OPENA1$FORAPPENDAS1:PRINT#1,USING"### \             \ ";JJ,HF$:DIMZ$(13):CLOSE:OPENA1$FORINPUTAS1
  41. 340 FORN=1TO13:LINEINPUT#1,Z$(N):NEXT
  42. 350 JJ=0
  43. 360 FORN=1TO12
  44. 370 IFZ$(N)<Z$(N+1)THENT$=Z$(N+1):Z$(N+1)=Z$(N):Z$(N)=T$:JJ=JJ+1
  45. 380 NEXT:IFJJ=0THEN390ELSE350
  46. 390 CLOSE:OPENA1$FOROUTPUTAS1:FORN=1TO11:PRINT#1,USING"\                  \";Z$(N):NEXT:PRINT#1,LEFT$(Z$(12),19):CLOSE
  47. 400 RUN
  48. 410 IFNM<1THEN220
  49. 420 PRINT@40," ";:FORN=1TONA:IFPO(N)>0THEN430ELSE470
  50. 430 Z=FIX(PO(N)/40):X=PO(N)-Z*40:IFA(X,Z)=0THENPRINT@X+Z*40+40," ";ELSEPRINT@X+Z*40+40,CHR$(158);
  51. 440 PO(N)=PO(N)-40:PRINT@PO(N)+40,CHR$(152):IFPO(N)<0THENPRINT@PO(N)+40," ";
  52. 450 IFPO(N)<0ANDPO(N)+40<>YTHENPO(N)=0:NEXT:RETURNELSEIFPO(N)+40=YTHENIFA(PO(N)+40,1)=0THENPRINT@PO(N)+80," ";:PO(N)=0:PRINT@0,SPACE$(80);:GOTO480ELSEPRINT@PO(N)+80, CHR$(158);:PRINT@0,SPACE$(80);:GOTO480
  53. 460 NEXT:RETURN
  54. 470 X=INT(RND(1)*NM)+1:PO(N)=MO(X,0):NEXT:RETURN
  55. 480 TIME$OFF:ONKEYGOSUB540,540,540,540,540,540,560,560:NL=NL-1:PRINT@0,STRING$(80,146):IFSO=1THENSOUND15000,20ELSESOUND0,20
  56. 490 PRINT@297,"Level";DL;NL;:PRINT@0,STRING$(80," ");:IFNL=0THEN510
  57. 500 TIME$ON:ONKEYGOSUB610,620,710,730,540,540,560,560:GOTO180
  58. 510 CLS:PRINT"You Lost. You managed to break"SC:PRINT"hearts before you fell in love."
  59. 520 RESTORE760:GOSUB750:IFSO=0THENFORN=1TO3000:NEXT
  60. 530 A$="Brides and Grooms":A1$="WDDNG.DO":JJ=2*(QNM-NM)+DL*5:GOTO300
  61. 540 RETURN
  62. 550 MENU
  63. 560 POWEROFF
  64. 570 CLS
  65. 580 IFNM=0THEN220ELSEPRINT:PRINT:PRINT"You have become an old maid.":PRINT"You managed to break";SC;"hearts."
  66. 590 IFSO=0THENFORWW=1TO2000:NEXTWWELSERESTORE770:GOSUB750
  67. 600 A$="Hall of Maids":A1$="MAIDS.DO":JJ=-NM+10*DL:GOTO300
  68. 610 KEYOFF:CT#=VAL(LEFT$(TIME$,2))*3600+VAL(MID$(TIME$,4,2))*60+VAL(RIGHT$(TIME$,2)):PRINT@312,CT#-ST#;" ";:PRINT@Y," ";:Y=INT(RND(1)*39):PRINT@Y,CHR$(147);:KEYON:RETURN
  69. 620 KEYOFF:CT#=VAL(LEFT$(TIME$,2))*3600+VAL(MID$(TIME$,4,2))*60+VAL(RIGHT$(TIME$,2)):PRINT@312,CT#-ST#;" ";:FORS=1TO5
  70. 630 IFA(Y,S)<>0ANDSO<>0THENPRINT@S*40+Y+40,CHR$(167);:SOUND15000,1:PRINT@S*40+Y+40,"*";:SOUND12000,1:PRINT@S*40+Y+40,CHR$(157);:SOUND9000,1:PRINT@S*40+Y+40,CHR$(166);:SOUND6000,1:PRINT@40*S+Y+40," ";
  71. 640 IFA(Y,S)<>0ANDSO=0THENPRINT@S*40+Y+40,CHR$(167);:GOSUB830:PRINT@S*40+Y+40,"*";:GOSUB830:PRINT@S*40+Y+40,CHR$(157);:GOSUB830:PRINT@S*40+Y+40,CHR$(166);:GOSUB830:PRINT@40*S+Y+40," ";
  72. 650 IFA(Y,S)<>0THENA(Y,S)=0:NM=NM-1:SC=SC+1:PRINT@280,"Score =";SC;:KEYON:ONKEYGOSUB610,620,710,730,540,540,560,560:RETURN
  73. 660 PRINT@S*40+Y+40,CHR$(167);
  74. 670 IFSO=1THENSOUNDS*100,1ELSEGOSUB830
  75. 680 PRINT@S*40+Y+40," ";
  76. 690 NEXTS
  77. 700 KEYON:ONKEYGOSUB610,620,710,730,540,540,560,560:RETURN
  78. 710 KEYOFF:CT#=VAL(LEFT$(TIME$,2))*3600+VAL(MID$(TIME$,4,2))*60+VAL(RIGHT$(TIME$,2)):PRINT@312,CT#-ST#;" ";:PRINT@Y," ";:Y=Y-1:IFY=-1THENY=39
  79. 720 PRINT@Y,CHR$(147);:KEYON:RETURN
  80. 730 KEYOFF:CT#=VAL(LEFT$(TIME$,2))*3600+VAL(MID$(TIME$,4,2))*60+VAL(RIGHT$(TIME$,2)):PRINT@312,CT#-ST#;" ";:PRINT@Y," ";:Y=Y+1:IFY=40THENY=0
  81. 740 PRINT@Y,CHR$(147);:KEYON:RETURN
  82. 750 IFSO<>0THENREADM1,M5:FORM2=1TOM1:READM3,M4:SOUNDM3,M4:READM5:NEXT:RETURNELSERETURN
  83. 760 DATA21,,6263,30,,4697,20,,4697,10,,4697,30,,0,20,,6263,30,,4184,15,,4968,10,,4697,30,,0,20,,6263,30,,4697,20,,3718,10,,3134,30,,3718,15,,4697,10,,5586,30,,4184,15,,4968,10,,4697,50,,0,20,,
  84. 770 DATA32,,7032,19,,5586,6,,4697,25,,4697,25,,4697,25,,4697,25,,4697,38,,3516,13,,4697,25,,5586,19,,5272,6,,4697,25,,4697,25,,5272,25,,6269,25,,7032,75,
  85. 780 DATA7032,19,,5586,6,,4697,25,,4697,25,,4697,25,,4697,25,,4697,38,,3516,13,,4697,25,,5586,19,,5272,6,,4697,25,,4697,25,,5272,12,,6269,32,,7032,75,,
  86. 790 DATA47,,3134,50,,3321,13,,3134,13,,2793,25,,3718,50,,4184,50,,4697,50,,4968,13,,4697,13,,4184,25,,5586,75,,1,25,,4968,50,,4433,13,,4184,25,,3718,13,,2793,50,,4184,50,
  87. 800 DATA3134,50,,3134,13,,3321,25,,3718,13,,4184,75,,1,25,
  88. 810 DATA3134,50,,3321,13,,3134,13,,2793,25,,3718,50,,4184,50,,4697,50,,4968,13,,4697,13,,4184,25,,5586,75,,1,25,,4968,50,,4433,13,,4184,25,,3718,13,,2793,50,,4184,50,
  89. 820 DATA2348,100,,2348,25,,2484,50,,2793,25,,3134,150,
  90. 830 FORW=1TO50:NEXT:RETURN
  91. 840 REM FIRST TITLE PAGE
  92. 850 IFSK=1THEN970ELSELINE(4,4)-(8,60),1,BF:LINE(29,4)-(33,60),1,BF:LINE(8,28)-(28,31),1,BF
  93. 860 LINE(36,4)-(49,4):LINE(36,4)-(36,27):LINE(36,27)-(49,27):LINE(36,15)-(45,15)
  94. 870 LINE(52,12)-(59,4):LINE(59,4)-(66,12):LINE(66,12)-(66,27):LINE(52,12)-(52,27):LINE(52,16)-(66,16)
  95. 880 LINE(67,4)-(79,4):LINE(79,4)-(81,6):LINE(81,6)-(81,14):LINE(81,14)-(79,16):LINE(79,16)-(68,16):LINE(71,16)-(81,27):LINE(68,4)-(68,27)
  96. 890 LINE(84,4)-(97,4):LINE(90,4)-(90,27)
  97. 900 LINE(100,4)-(111,4):LINE(111,4)-(113,6):LINE(113,6)-(113,14):LINE(113,14)-(111,16):LINE(111,16)-(113,18):LINE(113,18)-(113,25):LINE(113,25)-(111,27):LINE(111,27)-(100,27):LINE(101,5)-(101,26):LINE(111,16)-(101,16)
  98. 910 LINE(115,4)-(127,4):LINE(127,4)-(129,6):LINE(129,6)-(129,14):LINE(129,14)-(127,16):LINE(127,16)-(116,16):LINE(119,16)-(129,27):LINE(116,4)-(116,27)
  99. 920 LINE(132,4)-(145,4):LINE(132,4)-(132,27):LINE(132,27)-(145,27):LINE(132,15)-(141,15)
  100. 930 LINE(148,12)-(155,4):LINE(155,4)-(162,12):LINE(162,12)-(162,27):LINE(148,12)-(148,27):LINE(148,16)-(162,16)
  101. 940 LINE(164,4)-(164,27):LINE(164,18)-(177,6):LINE(177,6)-(177,4):LINE(169,14)-(177,25):LINE(177,25)-(177,27)
  102. 950 LINE(180,4)-(193,4):LINE(180,4)-(180,27):LINE(180,27)-(193,27):LINE(180,15)-(189,15)
  103. 960 LINE(195,4)-(207,4):LINE(207,4)-(209,6):LINE(209,6)-(209,14):LINE(209,14)-(207,16):LINE(207,16)-(196,16):LINE(199,16)-(209,27):LINE(196,4)-(196,27)
  104. 970 PRINT@169,"By Jesse Johnson"
  105. 980 PRINT@209,"and Paul Mallery"
  106. 990 PRINT@254,"of RISE";
  107. 1000 PRINT@(286+(11-(13+LEN(KK$))/2)),"Dedicated to ";KK$;".";
  108. 1010 PRINT@35,"86";
  109. 1020 IFSK=1THEN1050ELSERESTORE1030:READNP:FORPT=1TONP:READX,Y:PSET(179+X,32+Y):PSET(194+(15-X),32+Y):PSET(203+X,32+Y):PSET(218+(15-X),32+Y):NEXT
  110. 1030 DATA37,15,4,14,3,13,2,12,2,11,1,10,1,9,1,8,0,7,0,6,0,5,1
  111. 1040 DATA4,2,3,3,2,4,2,5,1,6,1,7,0,8,0,9,1,10,1,11,2,12,2,13,3,14,3,15,4,16,5,17,6,18,7,19,8,20,9,21,10,22,11,23,12,24,13,25,14,26,15,27
  112. 1050 DIMAR(8,4):RESTORE1070:FORA=1TO8:FORB=1TO4:READAR(A,B):NEXT:NEXT
  113. 1060 IFSK=1THENRETURNELSEFORA=2TO16STEP2:FORB=1TO8:LINE(224+AR(B,1),A-2+AR(B,2))-(224+AR(B,3),A-2+AR(B,4)),0:LINE(224+AR(B,1),A+AR(B,2))-(224+AR(B,3),A+AR(B,4)),1:NEXT:NEXT
  114. 1070 DATA1,0,3,2,5,0,3,2,1,3,3,5,5,3,3,5,2,7,4,7,0,19,3,22,6,19,3,22,3,2,3,23
  115. 1080 RESTORE1100:FORA=32TO54:READB,C,D:LINE(B+204,A)-(C+204,A),1:FORE#=0TO9STEPRND(1):NEXT:NEXT
  116. 1090 FORW=1TO1500:NEXTW
  117. 1100 DATA21,23,,20,23,,19,25,,20,25,,19,25,,18,24,,17,23,,16,20,,15,19,,14,18,,15,19,,16,20,,15,19,,14,18,,13,17,,13,18,,12,17,,11,15,,10,13,,9,12,,9,11,,8,10,,9,10,,10,10
  118. 1110 RETURN
  119. 1120 CLS:PRINTTAB(6)"Heartbreaker ";A$:PRINT"Score Name          Score Name"
  120. 1130 OPENA1$FORINPUTAS1
  121. 1140 IFEOF(1)THEN1170
  122. 1150 LINEINPUT#1,A2$
  123. 1160 PRINTA2$;:GOTO1140
  124. 1170 FORWW=1TO3000:NEXTWW:CLOSE1:RETURN
  125. 1180 REM SECOND TITLE SCREEN
  126. 1190 IFSK=1THEN1300ELSECLS:PRINTTAB(14)"Heartbreaker"
  127. 1200 PRINT"You ("CHR$(147)"), "KK$", are an aspiring":PRINT"heartbreaker. As a heartbreaker, it is  your duty to break as many hearts ("CHR$(158)") aspossible without falling in love by get-ting caught by Cupid's arrows ("CHR$(152)").":PRINT
  128. 1210 PRINT"Press <ENTER> to continue.";
  129. 1220 A$=INKEY$:IFA$<>CHR$(13)THEN1220
  130. 1230 CLS:PRINTTAB(14)"Heartbreaker"
  131. 1240 PRINT"Use 'F4' for right."
  132. 1250 PRINT"    'F3' for left."
  133. 1260 PRINT"    'F2' for fire."
  134. 1270 PRINT"F1 randomly places you on the screen."
  135. 1280 PRINT:PRINT:PRINT"Press <ENTER> to continue.";
  136. 1290 A$=INKEY$:IFA$<>CHR$(13)THEN1290
  137. 1300 CLS:PRINTTAB(14)"Heartbreaker"
  138. 1310 PRINT"Do you want sound? ";:GOSUB1490:SO=A
  139. 1320 PRINT@80,"Difficulty level (1-5) .";
  140. 1330 DL$=INKEY$:IFDL$=""THEN1330ELSEDL=VAL(DL$):JJ=DL:PRINTCHR$(8);DL$;
  141. 1340 PRINT@120,"Do you want to see the high scores? .";CHR$(8);
  142. 1350 DL$=INPUT$(1):IFDL$="N"ORDL$="n"THEN1370
  143. 1360 A$="Hall of Fame":A1$="SCORES.DO":GOSUB1120:A$="Brides and Grooms":A1$="WDDNG.DO":GOSUB1120:A$="Hall of Maids":A1$="MAIDS.DO":GOSUB1120
  144. 1370 ONDLGOTO1400,1410,1420,1430,1440
  145. 1380 GOTO1320
  146. 1390 ' so=sound, tm=time, dl=difficulty level, nm=number of hearts, na=number of arrows, nl=number of lives.
  147. 1400 TM=99:NM=35:NA=3:NL=5:GOTO1450
  148. 1410 TM=80+NL*3:NM=40:NA=4:NL=4:GOTO1450
  149. 1420 TM=70+NL*3:NM=45:NA=4:NL=3:GOTO1450
  150. 1430 TM=55+NL*3:NM=50:NA=5:NL=2:GOTO1450
  151. 1440 TM=45+NL*3:NM=50:NA=7:NL=1:GOTO1450
  152. 1450 ST#=VAL(LEFT$(TIME$,2))*3600+VAL(MID$(TIME$,4,2))*60+VAL(RIGHT$(TIME$,2))+8:ET#=ST#+TM:CT#=0:QNM=NM
  153. 1460 A=INT(ET#/3600):B=INT((ET#-INT(ET#/3600)*3600)/60):C=ET#-A*3600-B*60:ET$=MID$(STR$(A),LEN(STR$(A))-1,2)+":"+MID$(STR$(B),LEN(STR$(B))-1,2)+":"+MID$(STR$(C),LEN(STR$(C))-1,2)
  154. 1470 FORA=1TO8:IFMID$(ET$,A,1)=" "THENMID$(ET$,A,1)="0":NEXTELSENEXT
  155. 1480 TIME$ON:ONKEYGOSUB610,620,710,730,540,540,560,560:ONTIME$=ET$GOSUB570:RETURN
  156. 1490 PRINT".";
  157. 1500 A$=INKEY$:IFA$=""THEN1500
  158. 1510 IFA$="Y"ORA$="y"THENA=1:PRINTCHR$(8)"Y":RETURN
  159. 1520 IFA$="N"ORA$="n"THENA=0:PRINTCHR$(8)"N":RETURN
  160. 1530 GOTO1500
  161. 1540 CLS
  162. 1550 PRINT"You get "TM"seconds."
  163. 1560 PRINT"You have to break "NM"hearts."
  164. 1570 PRINT"You have a resistance level of";NL
  165. 1580 RETURN
  166. 1590 CLS:KK$="":LINEINPUT"Enter your full name (Last, First)      :";HF$
  167. 1600 KK$=HF$:IFHF$="PASSWORD"THENSK=1:CLS:GOTO70ELSESK=0
  168. 1610 KK=INSTR(1,HF$,", "):IFKK=0THEN1590ELSEKK$=RIGHT$(HF$,LEN(HF$)-KK-1):CLS:GOTO70
  169. 1620 Q1=INT(RND(1)*QNM)+1:Q2=FIX(MO(Q1,0)/40):Q3=MO(Q1,0)-Q2*40:IFA(Q3,Q2)=0THENRETURN
  170. 1630 Q4=INT(RND(1)*39):Q5=INT(RND(1)*5)+1:IFA(Q4,Q5)<>0THEN1630
  171. 1640 KEYSTOP:PRINT@MO(Q1,0)+40," ";:MO(Q1,0)=Q4+Q5*40:A(Q4,Q5)=1:A(Q3,Q2)=0
  172. 1650 PRINT@MO(Q1,0)+40,CHR$(158);:KEYON:RETURN
  173.