home *** CD-ROM | disk | FTP | other *** search
/ ftp.whtech.com / ftp.whtech.com.tar / ftp.whtech.com / club100 / gam / heart.100 < prev    next >
Text File  |  2006-10-19  |  11KB  |  119 lines

  1. 0 'HEART.BA Jesse Johnson
  2. 1 'CLUB 100 Library - 415/939-1246 BBS,    937-5039 NEWSLETTER, 932-8856 VOICE
  3. 2 'All copyrights reserved by:
  4. 3 '   R.    I.    S.    E.
  5. 4 'Research In Software Excellence
  6. 5 'This program may be distributed in
  7. 6 'any manner, as long as lines 1-7
  8. 7 'remain present. Thanks, the authors.
  9. 8 ONERRORGOTO9:OPEN"SCORES.DO"FORINPUTAS1:CLOSE:ONERRORGOTO0:GOTO11
  10. 9 A$="SCORES.DO":GOSUB10:A$="MAIDS.DO":GOSUB10:A$="WDDNG.DO":GOSUB10:GOTO11
  11. 10 OPENA$FOROUTPUTAS1:FORA=1TO11:PRINT#1,STRING$(20,32):NEXT:PRINT#1,STRING$(19,32):CLOSE:RETURN
  12. 11 IFINKEY$<>""THEN9ELSECLEAR1000:MAXFILES=1
  13. 12 DEFINTA-Z:KEYON:ONKEYGOSUB51,51,51,51,51,51,52,52:GOTO1213
  14. 13 GOSUB840:GOSUB1180:Y=20:KEYOFF:DIMA(39,5),PO(10),MO(50,1)
  15. 14 GOSUB1212:FORNN=1TONM
  16. 15 N=INT(RND(1)*39):M=INT(RND(1)*5)+1:IFA(N,M)<>0THEN15ELSEA(N,M)=1:MO(NN,0)=N+M*40
  17. 16 NEXTNN:CLS:PRINT:PRINT:FORN=1TO5:FORM=0TO39:IFA(M,N)=0THENPRINT" ";:NEXT:NEXT:KEYON:ONKEYGOSUB56,58,66,69,51,51,52,52:GOTO19
  18. 18 PRINTCHR$(158);:NEXT:NEXT:KEYON:ONKEYGOSUB56,58,66,69,51,51,52,52
  19. 19 IFNM=0THEN23ELSEPRINT@Y,CHR$(147)
  20. 20 PRINT@280,"Score ="SC;:PRINT@297,"Level"DL;NL;:GOTO21
  21. 21 GOSUB38:GOSUB1216:PRINT@280,"Score ="SC;:PRINT@297,"Level"DL;NL;:CT#=VAL(LEFT$(TIME$,2))*3600+VAL(MID$(TIME$,4,2))*60+VAL(RIGHT$(TIME$,2)):PRINT@312,CT#-ST#" ";:GOTO21
  22. 23 TIME$OFF:KEYOFF:DL=DL+1:IFDL>5THEN25
  23. 24 CLS:PRINTTAB(10)"Difficulty level ="DL:FORW=1TO1000:NEXTW:ONDLGOSUB1197,1198,1199,1200,1201:GOTO14
  24. 25 CLS:PRINT@15,"YOU WON!":PRINT:PRINT"You broke"SC"hearts and ":275PRINT"graduated from level 5, proving yourself";:PRINT"an exceptionally excellent heartbreaker (perhaps you should consider making     heartbreaking your career).
  25. 27 IFSO=0THENFORWW=1TO2000:NEXT:CLSELSERESTORE79:GOSUB72:CLS
  26. 28 A$="Hall of Fame":A1$="SCORES.DO":JJ=(5*(ABS(CT#-(ST#+TM)))+10*JJ)*7.2814:JJ=INT(JJ)
  27. 29 PRINTTAB(6)"Heartbreaker "A$
  28. 30 A$=INKEY$:IFA$<>""THEN30
  29. 31 IFINSTR(1,HF$,",")=0THENPRINT:PRINT"Please input your full name (LAST,      FIRST)";:LINEINPUT": ";HF$
  30. 32 PRINTCHR$(158)" Saving Score . . ."CHR$(158):OPENA1$FORAPPENDAS1:PRINT#1,USING"### \             \ ";JJ,HF$:DIMZ$(13):CLOSE:OPENA1$FORINPUTAS1:FORN=1TO13:LINEINPUT#1,Z$(N):NEXT
  31. 35 JJ=0:FORN=1TO12:IFZ$(N)<Z$(N+1)THENT$=Z$(N+1):Z$(N+1)=Z$(N):Z$(N)=T$:JJ=JJ+1
  32. 36 NEXT:IFJJ=0THEN37ELSE35
  33. 37 CLOSE:OPENA1$FOROUTPUTAS1:FORN=1TO11:PRINT#1,USING"\                  \";Z$(N):NEXT:PRINT#1,LEFT$(Z$(12),19):CLOSE:RUN
  34. 38 IFNM<1THEN23
  35. 39 PRINT@40," ";:FORN=1TONA:IFPO(N)>0THEN40ELSE44
  36. 40 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);
  37. 41 PO(N)=PO(N)-40:PRINT@PO(N)+40,CHR$(152):IFPO(N)<0THENPRINT@PO(N)+40," ";
  38. 42 IFPO(N)<0ANDPO(N)+40<>YTHENPO(N)=0:NEXT:RETURNELSEIFPO(N)+40=YTHENIFA(PO(N)+40,1)=0THENPRINT@PO(N)+80," ";
  39. 43 PO(N)=0:PRINT@0,SPACE$(80);:GOTO45ELSEPRINT@PO(N)+80,CHR$(158);:PRINT@0,SPACE$(80);:GOTO45:NEXT:RETURN
  40. 44 X=INT(RND(1)*NM)+1:PO(N)=MO(X,0):NEXT:RETURN
  41. 45 TIME$OFF:ONKEYGOSUB51,51,51,51,51,51,52,52:NL=NL-1:PRINT@0,STRING$(80,146):IFSO=1THENSOUND15000,20ELSESOUND0,20
  42. 46 PRINT@297,"Level"DL;NL;:PRINT@0,STRING$(80," ");:IFNL=0THEN48
  43. 47 TIME$ON:ONKEYGOSUB56,58,66,69,51,51,52,52:GOTO19
  44. 48 CLS:PRINT"You Lost. You managed to break"SC:PRINT"hearts before you fell in love.":RESTORE73:GOSUB72:IFSO=0THENFORN=1TO3000:NEXT
  45. 50 A$="Brides and Grooms":A1$="WDDNG.DO":JJ=2*(QNM-NM)+DL*5:GOTO29
  46. 51 RETURN
  47. 52 MENU
  48. 53 CLS:IFNM=0THEN23ELSEPRINT:PRINT:PRINT"You have become an old maid.":PRINT"You managed to break"SC"hearts.
  49. 54 IFSO=0THENFORWW=1TO2000:NEXTWWELSERESTORE75:GOSUB72
  50. 55 A$="Hall of Maids":A1$="MAIDS.DO":JJ=-NM+10*DL:GOTO29
  51. 56 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
  52. 58 KEYOFF:CT#=VAL(LEFT$(TIME$,2))*3600+VAL(MID$(TIME$,4,2))*60+VAL(RIGHT$(TIME$,2)):PRINT@312,CT#-ST#" ";:FORS=1TO5:IFA(Y,S)<>0ANDSO<>0THENPRINT@S*40+Y+40,CHR$(167);:SOUND15000,1:PRINT@S*40+Y+40,"*";:SOUND12000,1
  53. 60 PRINT@S*40+Y+40,CHR$(157);:SOUND9000,1:PRINT@S*40+Y+40,CHR$(166);:SOUND6000,1:PRINT@40*S+Y+40," ";:IFA(Y,S)<>0ANDSO=0THENPRINT@S*40+Y+40,CHR$(167);:GOSUB85:PRINT@S*40+Y+40,"*";:GOSUB85
  54. 62 PRINT@S*40+Y+40,CHR$(157);:GOSUB85:PRINT@S*40+Y+40,CHR$(166);:GOSUB85:PRINT@40*S+Y+40," ";:IFA(Y,S)<>0THENA(Y,S)=0:NM=NM-1:SC=SC+1:PRINT@280,"Score ="SC;
  55. 64 KEYON:ONKEYGOSUB56,58,66,69,51,51,52,52:RETURN:PRINT@S*40+Y+40,CHR$(167);:IFSO=1THENSOUNDS*100,1ELSEGOSUB85
  56. 65 PRINT@S*40+Y+40," ";:NEXTS:KEYON:ONKEYGOSUB56,58,66,69,51,51,52,52:RETURN
  57. 66 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
  58. 68 PRINT@Y,CHR$(147);:KEYON:RETURN
  59. 69 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
  60. 71 PRINT@Y,CHR$(147);:KEYON:RETURN
  61. 72 IFSO<>0THENREADM1,M5:FORM2=1TOM1:READM3,M4:SOUNDM3,M4:READM5:NEXT:RETURNELSERETURN
  62. 73 DATA21,,6263,30,,4697,20,,4697,10,,4697,30,,0,20,,6263,30,,4184,15,,4968,10,,4697,30,,0,20,,6263,30,,4697:DATA20,,3718,10,,3134,30,,3718,15,,4697,10,,5586,30,,4184,15,,4968,10,,4697,50,,0,20,,
  63. 75 DATA32,,7032,19,,5586,6,,4697,25,,4697,25,,4697,25,,4697,25,,4697,38,,3516,13,,4697:DATA25,,5586,19,,5272,6,,4697,25,,4697,25,,5272,25,,6269,25,,7032,75,:DATA7032,19,,5586,6,,4697,25,,4697,25,,4697,25,,4697,25,,4697,38,,3516,13,,4697,25,,5586
  64. 78 DATA19,,5272,6,,4697,25,,4697,25,,5272,12,,6269,32,,7032,75,,
  65. 79 DATA47,,3134,50,,3321,13,,3134,13,,2793,25,,3718,50,,4184,50,,4697,50,,4968,13,,4697,13,,4184:DATA25,,5586,75,,1,25,,4968,50,,4433,13,,4184,25,,3718,13,,2793,50,,4184,50,:DATA3134,50,,3134,13,,3321,25,,3718,13,,4184,75,,1,25,
  66. 82 DATA3134,50,,3321,13,,3134,13,,2793,25,,3718,50,,4184,50,,4697,50,,4968,13,,4697:DATA13,,4184,25,,5586,75,,1,25,,4968,50,,4433,13,,4184,25,,3718,13,,2793,50,,4184,50,:DATA2348,100,,2348,25,,2484,50,,2793,25,,3134,150,
  67. 85 FORW=1TO50:NEXT:RETURN
  68. 840 REM FIRST TITLE PAGE
  69. 841 IFSK=1THEN856ELSELINE(4,4)-(8,60),1,BF:LINE(29,4)-(33,60),1,BF:LINE(8,28)-(28,31),1,BF
  70. 842 LINE(36,4)-(49,4):LINE(36,4)-(36,27):LINE(36,27)-(49,27):LINE(36,15)-(45,15):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):LINE(67,4)-(79,4):LINE(79,4)-(81,6):LINE(81,6)-(81,14):LINE(81,14)-(79,16)
  71. 845 LINE(79,16)-(68,16):LINE(71,16)-(81,27):LINE(68,4)-(68,27):LINE(84,4)-(97,4):LINE(90,4)-(90,27):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)
  72. 847 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):LINE(115,4)-(127,4):LINE(127,4)-(129,6):LINE(129,6)-(129,14):LINE(129,14)-(127,16)
  73. 849 LINE(127,16)-(116,16):LINE(119,16)-(129,27):LINE(116,4)-(116,27):LINE(132,4)-(145,4):LINE(132,4)-(132,27):LINE(132,27)-(145,27):LINE(132,15)-(141,15)
  74. 851 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):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)
  75. 853 LINE(180,4)-(193,4):LINE(180,4)-(180,27):LINE(180,27)-(193,27):LINE(180,15)-(189,15):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)
  76. 856 PRINT@169,"By Jesse Johnson":PRINT@209,"and Paul Mallery":PRINT@254,"of RISE";:PRINT@(286+(11-(13+LEN(KK$))/2)),"Dedicated to "KK$".";:PRINT@35,"86";:IFSK=1THEN863ELSERESTORE860:READNP:FORPT=1TONP:READX,Y:PSET(179+X,32+Y)
  77. 859 PSET(194+(15-X),32+Y):PSET(203+X,32+Y):PSET(218+(15-X),32+Y):NEXT
  78. 860 DATA37,15,4,14,3,13,2,12,2,11,1,10,1,9,1,8,0,7,0,6,0,5,1: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:DATA18,7,19,8,20,9,21,10,22,11,23,12,24,13,25,14,26,15,27
  79. 863 DIMAR(8,4):RESTORE866:FORA=1TO8:FORB=1TO4:READAR(A,B):NEXT:NEXT: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
  80. 865 LINE(224+AR(B,1),A+AR(B,2))-(224+AR(B,3),A+AR(B,4)),1:NEXT:NEXT
  81. 866 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:RESTORE868:FORA=32TO54:READB,C,D:LINE(B+204,A)-(C+204,A),1:FORE#=0TO9STEPRND(1):NEXT:NEXT:FORW=1TO1500:NEXTW
  82. 868 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,:DATA13,17,,13,18,,12,17,,11,15,,10,13,,9,12,,9,11,,8,10,,9,10,,10,10:RETURN
  83. 870 CLS:PRINTTAB(6)"Heartbreaker "A$:PRINT"Score Name          Score Name":OPENA1$FORINPUTAS1
  84. 871 IFEOF(1)THEN873
  85. 872 LINEINPUT#1,A2$:PRINTA2$;:GOTO871
  86. 873 FORWW=1TO3000:NEXTWW:CLOSE1:RETURN
  87. 1180 REM SECOND TITLE SCREEN
  88. 1181 IFSK=1THEN1189ELSECLS:PRINTTAB(14)"Heartbreaker
  89. 1182 PRINT"You ("CHR$(147)"), "KK$", are an aspiring":PRINT"heartbreaker. As a heartbreaker, it is  your duty to break as ";:PRINT"many hearts ("CHR$(158)") as possible without falling in love by     getting caught by Cupid's arrows ("CHR$(152)").
  90. 1184 PRINT:PRINT"Press <ENTER> to continue.";
  91. 1185 A$=INKEY$:IFA$<>CHR$(13)THEN1185
  92. 1186 CLS:PRINTTAB(14)"Heartbreaker":PRINT"Use 'F4' for right.":PRINT"    'F3' for left.":PRINT"    'F2' for fire.":PRINT"F1 randomly places you on the screen.":PRINT:PRINT:PRINT"Press <ENTER> to continue.";
  93. 1188 A$=INKEY$:IFA$<>CHR$(13)THEN1188
  94. 1189 CLS:PRINTTAB(14)"Heartbreaker":PRINT"Do you want sound? ";:GOSUB1207:SO=A
  95. 1190 PRINT@80,"Difficulty level (1-5) .";
  96. 1191 DL$=INKEY$:IFDL$=""THEN1191ELSEDL=VAL(DL$):JJ=DL:PRINTCHR$(8)DL$;
  97. 1192 PRINT@120,"Do you want to see the high scores? ."CHR$(8);:DL$=INPUT$(1):IFDL$="N"ORDL$="n"THEN1195
  98. 1193 A$="Hall of Fame":A1$="SCORES.DO":GOSUB870:A$="Brides and Grooms":A1$="WDDNG.DO":GOSUB870:A$="Hall of Maids":A1$="MAIDS.DO":GOSUB870
  99. 1195 ONDLGOTO1197,1198,1199,1200,1201:GOTO1190:' so=sound, tm=time, dl=difficulty level, nm=number of hearts, na=number of arrows, nl=number of lives.
  100. 1197 TM=99:NM=35:NA=3:NL=5:GOTO1202
  101. 1198 TM=80+NL*3:NM=40:NA=4:NL=4:GOTO1202
  102. 1199 TM=70+NL*3:NM=45:NA=4:NL=3:GOTO1202
  103. 1200 TM=55+NL*3:NM=50:NA=5:NL=2:GOTO1202
  104. 1201 TM=45+NL*3:NM=50:NA=7:NL=1:GOTO1202
  105. 1202 ST#=VAL(LEFT$(TIME$,2))*3600+VAL(MID$(TIME$,4,2))*60+VAL(RIGHT$(TIME$,2))+8:ET#=ST#+TM:CT#=0:QNM=NM:A=INT(ET#/3600):B=INT((ET#-INT(ET#/3600)*3600)/60):C=ET#-A*3600-B*60
  106. 1204 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):FORA=1TO8:IFMID$(ET$,A,1)=" "THENMID$(ET$,A,1)="0":NEXTELSENEXT
  107. 1206 TIME$ON:ONKEYGOSUB56,58,66,69,51,51,52,52:ONTIME$=ET$GOSUB53:RETURN
  108. 1207 PRINT".";
  109. 1208 A$=INKEY$:IFA$=""THEN1208
  110. 1209 IFA$="Y"ORA$="y"THENA=1:PRINTCHR$(8)"Y":RETURN
  111. 1210 IFA$="N"ORA$="n"THENA=0:PRINTCHR$(8)"N":RETURN
  112. 1211 GOTO1208
  113. 1212 CLS:PRINT"You get "TM"seconds.":PRINT"You have to break "NM"hearts.":PRINT"You have a resistance level of"NL:RETURN
  114. 1213 CLS:KK$="":PRINT@41,"Enter your full name (Last, First)      :";:LINEINPUTHF$:KK$=HF$:IFHF$="PASSWORD"THENSK=1:CLS:GOTO13ELSESK=0
  115. 1215 KK=INSTR(1,HF$,", "):IFKK=0THEN1213ELSEKK$=RIGHT$(HF$,LEN(HF$)-KK-1):CLS:GOTO13
  116. 1216 Q1=INT(RND(1)*QNM)+1:Q2=FIX(MO(Q1,0)/40):Q3=MO(Q1,0)-Q2*40:IFA(Q3,Q2)=0THENRETURN
  117. 1217 Q4=INT(RND(1)*39):Q5=INT(RND(1)*5)+1:IFA(Q4,Q5)<>0THEN1217
  118. 1218 KEYSTOP:PRINT@MO(Q1,0)+40," ";:MO(Q1,0)=Q4+Q5*40:A(Q4,Q5)=1:A(Q3,Q2)=0:PRINT@MO(Q1,0)+40,CHR$(158);:KEYON:RETURN
  119.