0 'HEART.BA Modified for the Model 200 CLUB 100 Library - 415/939-1246 BBS, 937-5039 NEWSLETTER, 932-8856 VOICE 1 'All copyrights reserved by: 2 'R. I. S. E. 3 'Research In Software Excellence 4 'This program may be distributed in 5 'any manner, as long as lines 0-6 6 'remain present. Thanks, the authors. 10 ONERRORGOTO20:OPEN"SCORES.DO"FORINPUTAS1:CLOSE:ONERRORGOTO0:GOTO40 20 A$="SCORES.DO":GOSUB30:A$="MAIDS.DO":GOSUB30:A$="WDDNG.DO":GOSUB30:GOTO40 30 OPENA$FOROUTPUTAS1:FORA=1TO11:PRINT#1,STRING$(20,32):NEXT:PRINT#1,STRING$(19,32):CLOSE:RETURN 40 IFINKEY$<>""THEN20ELSECLEAR1000:MAXFILES=1 50 DEFINTA-Z:KEYON:ONKEYGOSUB540,540,540,540,540,540,560,560:GOTO1590 70 GOSUB840 80 GOSUB1180 90 Y=20 100 KEYOFF:DIMA(39,5),PO(10),MO(50,1) 110 GOSUB1540:FORNN=1TONM 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 130 NEXTNN 140 CLS:PRINT:PRINT:FORN=1TO5:FORM=0TO39 150 IFA(M,N)=0THENPRINT" ";:NEXT:NEXT::KEYON:ONKEYGOSUB610,620,710,730,540,540,560,560:GOTO180 160 PRINTCHR$(158); 170 NEXT:NEXT:KEYON:ONKEYGOSUB610,620,710,730,540,540,560,560 180 IFNM=0THEN220ELSEPRINT@Y,CHR$(147) 190 PRINT@280,"Score =";SC;:PRINT@297,"Level";DL;NL;:GOTO200 200 GOSUB410:GOSUB1620:PRINT@280,"Score =";SC;:PRINT@297,"Level";DL;NL; 210 CT#=VAL(LEFT$(TIME$,2))*3600+VAL(MID$(TIME$,4,2))*60+VAL(RIGHT$(TIME$,2)):PRINT@312,CT#-ST#;" ";:GOTO200 220 TIME$OFF:KEYOFF 230 DL=DL+1:IFDL>5THEN260 240 CLS:PRINTTAB(10)"Difficulty level =";DL:FORW=1TO1000:NEXTW 250 ONDLGOSUB1400,1410,1420,1430,1440:GOTO110 260 CLS:PRINT@15,"YOU WON!" 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)." 280 IFSO=0THENFORWW=1TO2000:NEXT:CLSELSERESTORE790:GOSUB750:CLS 290 A$="Hall of Fame":A1$="SCORES.DO":JJ=(5*(ABS(CT#-(ST#+TM)))+10*JJ)*7.2814:JJ=INT(JJ) 300 PRINTTAB(6)"Heartbreaker ";A$ 310 A$=INKEY$:IFA$<>""THEN310 320 IFINSTR(1,HF$,",")=0THENPRINT:PRINT"Please input your full name (LAST, FIRST)";:LINEINPUT": ";HF$ 325 PRINTCHR$(158);" Saving Score . . .";CHR$(158) 330 OPENA1$FORAPPENDAS1:PRINT#1,USING"### \ \ ";JJ,HF$:DIMZ$(13):CLOSE:OPENA1$FORINPUTAS1 340 FORN=1TO13:LINEINPUT#1,Z$(N):NEXT 350 JJ=0 360 FORN=1TO12 370 IFZ$(N)0THEN430ELSE470 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); 440 PO(N)=PO(N)-40:PRINT@PO(N)+40,CHR$(152):IFPO(N)<0THENPRINT@PO(N)+40," "; 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 460 NEXT:RETURN 470 X=INT(RND(1)*NM)+1:PO(N)=MO(X,0):NEXT:RETURN 480 TIME$OFF:ONKEYGOSUB540,540,540,540,540,540,560,560:NL=NL-1:PRINT@0,STRING$(80,146):IFSO=1THENSOUND15000,20ELSESOUND0,20 490 PRINT@297,"Level";DL;NL;:PRINT@0,STRING$(80," ");:IFNL=0THEN510 500 TIME$ON:ONKEYGOSUB610,620,710,730,540,540,560,560:GOTO180 510 CLS:PRINT"You Lost. You managed to break"SC:PRINT"hearts before you fell in love." 520 RESTORE760:GOSUB750:IFSO=0THENFORN=1TO3000:NEXT 530 A$="Brides and Grooms":A1$="WDDNG.DO":JJ=2*(QNM-NM)+DL*5:GOTO300 540 RETURN 550 MENU 560 POWEROFF 570 CLS 580 IFNM=0THEN220ELSEPRINT:PRINT:PRINT"You have become an old maid.":PRINT"You managed to break";SC;"hearts." 590 IFSO=0THENFORWW=1TO2000:NEXTWWELSERESTORE770:GOSUB750 600 A$="Hall of Maids":A1$="MAIDS.DO":JJ=-NM+10*DL:GOTO300 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 620 KEYOFF:CT#=VAL(LEFT$(TIME$,2))*3600+VAL(MID$(TIME$,4,2))*60+VAL(RIGHT$(TIME$,2)):PRINT@312,CT#-ST#;" ";:FORS=1TO5 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," "; 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," "; 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 660 PRINT@S*40+Y+40,CHR$(167); 670 IFSO=1THENSOUNDS*100,1ELSEGOSUB830 680 PRINT@S*40+Y+40," "; 690 NEXTS 700 KEYON:ONKEYGOSUB610,620,710,730,540,540,560,560:RETURN 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 720 PRINT@Y,CHR$(147);:KEYON:RETURN 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 740 PRINT@Y,CHR$(147);:KEYON:RETURN 750 IFSO<>0THENREADM1,M5:FORM2=1TOM1:READM3,M4:SOUNDM3,M4:READM5:NEXT:RETURNELSERETURN 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,, 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, 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,, 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, 800 DATA3134,50,,3134,13,,3321,25,,3718,13,,4184,75,,1,25, 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, 820 DATA2348,100,,2348,25,,2484,50,,2793,25,,3134,150, 830 FORW=1TO50:NEXT:RETURN 840 REM FIRST TITLE PAGE 850 IFSK=1THEN970ELSELINE(4,4)-(8,60),1,BF:LINE(29,4)-(33,60),1,BF:LINE(8,28)-(28,31),1,BF 860 LINE(36,4)-(49,4):LINE(36,4)-(36,27):LINE(36,27)-(49,27):LINE(36,15)-(45,15) 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) 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) 890 LINE(84,4)-(97,4):LINE(90,4)-(90,27) 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) 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) 920 LINE(132,4)-(145,4):LINE(132,4)-(132,27):LINE(132,27)-(145,27):LINE(132,15)-(141,15) 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) 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) 950 LINE(180,4)-(193,4):LINE(180,4)-(180,27):LINE(180,27)-(193,27):LINE(180,15)-(189,15) 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) 970 PRINT@169,"By Jesse Johnson" 980 PRINT@209,"and Paul Mallery" 990 PRINT@254,"of RISE"; 1000 PRINT@(286+(11-(13+LEN(KK$))/2)),"Dedicated to ";KK$;"."; 1010 PRINT@35,"86"; 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 1030 DATA37,15,4,14,3,13,2,12,2,11,1,10,1,9,1,8,0,7,0,6,0,5,1 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 1050 DIMAR(8,4):RESTORE1070:FORA=1TO8:FORB=1TO4:READAR(A,B):NEXT:NEXT 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 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 1080 RESTORE1100:FORA=32TO54:READB,C,D:LINE(B+204,A)-(C+204,A),1:FORE#=0TO9STEPRND(1):NEXT:NEXT 1090 FORW=1TO1500:NEXTW 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 1110 RETURN 1120 CLS:PRINTTAB(6)"Heartbreaker ";A$:PRINT"Score Name Score Name" 1130 OPENA1$FORINPUTAS1 1140 IFEOF(1)THEN1170 1150 LINEINPUT#1,A2$ 1160 PRINTA2$;:GOTO1140 1170 FORWW=1TO3000:NEXTWW:CLOSE1:RETURN 1180 REM SECOND TITLE SCREEN 1190 IFSK=1THEN1300ELSECLS:PRINTTAB(14)"Heartbreaker" 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 1210 PRINT"Press to continue."; 1220 A$=INKEY$:IFA$<>CHR$(13)THEN1220 1230 CLS:PRINTTAB(14)"Heartbreaker" 1240 PRINT"Use 'F4' for right." 1250 PRINT" 'F3' for left." 1260 PRINT" 'F2' for fire." 1270 PRINT"F1 randomly places you on the screen." 1280 PRINT:PRINT:PRINT"Press to continue."; 1290 A$=INKEY$:IFA$<>CHR$(13)THEN1290 1300 CLS:PRINTTAB(14)"Heartbreaker" 1310 PRINT"Do you want sound? ";:GOSUB1490:SO=A 1320 PRINT@80,"Difficulty level (1-5) ."; 1330 DL$=INKEY$:IFDL$=""THEN1330ELSEDL=VAL(DL$):JJ=DL:PRINTCHR$(8);DL$; 1340 PRINT@120,"Do you want to see the high scores? .";CHR$(8); 1350 DL$=INPUT$(1):IFDL$="N"ORDL$="n"THEN1370 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 1370 ONDLGOTO1400,1410,1420,1430,1440 1380 GOTO1320 1390 ' so=sound, tm=time, dl=difficulty level, nm=number of hearts, na=number of arrows, nl=number of lives. 1400 TM=99:NM=35:NA=3:NL=5:GOTO1450 1410 TM=80+NL*3:NM=40:NA=4:NL=4:GOTO1450 1420 TM=70+NL*3:NM=45:NA=4:NL=3:GOTO1450 1430 TM=55+NL*3:NM=50:NA=5:NL=2:GOTO1450 1440 TM=45+NL*3:NM=50:NA=7:NL=1:GOTO1450 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 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) 1470 FORA=1TO8:IFMID$(ET$,A,1)=" "THENMID$(ET$,A,1)="0":NEXTELSENEXT 1480 TIME$ON:ONKEYGOSUB610,620,710,730,540,540,560,560:ONTIME$=ET$GOSUB570:RETURN 1490 PRINT"."; 1500 A$=INKEY$:IFA$=""THEN1500 1510 IFA$="Y"ORA$="y"THENA=1:PRINTCHR$(8)"Y":RETURN 1520 IFA$="N"ORA$="n"THENA=0:PRINTCHR$(8)"N":RETURN 1530 GOTO1500 1540 CLS 1550 PRINT"You get "TM"seconds." 1560 PRINT"You have to break "NM"hearts." 1570 PRINT"You have a resistance level of";NL 1580 RETURN 1590 CLS:KK$="":LINEINPUT"Enter your full name (Last, First) :";HF$ 1600 KK$=HF$:IFHF$="PASSWORD"THENSK=1:CLS:GOTO70ELSESK=0 1610 KK=INSTR(1,HF$,", "):IFKK=0THEN1590ELSEKK$=RIGHT$(HF$,LEN(HF$)-KK-1):CLS:GOTO70 1620 Q1=INT(RND(1)*QNM)+1:Q2=FIX(MO(Q1,0)/40):Q3=MO(Q1,0)-Q2*40:IFA(Q3,Q2)=0THENRETURN 1630 Q4=INT(RND(1)*39):Q5=INT(RND(1)*5)+1:IFA(Q4,Q5)<>0THEN1630 1640 KEYSTOP:PRINT@MO(Q1,0)+40," ";:MO(Q1,0)=Q4+Q5*40:A(Q4,Q5)=1:A(Q3,Q2)=0 1650 PRINT@MO(Q1,0)+40,CHR$(158);:KEYON:RETURN